File: /nfs/home/0/users/jenkins/mfix.git/model/error_routine.f
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 SUBROUTINE ERROR_ROUTINE(CALL_ROUTINE,MESSAGE,ACTION_CODE,MESSAGE_CODE)
26
27 USE funits
28 USE compar
29 USE mpi_utility
30
31 IMPLICIT NONE
32
33
34
35
36 INTEGER, intent(in) :: ACTION_CODE
37
38
39
40
41 INTEGER, intent(in) :: MESSAGE_CODE
42
43
44
45 CHARACTER, intent(in) :: CALL_ROUTINE*(*)
46
47
48 CHARACTER, intent(in) :: MESSAGE*(*)
49
50
51
52 CHARACTER(len=16) :: int2char
53
54
55 IF (MESSAGE_CODE /= 3 .AND. DMP_LOG) THEN
56 write(*,1000); write(UNIT_LOG,1000)
57 IF(numPEs > 1) THEN
58 int2char=''; write(int2char,*) myPE
59 write(*,1001) trim(adjustl(int2Char)), CALL_ROUTINE
60 write(UNIT_LOG,1001) trim(adjustl(int2Char)), CALL_ROUTINE
61 ELSE
62 write(*,1002) CALL_ROUTINE
63 write(UNIT_LOG,1002) CALL_ROUTINE
64 ENDIF
65
66 WRITE (*, 1005) MESSAGE
67 WRITE (UNIT_LOG, 1005) MESSAGE
68 ENDIF
69
70
71 IF (MESSAGE_CODE /= 2 .AND. DMP_LOG) THEN
72 IF(ACTION_CODE == 0) THEN
73 WRITE (*, 1100)
74 WRITE (UNIT_LOG, 1100)
75 ELSE
76 WRITE (*, 1101)
77 WRITE (UNIT_LOG, 1101)
78 ENDIF
79 ENDIF
80
81 IF (ACTION_CODE == 1) CALL MFIX_EXIT(myPE)
82
83 RETURN
84
85 1000 FORMAT(2/,1X,70('*'))
86 1001 FORMAT(1X,'(PE ',A,'): From : ',A)
87 1002 FORMAT(1X,'From : ',A)
88 1005 FORMAT(1X,'Message : ',A)
89
90 1100 FORMAT(1X,70('*'),2/)
91 1101 FORMAT(/1X,'Aborting execution.',/1X,70('*'),2/)
92
93 END SUBROUTINE ERROR_ROUTINE
94