1 /*
2 $Id$
3 *======================================================================
4 *
5 * DISCLAIMER
6 *
7 * This material was prepared as an account of work sponsored by an
8 * agency of the United States Government. Neither the United States
9 * Government nor the United States Department of Energy, nor Battelle,
10 * nor any of their employees, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR
11 * ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY,
12 * COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, PRODUCT,
13 * SOFTWARE, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD NOT
14 * INFRINGE PRIVATELY OWNED RIGHTS.
15 *
16 * ACKNOWLEDGMENT
17 *
18 * This software and its documentation were produced with Government
19 * support under Contract Number DE-AC06-76RLO-1830 awarded by the United
20 * States Department of Energy. The Government retains a paid-up
21 * non-exclusive, irrevocable worldwide license to reproduce, prepare
22 * derivative works, perform publicly and display publicly by or for the
23 * Government, including the right to distribute to other Government
24 * contractors.
25 *
26 *======================================================================
27 *
28 * -- PEIGS routine (version 2.1) --
29 * Pacific Northwest Laboratory
30 * July 28, 1995
31 *
32 *======================================================================
33 */
34 #include <stdio.h>
35 #include <memory.h>
36 #include <math.h>
37 #include <stdlib.h>
38
39 #define ffabs(a) ((a) >= (0.) ? (a) : (-a))
40
41 #include "globalp.c.h"
42
pgexit(info,msg,proclist,nprocs,work)43 void pgexit( info, msg, proclist, nprocs, work )
44 char *msg;
45 Integer *info, *proclist, *nprocs;
46 DoublePrecision *work;
47 {
48 /*
49 This routine does a parallel, global exit if integer *info is non-zero
50 on any processor in proclist.
51
52 a global combine is performed on abs(*info),
53 if info is non-zero upon return, an exit is called with info = -51.
54
55 info = integer to check. On return info = 1 if info
56 was non-zero on any processor in proclist
57 nprocs = number of processor ids in proclist
58 proclist = array of processor ids on which to check n,
59 there must be no repeated processor ids in proclist.
60 proclist must be identical on all processors in proclist.
61
62 msg = message to print before exiting if n <> 0.
63 work = workspace or length at least bufsiz bytes (see cmbbrf1.h)
64
65
66 */
67
68 static Integer TYPE = 10;
69
70 Integer m;
71
72 extern void gi_sum();
73 extern void xstop_();
74 extern Integer mxmynd_();
75
76 m = ffabs( *info );
77
78 *info = 0;
79
80 if ( *nprocs > 1 )
81 gi_sum( &m, 1, TYPE, proclist[0], *nprocs, proclist, work);
82
83 if ( m != 0 ) {
84 *info = -51;
85 fprintf( stderr, " %s me = %d exiting via pgexit. \n", msg, mxmynd_() );
86 xstop_( info );
87 }
88
89 return;
90 }
91