abor1_sfx.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #############################################################
      SUBROUTINE abor1_sfx(YTEXT)
!     #############################################################
!
!!****  *ABOR1_SFX* - abor1 subroutine
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      P. Le Moigne   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    06/2008 
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_surfex_mpi, ONLY : nrank, nproc
USE modd_surfex_omp, ONLY : nblock, nblocktot
USE modd_surf_conf,  ONLY : cprogname, csoftware
!
USE modi_get_luout
USE modi_close_file
!      
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=*),  INTENT(IN)  :: ytext
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
 CHARACTER(LEN=6)  :: yprogram   
 CHARACTER(LEN=20) :: ystring
INTEGER           :: iluout         ! logical unit of output file      
REAL(KIND=JPRB) :: zhook_handle
!
#ifdef SFX_ARO
#include "abor1.intfb.h"
#endif
!-------------------------------------------------------------------------------
!
!* get output listing file logical unit
!
IF (lhook) CALL dr_hook('ABOR1_SFX',0,zhook_handle)
yprogram = cprogname
!      
 CALL get_luout(yprogram,iluout)
!
IF (yprogram=='ASCII ' .OR. yprogram=='TEXTE ' .OR. yprogram=='BINARY' .OR. yprogram=='NC    ') THEN
   IF ( nproc>1 .OR. nblocktot>1 ) &
     WRITE(*,*)"MPI TASK NUMBER = ",nrank,", OMP THREAD NUMBER = ",nblock
   WRITE(*,*)ytext
   ystring='LISTING_'//trim(csoftware)//'.txt'
   WRITE(*,*)'-------------------------------------------------------------------------------'
   WRITE(*,*) 'MORE DETAILS ABOUT THE CRASH IN THE OUTPUT LISTING FILE: ', trim(ystring)
   WRITE(*,*)'-------------------------------------------------------------------------------'   
ENDIF
!
WRITE(iluout,*) '---------------------------------------------------------------------------'
WRITE(iluout,*) '---------------------------------------------------------------------------'
WRITE(iluout,*) '--------------------   FATAL ERROR in SURFEX  -----------------------------'
WRITE(iluout,*) '---------------------------------------------------------------------------'
WRITE(iluout,*) '---------------------------------------------------------------------------'
WRITE(iluout,*) '-                                                                         -'
WRITE(iluout,*)ytext
WRITE(iluout,*) '-                                                                         -'
WRITE(iluout,*) '---------------------------------------------------------------------------'
WRITE(iluout,*) '---------------------------------------------------------------------------'
 CALL close_file(yprogram,iluout)
!
#ifdef SFX_ARO
call abor1('abort by abor1_sfx')
#else
 write(0,*) "aborted with text:",trim(ytext),"|"
 CALL abort
stop
#endif
IF (lhook) CALL dr_hook('ABOR1_SFX',1,zhook_handle)
!
END SUBROUTINE abor1_sfx