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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
/* ---------------------------------------------------------------------
*
* -- PBLAS auxiliary routine (version 2.0) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* April 1, 1998
*
* ---------------------------------------------------------------------
*/
/*
* Include files
*/
#ifdef TestingPblas
#include "../SRC/pblas.h"
#include "../SRC/PBpblas.h"
#include "../SRC/PBtools.h"
#include "../SRC/PBblacs.h"
#include "../SRC/PBblas.h"
#else
#include "../pblas.h"
#include "../PBpblas.h"
#include "../PBtools.h"
#include "../PBblacs.h"
#include "../PBblas.h"
#endif
/*
* ---------------------------------------------------------------------
* FORTRAN <-> C interface
* ---------------------------------------------------------------------
*
* These macros identifies how the PBLAS will be called as follows:
*
* _F2C_ADD_: the FORTRAN compiler expects the name of C functions to be
* in all lower case and to have an underscore postfixed it (Suns, Intel
* compilers expect this).
*
* _F2C_NOCHANGE: the FORTRAN compiler expects the name of C functions
* to be in all lower case (IBM RS6K compilers do this).
*
* _F2C_UPCASE: the FORTRAN compiler expects the name of C functions
* to be in all upcase. (Cray compilers expect this).
*
* _F2C_F77ISF2C: the FORTRAN compiler in use is f2c, a FORTRAN to C
* converter.
*/
#if (_F2C_CALL_ == _F2C_ADD_ )
#define PB_NoAbort pb_noabort_
#endif
#if (_F2C_CALL_ == _F2C_UPCASE )
#define PB_NoAbort PB_NOABORT
#endif
#if (_F2C_CALL_ == _F2C_NOCHANGE )
#define PB_NoAbort pb_noabort
#endif
#if (_F2C_CALL_ == _F2C_F77ISF2C )
#define PB_NoAbort pb_noabort__
#endif
#ifdef __STDC__
void PB_Cwarn( int ICTXT, int LINE, char * ROUT, char * FORM, ... )
#else
void PB_Cwarn( va_alist )
va_dcl
#endif
{
/*
* Purpose
* =======
*
* PB_Cwarn is an error handler for the PBLAS routines. This routine
* displays an error message on stderr.
*
* Arguments
* =========
*
* ICTXT (local input) INTEGER
* On entry, ICTXT specifies the BLACS context handle, indica-
* ting the global context of the operation. The context itself
* is global, but the value of ICTXT is local.
*
* LINE (local input) INTEGER
* On entry, LINE specifies the line number in the file where
* the error has occured. When LINE is not a valid line number,
*
* ROUT (global input) pointer to CHAR
* On entry, ROUT specifies the name of the routine calling this
* error handler.
*
* FORM (local input) pointer to CHAR
* On entry, FORM is a control string specifying the format
* conversion of its following arguments.
*
* ... (local input)
* On entry, FORM is a control string specifying the format
* On entry, the expressions that are to be evaluated and con-
* verted according to the formats in the control string FORM
* and then placed in the output stream.
*
* -- Written on April 1, 1998 by
* R. Clint Whaley, University of Tennessee, Knoxville 37996, USA.
*
* ---------------------------------------------------------------------
*/
va_list argptr;
int iam, mycol, myrow, npcol, nprow;
char cline[100];
/* ..
* .. External Functions ..
*/
#ifdef TestingPblas
#ifdef __STDC__
int PB_NoAbort( int * );
#else
int PB_NoAbort();
#endif
#endif
#ifdef __STDC__
va_start( argptr, FORM );
#else
char * ROUT, * FORM;
int ICTXT, LINE;
/* ..
* .. Executable Statements ..
*
*/
va_start( argptr );
ICTXT = va_arg( argptr, int );
LINE = va_arg( argptr, int );
ROUT = va_arg( argptr, char * );
FORM = va_arg( argptr, char * );
#endif
#ifdef TestingPblas
/*
* For testing purpose only, the error is reported, but the program execution
* is not terminated
*/
if( PB_NoAbort( &ICTXT ) ) return;
#endif
vsprintf( cline, FORM, argptr );
va_end( argptr );
Cblacs_gridinfo( ICTXT, &nprow, &npcol, &myrow, &mycol );
if( nprow != -1 ) iam = Cblacs_pnum( ICTXT, myrow, mycol );
else iam = -1;
/*
* Display an error message
*/
if( LINE <= 0 )
(void) fprintf( stderr, "%s'%s'\n%s{%d,%d}, %s%d, %s%d%s'%s'.\n\n",
"PBLAS ERROR ", cline, "from ", myrow, mycol, "pnum=",
iam, "Contxt=", ICTXT, ", in routine ", ROUT );
else
(void) fprintf( stderr, "%s'%s'\n%s{%d,%d}, %s%d, %s%d%s%d%s'%s'.\n\n",
"PBLAS ERROR ", cline, "from ", myrow, mycol, "pnum=",
iam, "Contxt=", ICTXT, ", on line ", LINE,
" of routine ", ROUT );
/*
* End of PB_Cwarn
*/
}
|
