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