132 lines
3.6 KiB
Fortran
132 lines
3.6 KiB
Fortran
! ---
|
|
! 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.
|
|
! ---
|
|
! pxf.F90 - assortment of Fortran wrappers to various
|
|
! unix-y system calls.
|
|
!
|
|
! Copyright Toby White, <tow21@cam.ac.uk> 2005
|
|
|
|
! The name pxf is intended to be reminiscent of the POSIX
|
|
! fortran interfaces defined by IEEE 1003.9-1992, although
|
|
! in fact I don't think that either flush or abort were
|
|
! covered by said standard.
|
|
|
|
! Of the preprocessor defines used here, only xlF is
|
|
! automatically defined by the appropriate compiler. All
|
|
! others must be defined by some other mechanism - I
|
|
! recommend autoconf.
|
|
|
|
|
|
! FLUSH: flushes buffered output on a given unit. Not guaranteed
|
|
! to do anything at all (particularly under MPI when even FLUSHed
|
|
! buffers may not make it to the host cpu after an abort.
|
|
!
|
|
! IMPLEMENTATION: in F2003, this is a native operation called by the
|
|
! FLUSH statement.
|
|
! In almost every compiler, there is a FLUSH intrinsic subroutine
|
|
! available which takes one argument, the unit to be flushed.
|
|
! (some will flush all open units when no argument is given - this
|
|
! facility is not used here.
|
|
! NAG complicates matters by having to USE a module to get at flush.
|
|
!
|
|
! If no FLUSH is available, the subroutine is a no-op.
|
|
|
|
!! UPDATE: We assume F2003
|
|
#ifndef SIESTA__NO_F2003
|
|
subroutine pxfflush(unit)
|
|
implicit none
|
|
integer, intent(in) :: unit
|
|
flush(unit)
|
|
end subroutine pxfflush
|
|
#else
|
|
subroutine pxfflush(unit)
|
|
#ifdef __NAG__
|
|
use f90_unix_io, only : flush
|
|
#endif
|
|
implicit none
|
|
integer, intent(in) :: unit
|
|
#if defined(F2003)
|
|
flush(unit)
|
|
#elif defined(GFORTRAN)
|
|
call flush(unit)
|
|
#elif defined(__GFORTRAN__)
|
|
call flush(unit)
|
|
#elif defined(XLF)
|
|
if (unit.eq.6 .or. unit.eq.0) then
|
|
call flush_(unit)
|
|
else
|
|
flush(unit)
|
|
endif
|
|
#elif defined (FC_HAVE_FLUSH)
|
|
call flush(unit)
|
|
#elif defined (ALTIX)
|
|
flush(unit)
|
|
call flush(unit)
|
|
#else
|
|
continue
|
|
#endif
|
|
end subroutine pxfflush
|
|
#endif
|
|
|
|
! ABORT: terminates program execution in such a way that a backtrace
|
|
! is produced. (see abort() in the C Standard Library). No arguments.
|
|
!
|
|
! IMPLEMENTATION: In F2003, the C interoperability features mean that
|
|
! the abort in stdlib.h is available to be linked against.
|
|
! In several other compilers an ABORT intrinsic subroutine is available.
|
|
! Again, NAG complicates matters by needing to USE a module.
|
|
!
|
|
! In the case where no native ABORT can be found, we emulate one
|
|
! by dereferencing a null pointer. This has reliably produced coredumps
|
|
! on every platform I've tried it with. Just in case it doesn't (it need
|
|
! not even stop execution) a stop is given to force termination.
|
|
|
|
!! UPDATE: We assume F2003
|
|
#ifndef SIESTA_NO_F2003
|
|
subroutine pxfabort()
|
|
interface
|
|
subroutine abort() bind(c)
|
|
end subroutine abort
|
|
end interface
|
|
call abort()
|
|
end subroutine pxfabort
|
|
|
|
#else
|
|
|
|
subroutine pxfabort()
|
|
#ifdef __NAG__
|
|
use f90_unix_proc, only : abort
|
|
#endif
|
|
|
|
#ifdef F2003
|
|
interface
|
|
subroutine abort() bind(c)
|
|
end subroutine abort
|
|
end interface
|
|
call abort()
|
|
#elif defined(GFORTRAN)
|
|
call abort()
|
|
#elif defined(__GFORTRAN__)
|
|
call abort()
|
|
#elif defined(XLF)
|
|
call abort_()
|
|
#elif defined(FC_HAVE_ABORT)
|
|
call abort()
|
|
#elif defined(ALTIX)
|
|
call abort()
|
|
#else
|
|
Integer, Pointer :: i
|
|
i=>null()
|
|
Print*,i
|
|
#endif
|
|
|
|
stop
|
|
|
|
end subroutine pxfabort
|
|
#endif
|
|
|