xref: /phasta/M2NFixBnd/src/error.f (revision 595995161822a203c8467e0e4a253d7bd7d6df32)
1*59599516SKenneth E. Jansen        subroutine error (routin, variab, num)
2*59599516SKenneth E. Jansenc
3*59599516SKenneth E. Jansenc----------------------------------------------------------------------
4*59599516SKenneth E. Jansenc
5*59599516SKenneth E. Jansenc This utility routine prints out the error and stops the program.
6*59599516SKenneth E. Jansenc
7*59599516SKenneth E. Jansenc input:
8*59599516SKenneth E. Jansenc  routin       : name of the routine where the error occurred
9*59599516SKenneth E. Jansenc  variab       : an 8-character error message
10*59599516SKenneth E. Jansenc  num          : any integer number associated with the error
11*59599516SKenneth E. Jansenc
12*59599516SKenneth E. Jansenc Farzin Shakib, Summer 1985.
13*59599516SKenneth E. Jansenc----------------------------------------------------------------------
14*59599516SKenneth E. Jansenc
15*59599516SKenneth E. Jansen        include "commonM2NFixBnd.h"
16*59599516SKenneth E. Jansen        include "mpif.h"
17*59599516SKenneth E. Jansenc
18*59599516SKenneth E. Jansen        character*8 routin, variab
19*59599516SKenneth E. Jansenc
20*59599516SKenneth E. Jansen        data ierchk /0/
21*59599516SKenneth E. Jansenc
22*59599516SKenneth E. Jansenc.... check for redundant error
23*59599516SKenneth E. Jansenc
24*59599516SKenneth E. Jansen        if (ierchk .eq. 1) stop
25*59599516SKenneth E. Jansen        ierchk = 1
26*59599516SKenneth E. Jansen
27*59599516SKenneth E. Jansen        if(myrank.eq.master) then
28*59599516SKenneth E. Jansenc
29*59599516SKenneth E. Jansenc.... open file
30*59599516SKenneth E. Jansenc
31*59599516SKenneth E. Jansen           ferror='error.log'
32*59599516SKenneth E. Jansen           open (unit=ierror, file=ferror, status='unknown')
33*59599516SKenneth E. Jansenc
34*59599516SKenneth E. Jansenc.... print the error
35*59599516SKenneth E. Jansenc
36*59599516SKenneth E. Jansen           write (*,1000) title, routin, variab, num
37*59599516SKenneth E. Jansen           if (num .ne. 0) write (ierror,1000) title, routin, variab,num
38*59599516SKenneth E. Jansen           if (num .eq. 0) write (ierror,1000) title, routin, variab
39*59599516SKenneth E. Jansenc
40*59599516SKenneth E. Jansenc.... halt the process
41*59599516SKenneth E. Jansenc
42*59599516SKenneth E. Jansen           close (ierror)
43*59599516SKenneth E. Jansen        endif
44*59599516SKenneth E. Jansen
45*59599516SKenneth E. Jansenc        WRITE(6,'(A,G14.6)') 'Life: ',death - birth
46*59599516SKenneth E. Jansen
47*59599516SKenneth E. Jansen        if (numpe > 1) then
48*59599516SKenneth E. Jansen           call MPI_ABORT(MPI_COMM_WORLD)
49*59599516SKenneth E. Jansen        endif
50*59599516SKenneth E. Jansen
51*59599516SKenneth E. Jansen
52*59599516SKenneth E. Jansen1000    format(' ',a80,//,
53*59599516SKenneth E. Jansen     &         ' ****** Error occurred in routine <',a8,'>',/,
54*59599516SKenneth E. Jansen     &          '  Error code :',a8,:,' : ',i8,//)
55*59599516SKenneth E. Jansen        end
56