File: /nfs/home/0/users/jenkins/mfix.git/model/error_routine.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: ERROR_ROUTINE (CALL_ROUTINE,MESSAGE,ACTION_CODE,       C
4     !                              MESSAGE_CODE)                           C
5     !  Purpose:  Assist in printing error messages during input processing C
6     !                                                                      C
7     !  Author: P.NICOLETTI                                Date: 25-NOV-91  C
8     !  Reviewer: W. Rogers, M. Syamlal, S. Venkatesan     Date: 29-JAN-92  C
9     !                                                                      C
10     !  Revision Number:                                                    C
11     !  Purpose:  Added myPE identifier in outputs and also replace STOP    C
12     !            with mfix_exit() to abort all processors                  C
13     !                                                                      C
14     !  Author:   Aeolus Res. Inc.                         Date: 04-SEP-99  C
15     !  Reviewer:                                          Date: dd-mmm-yy  C
16     !                                                                      C
17     !  Literature/Document References:                                     C
18     !                                                                      C
19     !  Variables referenced: None                                          C
20     !  Variables modified: None                                            C
21     !                                                                      C
22     !  Local variables: ABORT_CONT                                         C
23     !                                                                      C
24     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
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     ! Action to be taken after error messgase is given.
34     ! > 0 :: Continute
35     ! > 1 :: Abort
36           INTEGER, intent(in) :: ACTION_CODE
37     ! Message code
38     ! - 1 :: Write header, message, and footer.
39     ! - 2 :: Write only the header and message.
40     ! - 3 :: Write only the message and footer.
41           INTEGER, intent(in) ::  MESSAGE_CODE
42     
43     ! Name of routine calling ERROR_ROUTINE. Used in constructing
44     ! the error message header.
45           CHARACTER, intent(in) :: CALL_ROUTINE*(*)
46     
47     ! Message to be written.
48           CHARACTER, intent(in) :: MESSAGE*(*)
49     
50     ! Local Variables
51     ! String used to format integers to characters.
52           CHARACTER(len=16) :: int2char
53     
54     ! Write the header information and passed messaged.
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     ! WRITE OUT TRAILER INFO, UNLESS MESSAGE_CODE = 2
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