plante.F

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE plante
!                   *****************
!
     &(ival)
!
!***********************************************************************
! SPECIAL   V6P1                                   21/08/2010
!***********************************************************************
!
!brief    CAUSES A DIVIDE CHECK IF IVAL = 0 SUCH THAT THE CALL TREE
!+              IS GIVEN WHEN THE PROGRAM STOPS FOLLOWING DETECTION OF
!+              AN ERROR.
!+
!+              USE INSTEAD OF "STOP"
!
!warning  ALSO EXISTS IN THE BIEF LIBRARY
!warning  CALL TO PLANTE MUST BE FOLLOWED BY A "STOP" SO THAT
!+            THE COMPILER UNDERSTANDS THAT'S THE END
!
!bug      IN THE EVENT OF A COMPILATION ERROR WITH THIS SUBROUTINE
!+            ERASE THE TWO LINES MARKED CJAJ
!
!history  J-M HERVOUET (LNH) ; F  LEPEINTRE (LNH)
!+        17/08/1994
!+        V5P5
!+
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!history Y AUDOUIN (LNHE)
!+       25/05/2015
!+       V7P0
!+       Now crashing properly in parallel
!
!history  S.E.BOURBAN (HRW)
!+        16/09/2016
!+        V7P2
!+   Compatible flushing depending on compiler used
!+   (necessary for Algorithmic Differentiation)
!+   TODO: Create a common function with NESTOR and other flushes.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| IVAL           |-->| INTEGER VALUE, OPTION, SEE CODE BELOW
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_special
#if defined NO_STD_FLUSH || NAGFOR
      USE f90_unix_io, ONLY: flush
#endif /* NO_STD_FLUSH || NAGFOR */
!
#if defined HAVE_MPI
#  if defined HAVE_MPI_MOD
      USE mpi
      IMPLICIT NONE
#  else
      IMPLICIT NONE
      include 'mpif.h'
#  endif
#endif
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: ival
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER icode, ierr
      LOGICAL mpi_is_init
!
!-----------------------------------------------------------------------
!
      WRITE(lu,20)
20    FORMAT(1x,///,1x,'PLANTE: PROGRAM STOPPED AFTER AN ERROR')
!
!-----------------------------------------------------------------------
! PARALLEL MODE
!
!JAJ SETTING EXIT VALUES ACCORDING TO THE IVAL VALUE
!    IN CODE IVAL=0 OR IVAL=1 ARE USED NON-CONSEQUENTLY
!
!     STANDARD F90 :  STOP [n] WHERE N IS A STRING OF NOT MORE
!     THAN FIVE DIGITS OR IS A CHARACTER CONSTANT.
!     HOWEVER, CODE IS NOT ALWAYS SENT TO STDERR
!     (COMPILER DEPENDENT, NAG DOESN'T FOR INSTANCE)
!     ICODE MIGHT BE USED IN A POSSIBLE SYSTEM DEPENDENT EXIT PROCEDURE
#if defined NO_STD_FLUSH
      CALL flush(lu)
#else
      FLUSH(lu)
#endif
#if defined HAVE_MPI
      CALL mpi_initialized(mpi_is_init,icode)
#endif
      IF(ival.LT.0) THEN
        icode = 0      ! JUST ASSUMED FOR NON-ERROR STOP
      ELSEIF(ival.EQ.0.OR.ival.EQ.1) THEN
        icode = 2      ! EXIT IVAL 0 OR 1 INDICATING A "CONTROLLED" ERROR
      ELSE
        icode = 1     ! SOMETHING ELSE? BUT AN ERROR!
      ENDIF
      WRITE(lu,*) 'RETURNING EXIT CODE: ', icode
!
#if defined HAVE_MPI
      IF(mpi_is_init) CALL mpi_abort(mpi_comm_world,icode,ierr)
#endif
      stop 1   ! WHICH IS USUALLY EQUIVALENT TO CALL EXIT(1)
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE plante