1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
!
! Copyright (C) Quantum ESPRESSO group
!
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!----------------------------------------------------------------------------
SUBROUTINE fftx_error__( calling_routine, message, ierr )
!----------------------------------------------------------------------------
!
! ... This is a simple routine which writes an error message to output:
!
USE fft_param
IMPLICIT NONE
!
CHARACTER(LEN=*), INTENT(IN) :: calling_routine, message
! the name of the calling calling_routine
! the output message
INTEGER, INTENT(IN) :: ierr
!
CHARACTER(LEN=6) :: cerr
INTEGER :: info
!
IF( ierr <= 0 ) THEN
RETURN
END IF
!
! ... the error message is written un the "*" unit
!
WRITE( cerr, FMT = '(I6)' ) ierr
WRITE( UNIT = *, FMT = '(/,1X,78("%"))' )
WRITE( UNIT = *, FMT = '(5X,"Error in routine ",A," (",A,"):")' ) &
TRIM(calling_routine), TRIM(ADJUSTL(cerr))
WRITE( UNIT = *, FMT = '(5X,A)' ) TRIM(message)
WRITE( UNIT = *, FMT = '(1X,78("%"),/)' )
!
WRITE( *, '(" stopping ...")' )
!
#if defined(__MPI)
!
CALL mpi_abort(MPI_COMM_WORLD,ierr,info)
!
#endif
!
STOP 1
!
RETURN
!
END SUBROUTINE fftx_error__
|
