scnc
/
siesta
mirror of https://gitlab.com/siesta-project/siesta.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Add libsys functionality -- serial, no MPI

This commit is contained in:
Alberto Garcia 2023-05-08 15:04:17 +02:00
parent ce822f4e43
commit dcd2448c4d
29 changed files with 273 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
CMakeLists.txt
View File

@ -214,6 +214,7 @@ if( WITH_MPI )
add_library(Siesta::MPI ALIAS mpi_siesta)
endif()
add_subdirectory("Src/libsys")
add_subdirectory("Src/easy-fdict")
add_subdirectory("Src/ncps/src/libxc-compat")
add_subdirectory("Src/ncps/src")

4
Src/CMakeLists.txt
View File

@ -32,7 +32,6 @@ set(libsiesta_sources
broadcast_projections.F
broyden_optim.F
bsc_cellxc.F
bye.F
byte_count.F90
cart2frac.f
cell_broyden_optim.F
@ -118,7 +117,6 @@ set(libsiesta_sources
diagon.F
diagonalizeHk.F90
diagpol.f
die.F
digcel.f
dipole.F90
dismin.f
@ -483,7 +481,6 @@ set(libsiesta_sources
state_analysis.F
state_init.F
struct_init.F
sys.F
timer.F90
timer_tree.f90
timestamp.f90
@ -574,6 +571,7 @@ target_link_libraries(
$<$<BOOL:${WITH_ELPA}>:Elpa::elpa>
"$<$<BOOL:${WITH_MPI}>:Scalapack::Scalapack>"
"$<$<BOOL:${WITH_DFTD3}>:s-dftd3::s-dftd3>"
${PROJECT_NAME}-libsys
LAPACK::LAPACK
)

2
Src/arw.f
View File

@ -119,7 +119,7 @@
IF (IOnode) WRITE(6,'(A,/,A,F3.0,2(A,I2),2(A,F12.5))')
& ' EGOFV: ERROR: Too many iterations. Stopping.',
& ' Z=',Z,' L=',L,' NNODE=',NNODE,' E=',E,' DE=',DE
call die()
call die("stopping program")
END IF
! Find true waveftn G from auxiliary function Y and normalize

40
Src/atom.F
View File

@ -1067,7 +1067,7 @@ c endif
if (rmax.gt.rint) then
write(6,*) 'POLARIZATION: Rc for the polarization orbitals'
write(6,*) 'must be smaller than ',rint,' Bohr'
call die()
call die("stopping program")
endif
do ir = nrc+1,nrval
@ -1303,7 +1303,7 @@ C Under certain circunstances the algorithm is not going to work
write(6,'(/,A,/,A)')
. 'parabola: The program failed in finding a SPLIT orbital ',
. 'parabola: with the desired splitnorm'
call die()
call die("stopping program")
endif
valmin=(splnorm-rnrmin)**2
@ -2138,7 +2138,7 @@ C
write(6,"(2a,i4)")
. 'new_specie: ERROR: Parameter lmaxd must be increased ',
. 'to at least ', lmax
call die()
call die("stopping program")
endif
nzetamax=0
@ -2155,14 +2155,14 @@ C
write(6,"(2a,i4)")
. 'new_specie: ERROR: Parameter nsmx must be increased ',
. 'to at least ', nsm_max-1
call die
call die("stopping program")
endif
if (nzetamax.gt.nzetmx) then
write(6,"(2a,i4)")
. 'new_specie: ERROR: Parameter nzetmx must be increased ',
. 'to at least ', nzetamax
call die
call die("stopping program")
endif
!
nkblmx= maxval(nkbl(0:lmxkb))
@ -2171,7 +2171,7 @@ C
write(6,"(2a,i4)")
. 'new_specie: ERROR: Parameter nkbmx must be increased ',
. 'to at least ', nkblmx
call die
call die("stopping program")
endif
@ -2289,7 +2289,7 @@ C
if (nrval.gt.nrmax) then
write(6,'(a,i4)')
. 'read_vps: ERROR: Nrmax must be increased to at least',nrval
call die
call die("stopping program")
endif
!=======
@ -2314,7 +2314,7 @@ C
. 'read_vps: Pseudo-core for hartree and xc-correction'
write(6,'(a)') 'Siesta cannot use this pseudopotential'
write(6,'(a)') 'Use option pe instead of ph in ATOM program'
call die()
call die("stopping program")
elseif(nicore.eq.'fcec') then
write(6,'(a)') 'read_vps: Full-core for xc-correction'
elseif(nicore.eq.'fche') then
@ -2322,7 +2322,7 @@ C
. 'read_vps: Full-core for hartree and xc-correction'
write(6,'(a)') 'Siesta cannot use this pseudopotential'
write(6,'(a)') 'Use option pe instead of ph in ATOM program'
call die()
call die("stopping program")
endif
endif
@ -3420,7 +3420,7 @@ C
. ' not bound in the atom'
write(6,'(a)')
. 'FILTERET: ERROR a cut off radius must be explicitly given'
call die
call die("stopping program")
endif
if (abs(eshift).gt.1.0d-5) then
el = eigen(l) + eshift
@ -3909,7 +3909,7 @@ C
. ' not bound in the atom'
write(6,'(A)')
. 'SPLIT: ERROR a cut off radius must be explicitly given'
call die()
call die("stopping program")
else
! Use this rc
rco(1,l,nsm) = user_set_rc
@ -4060,7 +4060,7 @@ C
write(6,'(/,A,I2,A,I2,A,I2)')
. 'SPLIT: WARNING: Split-orbital with zeta=',izeta,
. ' and zeta=',i,' are identical for l=',l
call die()
call die("stopping program")
endif
enddo
@ -4500,7 +4500,7 @@ C
. ' not bound in the atom'
write(6,'(A)')
. 'NODES: ERROR a cut off radius must be explicitly given'
call die
call die("stopping program")
endif
if (abs(eshift).gt.1.0d-5) then
@ -4747,7 +4747,7 @@ C
. ' not bound in the atom'
write(6,'(A)')
. 'NONODES: ERROR a cut off radius must be explicitly given'
call die
call die("stopping program")
endif
if (abs(eshift).gt.1.0d-5) then
@ -4779,7 +4779,7 @@ C If the compression factor is negative or zero the orbitals are untouched
. 'NONODES: WARNING: PAO base function with zeta=',izeta,
. ' and zeta=',i,' are identical for ',cnfigtb(l,nsm,is),
. sym(l),' state'
call die
call die("stopping program")
endif
enddo
@ -5100,7 +5100,7 @@ C
. ' not bound in the atom'
write(6,'(A)')
. 'SPLITGAUSS: ERROR a cut off radius must be explicitly given'
call die
call die("stopping program")
endif
if (abs(eshift).gt.1.0d-5) then
@ -5135,7 +5135,7 @@ C
.'SPLITGAUSS: ERROR: with SPLITGAUSS option the compression ',
.'SPLITGAUSS: ERROR: factors for all the augmentation functions',
. ' must be explicitly specified'
call die
call die("stopping program")
endif
gexp=abs(lambda(izeta,l,nsm))
gexp=1.0d0/(gexp**2)
@ -7057,7 +7057,7 @@ C
. 'Bessel: ERROR Cut-off radius must be explicitly specified'
write(6,'(a)')
. 'Bessel: ERROR using Z=-100 (Floating Bessel functions)'
call die
call die("stopping program")
endif
C
if (abs(lambda(izeta,l,nsm)).lt.1.0d-3)
@ -7158,7 +7158,7 @@ C Written by D. Sanchez-Portal, Aug. 1998.
. 'NODES','SPLIT','USER','SPLITGAUSS',
. 'NONODES','FILTERET'
call die
call die("stopping program")
endif
@ -7474,7 +7474,7 @@ c . ,' # scaleFactor(izeta=1,Nzeta)'
$ "Split-norm parameter is too small, "
$ // "(degenerate 2nd zeta): ",
$ spln
call die()
call die("stopping program")
endif
if (nsp <= 2) then
call die("Cannot find split_valence match point")

16
Src/atomlwf.F
View File

@ -279,7 +279,7 @@ C Check that there is an integer number of electrons
if (Node.eq.0) then
write(6,*) 'cspa: Wrong total charge; non integer:',qtot
endif
call die()
call die("stopping program")
endif
C ..................
@ -482,7 +482,7 @@ C loop over the neighbors of ia within rcoor
write(6,*) 'cspa: Number of LWFs larger than basis set size'
write(6,*) ' Increase basis set, or use less LWFs'
endif
call die()
call die("stopping program")
endif
if ((ioptlwf .eq. 2) .and. (nbands .ne. nqtot/2)) then
@ -491,7 +491,7 @@ C loop over the neighbors of ia within rcoor
write(6,*) ' Something went wrong in generating the'
write(6,*) ' LWFs for the Ordejon-Mauri functional'
endif
call die()
call die("stopping program")
endif
@ -573,7 +573,7 @@ C Deallocate local memory
write(6,*) 'cspa: Wrong atomic charge for atom ',ia
write(6,*) ' qa = ',qa(ia),' must be an integer'
endif
call die()
call die("stopping program")
endif
if (ioptlwf .eq. 1) then
indexi = ( ( nelectr + 2 ) / 2 )
@ -592,7 +592,7 @@ c write(6,*) ' You can only use the functional of'
c write(6,*) ' Ordejon-Mauri for atoms with an even'
c write(6,*) ' number of electrons.'
c endif
c OLD------ call die()
c OLD------ call die("stopping program")
c give one-extra/one-less LWF to odd species in turn with flag secondodd
if (secondodd) then
indexi = ( ( nelectr - 1 ) / 2 )
@ -700,7 +700,7 @@ C If 32 or less electrons, populate lowest s, p, d and f orbitals
write(6,*) 'cspa: Cannot build initial guess in initguess.'
write(6,*) ' Reason: Too many electrons for this routine'
endif
call die()
call die("stopping program")
endif
if (lmaxp .gt. lomaxfis(is)) then
@ -709,7 +709,7 @@ C If 32 or less electrons, populate lowest s, p, d and f orbitals
write(6,*) ' Reason: Max. angular moment for atom ',ia,
. ' is not large enough'
endif
call die()
call die("stopping program")
endif
if (ne .gt. 32) then
@ -717,7 +717,7 @@ C If 32 or less electrons, populate lowest s, p, d and f orbitals
write(6,*) 'cspa: Cannot build initial guess in initguess.'
write(6,*) ' Too many valence electrons in atom ',ia
endif
call die()
call die("stopping program")
endif
if (l .le. lmaxp) then

4
Src/basis_io.F
View File

@ -342,7 +342,7 @@
integer, intent(in):: status
if (status .ne. nf90_noerr) then
print *, trim(nf90_strerror(status))
call die()
call die("stopping program")
endif
end subroutine check
@ -659,7 +659,7 @@
integer, intent(in):: status
if (status .ne. nf90_noerr) then
print *, trim(nf90_strerror(status))
call die()
call die("stopping program")
endif
end subroutine check

18
Src/basis_specs.f
View File

@ -494,7 +494,7 @@ C Sanity checks on values
write(6,'(a,1x,a)')
. "WRONG species symbol in PS.KBprojectors:",
. trim(fdf_bnames(pline,1))
call die()
call die("stopping program")
endif
basp => basis_parameters(isp)
basp%nkbshells = fdf_bintegers(pline,1)
@ -599,7 +599,7 @@ C Sanity checks on values
write(6,'(a,1x,a)')
. "WRONG species symbol in PS.KBprojectors:",
. trim(fdf_bnames(pline,1))
call die()
call die("stopping program")
endif
basp => basis_parameters(isp)
basp%nkbshells = fdf_bintegers(pline,1)
@ -707,7 +707,7 @@ C Sanity checks on values
write(6,'(a,1x,a)')
. "WRONG species symbol in PAO.Basis:",
. trim(fdf_bnames(pline,1))
call die()
call die("stopping program")
endif
basp => basis_parameters(isp)
@ -1183,7 +1183,7 @@ c given by the general input PAO.BasisSize, or its default value.
write(6,'(a,1x,a)')
. "WRONG species symbol in PAO.BasisSizes:",
. trim(fdf_bnames(pline,1))
call die()
call die("stopping program")
else
basp => basis_parameters(isp)
basp%basis_size = fdf_bnames(pline,2)
@ -1358,7 +1358,7 @@ c Reads fdf block. Not necessarily all species have to be given.
if (isp .eq. 0) then
write(6,'(a,1x,a)') "WRONG species symbol in PS.lmax:",
. trim(fdf_bnames(pline,1))
call die()
call die("stopping program")
else
basp => basis_parameters(isp)
basp%lmxkb_requested = fdf_bintegers(pline,1)
@ -1457,7 +1457,7 @@ c (according to atmass subroutine).
. ' TZDP, TZP2, TZ2P',
. ' TZTP, TZP3, TZ3P'
call die()
call die("stopping program")
endif
end subroutine size_name
@ -1482,7 +1482,7 @@ c (according to atmass subroutine).
. 'type_name: Incorrect basis-type option specified,',
. ' active options are:',
. 'NODES','SPLIT','SPLITGAUSS','NONODES','FILTERET'
call die
call die("stopping program")
endif
end subroutine type_name
@ -1513,7 +1513,7 @@ c (according to atmass subroutine).
write(6,'(2a)')
. 'ERROR Fractional semicore charge for species ',
. basp%label
call die()
call die("stopping program")
endif
charge_loc = Zval_vps-Zval
@ -1550,7 +1550,7 @@ c (according to atmass subroutine).
if (basp%bessel) then
write(6,'(2a)') basp%label,
. ' must be in PAO.Basis (it is a floating Bessel function)'
call die()
call die("stopping program")
endif
!
! Set the default max l

8
Src/basis_types.f
View File

@ -587,19 +587,19 @@
lmax = max(lmax,lmaxkb)
if (lmax .gt. lmaxd) then
write(6,*) "Increment lmaxd to ", lmax
call die()
call die("lmaxd too small")
endif
if (nzeta_max .gt. nzetmx) then
write(6,*) "Increment nzetmx to ", nzeta_max
call die()
call die("nzetmx too small")
endif
if (nsemi_max .gt. nsemx) then
write(6,*) "Increment nsemx to ", nsemi_max
call die()
call die("nsemx too small")
endif
if (nkb_max .gt. nkbmx) then
write(6,*) "Increment nkbmx to ", nkb_max
call die()
call die("nkbmx too small")
endif
!
! ALLOCATE old arrrays

4
Src/bsc_cellxc.F
View File

@ -230,7 +230,7 @@ C Start time counter (intended only for debugging and development)
C Check value of mspin
if (mspin.lt.nspin) then
write(6,*) 'cellXC: parameter mspin must be at least ', nspin
call die()
call die("stopping program")
endif
BS(1) = (meshLim(2,1)-meshLim(1,1)+1)*NSM
@ -246,7 +246,7 @@ C be calculated.
write(6,'('' ERROR - number of fine mesh points per '',
& ''Node must be greater than finite difference order '')')
endif
call die()
call die("stopping program")
endif
iDistr = 3

2
Src/chempot.F
View File

@ -236,7 +236,7 @@ C (which will determine the reduce space) -
if (Node.eq.0) then
write(6,*) 'chempot: ERROR: zero neighbors for orbital ',i
endif
CALL DIE()
CALL DIE("stopping program")
endif
nu = numh(mu)

6
Src/coor.F
View File

@ -102,7 +102,7 @@ C Format of atomic coordinates
write(6,"(/,2a)") 'coor: ERROR: Explicit lattice ',
. 'constant is needed for ScaledCartesian format'
endif
call die()
call die("stopping program")
endif
iscale = 2
if (Node.eq.0) then
@ -120,7 +120,7 @@ C Format of atomic coordinates
write(6,"(/,2a)") 'coor: ERROR: Explicit lattice ',
. 'constant is needed for Fractional format'
endif
call die()
call die("stopping program")
endif
iscale = 3
if (Node.eq.0) then
@ -143,7 +143,7 @@ C Format of atomic coordinates
write(6,"('coor: ',72('*'))")
endif
call die()
call die("stopping program")
endif

6
Src/dftu_specs.f
View File

@ -433,7 +433,7 @@
write(6,'(a,1x,a)')
. 'WRONG species symbol in DFTU.proj:',
. trim(fdf_bnames(pline,1))
call die()
call die("stopping program")
endif
basp => basis_parameters(isp)
@ -896,7 +896,7 @@
write(6,'(a,i4)')
. 'dftu_proj_gen: ERROR: Nrmax must be increased to at least',
. nrval
call die
call die("stopping program")
endif
! Read the radial logarithmic mesh
@ -1217,7 +1217,7 @@
. l, ' not bound in the atom'
write(6,'(a)')
. 'dftu_proj_gen: an rc radius must be explicitly given'
call die()
call die("stopping program")
endif
if( abs(energy_shift_dftu) .gt. 1.0d-5 ) then

2
Src/diagk_file.F
View File

@ -241,7 +241,7 @@ C Loop over k points
write(6,"(a,2i6)") "Saved, needed: ", n_eigenvectors,
$ neigneeded
endif
call die()
call die("stopping program")
endif
call timer( 'c-buildD', 1 )

6
Src/fermid.F
View File

@ -144,7 +144,7 @@ C Determine Fermi level
write (6,'(/a)')
. 'Fermid: Bands full, no excitation possible'
endif
call die()
call die("stopping program")
else
#ifdef DEBUG
call write_debug( ' POS fermid' )
@ -157,7 +157,7 @@ C Determine Fermi level
write(6,*) 'Fermid: Not enough states'
write(6,*) 'Fermid: qtot,sumq=',qtot,sumq
endif
call die()
call die("stopping program")
endif
T = max(temp,1.d-6)
Tinv = 1._dp / T
@ -339,7 +339,7 @@ C calculated here if ne < maxe
write(6,*) 'Fermid: ispin,qtot,sumq=',
. ispin,qtot(ispin),sumq(ispin)
endif
call die()
call die("stopping program")
ENDIF
enddo
T = max(temp,1.0d-6)

2
Src/iogrid_netcdf.F90
View File

@ -112,7 +112,7 @@ subroutine set_box_limits(mesh,nsm)
if (Node == 0) then
write(6,*) "Nominal npt: ", npt_mesh, " /= assigned npt:", npt_total
endif
call die()
call die("stopping program")
endif
! JMS: commented out. 2009/02/06

16
Src/libsys/CMakeLists.txt Normal file
View File

@ -0,0 +1,16 @@
#
#
add_library(
${PROJECT_NAME}-libsys
sys.F90
external_entries.f90
)
target_include_directories(
${PROJECT_NAME}-libsys
INTERFACE
${CMAKE_CURRENT_BINARY_DIR}
)

28
Src/libsys/external_entries.f90 Normal file
View File

@ -0,0 +1,28 @@
!
! These are 'external' versions of the routines in module sys
!
subroutine die(str)
use sys, only: die_sys => die
character(len=*), intent(in) :: str
call die_sys(str)
end subroutine die
subroutine bye(str)
use sys, only: bye_sys => bye
character(len=*), intent(in) :: str
call bye_sys(str)
end subroutine bye
subroutine message(level,str)
use sys, only: message_sys => message
character(len=*), intent(in) :: level
character(len=*), intent(in) :: str
call message_sys(level, str)
end subroutine message
subroutine reset_messages_file()
use sys, only: reset_messages_file_sys => reset_messages_file
call reset_messages_file_sys()
end subroutine reset_messages_file

134
Src/libsys/sys.F90 Normal file
View File

@ -0,0 +1,134 @@
! ---
! Copyright (C) 1996-2016 The SIESTA group
! This file is distributed under the terms of the
! GNU General Public License: see COPYING in the top directory
! or http://www.gnu.org/copyleft/gpl.txt .
! See Docs/Contributors.txt for a list of contributors.
! ---
module sys
!
! Termination and messaging routines, MPI aware
! This module is being progressively emptied out
! of functionality, relying instead in properly
! adapted external functions
implicit none
public :: die ! Prints an error message and terminates the program
public :: message ! Prints a message string if node==0
public :: reset_messages_file !
public :: bye ! Cleans up and exits the program
interface
subroutine message_interf(level,str)
character(len=*), intent(in) :: level
character(len=*), intent(in) :: str
end subroutine message_interf
end interface
interface
subroutine reset_messages_file_interf()
end subroutine reset_messages_file_interf
end interface
interface
subroutine die_interf(str)
character(len=*), intent(in) :: str
end subroutine die_interf
end interface
interface
subroutine bye_interf(str)
character(len=*), intent(in) :: str
end subroutine bye_interf
end interface
procedure(die_interf), pointer :: die => simple_die_routine
procedure(bye_interf), pointer :: bye => simple_bye_routine
procedure(message_interf), pointer :: message => simple_message_routine
procedure(reset_messages_file_interf), pointer :: reset_messages_file=> simple_reset_routine
public :: set_die_handler
public :: set_bye_handler
public :: set_message_handler
public :: set_reset_message_handler
private
CONTAINS
subroutine set_die_handler(func)
procedure(die_interf) :: func
die => func
end subroutine set_die_handler
subroutine set_bye_handler(func)
procedure(bye_interf) :: func
bye => func
end subroutine set_bye_handler
subroutine set_message_handler(func)
procedure(message_interf) :: func
message => func
end subroutine set_message_handler
subroutine set_reset_message_handler(func)
procedure(reset_messages_file_interf) :: func
reset_messages_file => func
end subroutine set_reset_message_handler
! auxiliary routine to provide a non-zero exit code
subroutine exit(code)
use iso_c_binding, only: C_INT
integer(C_INT), intent(in) :: code
interface
subroutine c_exit(code) bind(C,name="exit")
use iso_c_binding, only: c_int
integer(c_int), intent(in) :: code
end subroutine c_exit
end interface
call c_exit(code)
end subroutine exit
! --------------------------------
subroutine simple_die_routine(str)
character(len=*), intent(in) :: str
write(0,'(a,a)') "[error]: " // trim(str)
write(6,'(a,a)') "[error]: " // trim(str)
!
call exit(1)
! alternatively
! stop
! In F2018:
! error stop 1
end subroutine simple_die_routine
! --------------------------------
subroutine simple_bye_routine(str)
character(len=*), intent(in) :: str
write(0,'(a,a)') "[bye]: " // trim(str)
write(6,'(a,a)') "[bye]: " // trim(str)
!
call exit(0)
! Alternatively:
! stop
end subroutine simple_bye_routine
! --------------------------------
subroutine simple_message_routine(level,str)
character(len=*), intent(in) :: level
character(len=*), intent(in) :: str
write(0,'(a,a,a)') trim(level) // ": " // trim(str)
write(6,'(a,a,a)') trim(level) // ": " // trim(str)
!
end subroutine simple_message_routine
! --------------------------------
subroutine simple_reset_routine()
!
end subroutine simple_reset_routine
! --------------------------------
end module sys

4
Src/m_broyddj.f90
View File

@ -338,14 +338,14 @@ subroutine dlinds(n,a,np1,ainv,np)
call dgetrf(n,n,ainv,np,ipiv,info)
if (info.ne.0) then
write(6,*) 'Error in DGETRF. INFO:',info
call die()
call die("stopping program")
endif
lwork = n
call dgetri(n,ainv,np,ipiv,work,lwork,info)
if (info.ne.0) then
write(6,*) 'Error in DGETRI. INFO:',info
call die()
call die("stopping program")
endif
end subroutine dlinds

4
Src/m_broyddj_nocomm.f90
View File

@ -404,14 +404,14 @@ subroutine dlinds(n,a,np1,ainv,np)
call dgetrf(n,n,ainv,np,ipiv,info)
if (info.ne.0) then
write(6,*) 'Error in DGETRF. INFO:',info
call die()
call die("stopping program")
endif
lwork = n
call dgetri(n,ainv,np,ipiv,work,lwork,info)
if (info.ne.0) then
write(6,*) 'Error in DGETRI. INFO:',info
call die()
call die("stopping program")
endif
end subroutine dlinds

6
Src/m_digest_nnkp.F90
View File

@ -119,7 +119,7 @@ subroutine read_nnkp( seedname, latvec, reclatvec, numkpoints, &
if( .not. have_nnkp ) then
write(6,'(/,a)') &
& 'read_nnkp: Could not find the file '//trim(seedname)//'.nnkp'
call die()
call die("stopping program")
endif
call io_assign( iu )
@ -151,7 +151,7 @@ subroutine read_nnkp( seedname, latvec, reclatvec, numkpoints, &
if(abs(latvec(i,j)-ucell(i,j))>eps4) then
write(6,*) 'read_nnkp: Something wrong with the real lattice! '
write(6,*) ' latvec(i,j) =',latvec(i,j),' ucell(i,j)=',ucell(i,j)
call die()
call die("stopping program")
endif
enddo
enddo
@ -179,7 +179,7 @@ subroutine read_nnkp( seedname, latvec, reclatvec, numkpoints, &
write(6,*)'read_nnkp: Something wrong with the reciprocal lattice!'
write(6,*)' reclatvec(i,j)=',reclatvec(i,j), &
& ' rcell(i,j)=',rcell(i,j)
call die()
call die("stopping program")
endif
enddo
enddo

10
Src/moremeshsubs.F
View File

@ -1135,7 +1135,7 @@ C Wait for received data and move it to the destination buffer
if (Node.eq.0) then
write(*,*)'ERROR: Wrong parameter for function distMeshData'
endif
call die()
call die("stopping program")
endif
call de_alloc( JS, 'JS', 'distmeshdata' )
@ -1557,7 +1557,7 @@ C We should receive data from process src(icom)-1
if (Node.eq.0) then
write(*,*)'ERROR: Wrong parameter for function distMeshData'
endif
call die()
call die("stopping program")
endif
if ( MaxSize > 0 ) then
@ -1740,7 +1740,7 @@ C We should receive data from process src(icom)-1
if (Node.eq.0) then
write(*,*)'ERROR: Wrong parameter for function distMeshData'
endif
call die()
call die("stopping program")
endif
if (MaxSize.gt.0) then
@ -2014,12 +2014,12 @@ C Local variables
if (.not.associated(mcomm%dst)) then
write(6,*) 'ERROR: Trying to communicate extencil ',
& 'with an uninitialized mesh distribution'
call die()
call die("stopping program")
endif
if (.not.associated(mcomm%src)) then
write(6,*) 'ERROR: Trying to communicate extencil ',
& 'with an uninitialized mesh distribution'
call die()
call die("stopping program")
endif
nullify(SBUF,RBUF)

2
Src/ncdf_io.F90
View File

@ -122,7 +122,7 @@ contains
if (Node == 0) then
write(6,*) "Nominal npt: ", nmesh, " /= assigned npt:", ntot
end if
call die()
call die("stopping program")
end if
end subroutine cdf_init_mesh

5
Src/ncps/src/CMakeLists.txt
View File

@ -20,6 +20,11 @@ target_link_libraries(
${PROJECT_NAME}-libxc-trans
libpsml::libpsml
)
target_link_libraries(
${PROJECT_NAME}-libncps
PRIVATE
${PROJECT_NAME}-libsys
)
target_include_directories(
${PROJECT_NAME}-libncps
INTERFACE

8
Src/psoplib/src/CMakeLists.txt
View File

@ -16,4 +16,12 @@ target_include_directories(
${CMAKE_CURRENT_BINARY_DIR}
)
target_link_libraries(
${PROJECT_NAME}-libpsop
PRIVATE
${PROJECT_NAME}-libsys
)

2
Src/setatomnodes.F
View File

@ -588,7 +588,7 @@ C The lok[xyz] variable below are only necessary when using buffers.
write(6,*) "Try specifying a number of nodes that is ",
. "an exact factor of the number of cells:"
. ,product(nspcell)
call die()
call die("stopping program")
endif
endif
call de_alloc( ncellpernodelist, 'ncellpernodelist',

2
Src/show_distribution.f
View File

@ -40,7 +40,7 @@
write(6,"(a)") "Some processors are idle. Check PARALLEL_DIST"
write(6,"(a)")
$ "You have too many processors for the system size !!!"
call die()
call die("stopping program")
endif
end subroutine show_distribution

12
Src/zmatrix.F
View File

@ -690,7 +690,7 @@ C Check whether any atom info has been read.
write (6,'(A,i3)')
. 'read_Zmatrix: no atoms defined at molecule', m
endif
call die()
call die("stopping program")
endif
C PB END
@ -702,7 +702,7 @@ C Second atom
write(6,'(''read_Zmatrix: molecule nr '',i7,
. ''; atom nr 2'')') m
endif
call die()
call die("stopping program")
endif
endif
@ -716,7 +716,7 @@ C Third atom
write(6,'(''read_Zmatrix: molecule nr '',i7,
. ''; atom nr 3'')') m
endif
call die ()
call die("stopping program")
endif
endif
@ -729,7 +729,7 @@ C Fourth atom and up -> general case
write(6,'(''read_Zmatrix: molecule nr '',i7,
. ''; atom nr '',i7)') m,i-nStart
endif
call die()
call die("stopping program")
endif
if (iZmat(3*i-1).gt.i-1.or.
. iZmat(3*i-1).eq.iZmat(3*i)) then
@ -738,7 +738,7 @@ C Fourth atom and up -> general case
write(6,'(''read_Zmatrix: molecule nr '',i7,
. ''; atom nr '',i7)') m,i-nStart
endif
call die()
call die("stopping program")
endif
if (iZmat(3*i).gt.i-1.or.
. iZmat(3*i).eq.iZmat(3*i-2)) then
@ -747,7 +747,7 @@ C Fourth atom and up -> general case
write(6,'(''read_Zmatrix: molecule nr '',i7,
. ''; atom nr '',i7)') m,i-nStart
endif
call die()
call die("stopping program")
endif
enddo
C End looping over molecules

1
Util/Grid/CMakeLists.txt
View File

@ -94,6 +94,7 @@ install(TARGETS cdf_get_cell RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} )
# To avoid "multiple rules" in Ninja
add_library(aux_fft ${top_src_dir}/m_fft_gpfa.F)
target_link_libraries(aux_fft PRIVATE ${PROJECT_NAME}-libsys)
add_executable(cdf_laplacian
${top_src_dir}/reclat.f