xref: /petsc/src/sys/objects/init.c (revision 0ca81413ba2e908e73df59769d30584e082b69ad)
1 
2 /*
3 
4    This file defines part of the initialization of PETSc
5 
6   This file uses regular malloc and free because it cannot know
7   what malloc is being used until it has already processed the input.
8 */
9 
10 #include <petscsys.h>        /*I  "petscsys.h"   I*/
11 #include <pthread.h>
12 #if defined(PETSC_HAVE_STDLIB_H)
13 #include <stdlib.h>
14 #endif
15 #if defined(PETSC_HAVE_MALLOC_H)
16 #include <malloc.h>
17 #endif
18 #if defined(PETSC_HAVE_VALGRIND)
19 #include <valgrind/valgrind.h>
20 #endif
21 
22 /* ------------------------Nasty global variables -------------------------------*/
23 /*
24      Indicates if PETSc started up MPI, or it was
25    already started before PETSc was initialized.
26 */
27 PetscBool    PetscBeganMPI         = PETSC_FALSE;
28 PetscBool    PetscInitializeCalled = PETSC_FALSE;
29 PetscBool    PetscFinalizeCalled   = PETSC_FALSE;
30 PetscBool    PetscUseThreadPool    = PETSC_FALSE;
31 PetscBool    PetscThreadGo         = PETSC_TRUE;
32 PetscMPIInt  PetscGlobalRank = -1;
33 PetscMPIInt  PetscGlobalSize = -1;
34 PetscMPIInt  PetscMaxThreads = 2;
35 pthread_t*   PetscThreadPoint;
36 pthread_barrier_t* BarrPoint;
37 PetscErrorCode ithreaderr;
38 int*         pVal;
39 
40 typedef struct {
41   pthread_mutex_t mutex;
42   pthread_cond_t cond;
43   void* (*pfunc)(void*);
44   void** pdata;
45   pthread_barrier_t* pbarr;
46   int iNumJobThreads;
47   int iNumReadyThreads;
48   PetscBool startJob;
49 } sjob;
50 sjob job = {PTHREAD_MUTEX_INITIALIZER,PTHREAD_COND_INITIALIZER,NULL,NULL,NULL,0,0,PETSC_FALSE};
51 
52 pthread_cond_t  main_cond  = PTHREAD_COND_INITIALIZER;
53 
54 void*          PetscThreadFunc(void*);
55 void*          PetscThreadInitialize(PetscInt);
56 PetscErrorCode PetscThreadFinalize(void);
57 void           MainWait(void);
58 PetscErrorCode MainJob(void* (*pFunc)(void*),void**,PetscInt);
59 void* FuncFinish(void*);
60 void* PetscThreadRun(MPI_Comm Comm,void* (*pFunc)(void*),int,pthread_t*,void**);
61 void* PetscThreadStop(MPI_Comm Comm,int,pthread_t*);
62 
63 #if defined(PETSC_USE_COMPLEX)
64 #if defined(PETSC_COMPLEX_INSTANTIATE)
65 template <> class std::complex<double>; /* instantiate complex template class */
66 #endif
67 #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)
68 MPI_Datatype   MPI_C_DOUBLE_COMPLEX;
69 MPI_Datatype   MPI_C_COMPLEX;
70 #endif
71 PetscScalar    PETSC_i;
72 #else
73 PetscScalar    PETSC_i = 0.0;
74 #endif
75 #if defined(PETSC_USE_REAL___FLOAT128)
76 MPI_Datatype   MPIU___FLOAT128 = 0;
77 #endif
78 MPI_Datatype   MPIU_2SCALAR = 0;
79 MPI_Datatype   MPIU_2INT = 0;
80 
81 /*
82      These are needed by petscbt.h
83 */
84 #include <petscbt.h>
85 char      _BT_mask = ' ';
86 char      _BT_c = ' ';
87 PetscInt  _BT_idx  = 0;
88 
89 /*
90        Function that is called to display all error messages
91 */
92 PetscErrorCode  (*PetscErrorPrintf)(const char [],...)          = PetscErrorPrintfDefault;
93 PetscErrorCode  (*PetscHelpPrintf)(MPI_Comm,const char [],...)  = PetscHelpPrintfDefault;
94 #if defined(PETSC_HAVE_MATLAB_ENGINE)
95 PetscErrorCode  (*PetscVFPrintf)(FILE*,const char[],va_list)    = PetscVFPrintf_Matlab;
96 #else
97 PetscErrorCode  (*PetscVFPrintf)(FILE*,const char[],va_list)    = PetscVFPrintfDefault;
98 #endif
99 /*
100   This is needed to turn on/off cusp synchronization */
101 PetscBool   synchronizeCUSP = PETSC_FALSE;
102 
103 /* ------------------------------------------------------------------------------*/
104 /*
105    Optional file where all PETSc output from various prints is saved
106 */
107 FILE *petsc_history = PETSC_NULL;
108 
109 #undef __FUNCT__
110 #define __FUNCT__ "PetscOpenHistoryFile"
111 PetscErrorCode  PetscOpenHistoryFile(const char filename[],FILE **fd)
112 {
113   PetscErrorCode ierr;
114   PetscMPIInt    rank,size;
115   char           pfile[PETSC_MAX_PATH_LEN],pname[PETSC_MAX_PATH_LEN],fname[PETSC_MAX_PATH_LEN],date[64];
116   char           version[256];
117 
118   PetscFunctionBegin;
119   ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
120   if (!rank) {
121     char        arch[10];
122     int         err;
123     PetscViewer viewer;
124 
125     ierr = PetscGetArchType(arch,10);CHKERRQ(ierr);
126     ierr = PetscGetDate(date,64);CHKERRQ(ierr);
127     ierr = PetscGetVersion(version,256);CHKERRQ(ierr);
128     ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
129     if (filename) {
130       ierr = PetscFixFilename(filename,fname);CHKERRQ(ierr);
131     } else {
132       ierr = PetscGetHomeDirectory(pfile,240);CHKERRQ(ierr);
133       ierr = PetscStrcat(pfile,"/.petschistory");CHKERRQ(ierr);
134       ierr = PetscFixFilename(pfile,fname);CHKERRQ(ierr);
135     }
136 
137     *fd = fopen(fname,"a"); if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open file: %s",fname);
138     ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"---------------------------------------------------------\n");CHKERRQ(ierr);
139     ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"%s %s\n",version,date);CHKERRQ(ierr);
140     ierr = PetscGetProgramName(pname,PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
141     ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"%s on a %s, %d proc. with options:\n",pname,arch,size);CHKERRQ(ierr);
142     ierr = PetscViewerASCIIOpenWithFILE(PETSC_COMM_WORLD,*fd,&viewer);CHKERRQ(ierr);
143     ierr = PetscOptionsView(viewer);CHKERRQ(ierr);
144     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
145     ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"---------------------------------------------------------\n");CHKERRQ(ierr);
146     err = fflush(*fd);
147     if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
148   }
149   PetscFunctionReturn(0);
150 }
151 
152 #undef __FUNCT__
153 #define __FUNCT__ "PetscCloseHistoryFile"
154 PetscErrorCode  PetscCloseHistoryFile(FILE **fd)
155 {
156   PetscErrorCode ierr;
157   PetscMPIInt    rank;
158   char           date[64];
159   int            err;
160 
161   PetscFunctionBegin;
162   ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
163   if (!rank) {
164     ierr = PetscGetDate(date,64);CHKERRQ(ierr);
165     ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"---------------------------------------------------------\n");CHKERRQ(ierr);
166     ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"Finished at %s\n",date);CHKERRQ(ierr);
167     ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"---------------------------------------------------------\n");CHKERRQ(ierr);
168     err = fflush(*fd);
169     if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
170     err = fclose(*fd);
171     if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
172   }
173   PetscFunctionReturn(0);
174 }
175 
176 /* ------------------------------------------------------------------------------*/
177 
178 /*
179    This is ugly and probably belongs somewhere else, but I want to
180   be able to put a true MPI abort error handler with command line args.
181 
182     This is so MPI errors in the debugger will leave all the stack
183   frames. The default MP_Abort() cleans up and exits thus providing no useful information
184   in the debugger hence we call abort() instead of MPI_Abort().
185 */
186 
187 #undef __FUNCT__
188 #define __FUNCT__ "Petsc_MPI_AbortOnError"
189 void Petsc_MPI_AbortOnError(MPI_Comm *comm,PetscMPIInt *flag)
190 {
191   PetscFunctionBegin;
192   (*PetscErrorPrintf)("MPI error %d\n",*flag);
193   abort();
194 }
195 
196 #undef __FUNCT__
197 #define __FUNCT__ "Petsc_MPI_DebuggerOnError"
198 void Petsc_MPI_DebuggerOnError(MPI_Comm *comm,PetscMPIInt *flag)
199 {
200   PetscErrorCode ierr;
201 
202   PetscFunctionBegin;
203   (*PetscErrorPrintf)("MPI error %d\n",*flag);
204   ierr = PetscAttachDebugger();
205   if (ierr) { /* hopeless so get out */
206     MPI_Abort(*comm,*flag);
207   }
208 }
209 
210 #undef __FUNCT__
211 #define __FUNCT__ "PetscEnd"
212 /*@C
213    PetscEnd - Calls PetscFinalize() and then ends the program. This is useful if one
214      wishes a clean exit somewhere deep in the program.
215 
216    Collective on PETSC_COMM_WORLD
217 
218    Options Database Keys are the same as for PetscFinalize()
219 
220    Level: advanced
221 
222    Note:
223    See PetscInitialize() for more general runtime options.
224 
225 .seealso: PetscInitialize(), PetscOptionsView(), PetscMallocDump(), PetscMPIDump(), PetscFinalize()
226 @*/
227 PetscErrorCode  PetscEnd(void)
228 {
229   PetscFunctionBegin;
230   PetscFinalize();
231   exit(0);
232   return 0;
233 }
234 
235 PetscBool    PetscOptionsPublish = PETSC_FALSE;
236 extern PetscErrorCode        PetscSetUseTrMalloc_Private(void);
237 extern PetscBool  petscsetmallocvisited;
238 static char       emacsmachinename[256];
239 
240 PetscErrorCode (*PetscExternalVersionFunction)(MPI_Comm) = 0;
241 PetscErrorCode (*PetscExternalHelpFunction)(MPI_Comm)    = 0;
242 
243 #undef __FUNCT__
244 #define __FUNCT__ "PetscSetHelpVersionFunctions"
245 /*@C
246    PetscSetHelpVersionFunctions - Sets functions that print help and version information
247    before the PETSc help and version information is printed. Must call BEFORE PetscInitialize().
248    This routine enables a "higher-level" package that uses PETSc to print its messages first.
249 
250    Input Parameter:
251 +  help - the help function (may be PETSC_NULL)
252 -  version - the version function (may be PETSC_NULL)
253 
254    Level: developer
255 
256    Concepts: package help message
257 
258 @*/
259 PetscErrorCode  PetscSetHelpVersionFunctions(PetscErrorCode (*help)(MPI_Comm),PetscErrorCode (*version)(MPI_Comm))
260 {
261   PetscFunctionBegin;
262   PetscExternalHelpFunction    = help;
263   PetscExternalVersionFunction = version;
264   PetscFunctionReturn(0);
265 }
266 
267 #undef __FUNCT__
268 #define __FUNCT__ "PetscOptionsCheckInitial_Private"
269 PetscErrorCode  PetscOptionsCheckInitial_Private(void)
270 {
271   char           string[64],mname[PETSC_MAX_PATH_LEN],*f;
272   MPI_Comm       comm = PETSC_COMM_WORLD;
273   PetscBool      flg1 = PETSC_FALSE,flg2 = PETSC_FALSE,flg3 = PETSC_FALSE,flg4 = PETSC_FALSE,flag,flgz,flgzout;
274   PetscErrorCode ierr;
275   PetscReal      si;
276   int            i;
277   PetscMPIInt    rank;
278   char           version[256];
279 
280   PetscFunctionBegin;
281   ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
282 
283   /*
284       Setup the memory management; support for tracing malloc() usage
285   */
286   ierr = PetscOptionsHasName(PETSC_NULL,"-malloc_log",&flg3);CHKERRQ(ierr);
287 #if defined(PETSC_USE_DEBUG) && !defined(PETSC_USE_PTHREAD)
288   ierr = PetscOptionsGetBool(PETSC_NULL,"-malloc",&flg1,&flg2);CHKERRQ(ierr);
289   if ((!flg2 || flg1) && !petscsetmallocvisited) {
290 #if defined(PETSC_HAVE_VALGRIND)
291     if (flg2 || !(RUNNING_ON_VALGRIND)) {
292       /* turn off default -malloc if valgrind is being used */
293 #endif
294       ierr = PetscSetUseTrMalloc_Private();CHKERRQ(ierr);
295 #if defined(PETSC_HAVE_VALGRIND)
296     }
297 #endif
298   }
299 #else
300   ierr = PetscOptionsGetBool(PETSC_NULL,"-malloc_dump",&flg1,PETSC_NULL);CHKERRQ(ierr);
301   ierr = PetscOptionsGetBool(PETSC_NULL,"-malloc",&flg2,PETSC_NULL);CHKERRQ(ierr);
302   if (flg1 || flg2 || flg3) {ierr = PetscSetUseTrMalloc_Private();CHKERRQ(ierr);}
303 #endif
304   if (flg3) {
305     ierr = PetscMallocSetDumpLog();CHKERRQ(ierr);
306   }
307   flg1 = PETSC_FALSE;
308   ierr = PetscOptionsGetBool(PETSC_NULL,"-malloc_debug",&flg1,PETSC_NULL);CHKERRQ(ierr);
309   if (flg1) {
310     ierr = PetscSetUseTrMalloc_Private();CHKERRQ(ierr);
311     ierr = PetscMallocDebug(PETSC_TRUE);CHKERRQ(ierr);
312   }
313 
314   flg1 = PETSC_FALSE;
315   ierr = PetscOptionsGetBool(PETSC_NULL,"-malloc_info",&flg1,PETSC_NULL);CHKERRQ(ierr);
316   if (!flg1) {
317     flg1 = PETSC_FALSE;
318     ierr = PetscOptionsGetBool(PETSC_NULL,"-memory_info",&flg1,PETSC_NULL);CHKERRQ(ierr);
319   }
320   if (flg1) {
321     ierr = PetscMemorySetGetMaximumUsage();CHKERRQ(ierr);
322   }
323 
324   /*
325       Set the display variable for graphics
326   */
327   ierr = PetscSetDisplay();CHKERRQ(ierr);
328 
329   /*
330       Determine whether user specified maximum number of threads
331    */
332   ierr = PetscOptionsHasName(PETSC_NULL,"-thread_max",&flg1);CHKERRQ(ierr);
333   if(flg1) {
334     ierr = PetscOptionsGetInt(PETSC_NULL,"-thread_max",&PetscMaxThreads,PETSC_NULL);CHKERRQ(ierr);
335   }
336 
337   /*
338       Determine whether to use thread pool
339    */
340   ierr = PetscOptionsHasName(PETSC_NULL,"-use_thread_pool",&flg1);CHKERRQ(ierr);
341   if(flg1) {
342     PetscUseThreadPool = PETSC_TRUE;
343   }
344   PetscThreadInitialize(PetscMaxThreads);
345   /*
346       Print the PETSc version information
347   */
348   ierr = PetscOptionsHasName(PETSC_NULL,"-v",&flg1);CHKERRQ(ierr);
349   ierr = PetscOptionsHasName(PETSC_NULL,"-version",&flg2);CHKERRQ(ierr);
350   ierr = PetscOptionsHasName(PETSC_NULL,"-help",&flg3);CHKERRQ(ierr);
351   if (flg1 || flg2 || flg3){
352 
353     /*
354        Print "higher-level" package version message
355     */
356     if (PetscExternalVersionFunction) {
357       ierr = (*PetscExternalVersionFunction)(comm);CHKERRQ(ierr);
358     }
359 
360     ierr = PetscGetVersion(version,256);CHKERRQ(ierr);
361     ierr = (*PetscHelpPrintf)(comm,"--------------------------------------------\
362 ------------------------------\n");CHKERRQ(ierr);
363     ierr = (*PetscHelpPrintf)(comm,"%s\n",version);CHKERRQ(ierr);
364     ierr = (*PetscHelpPrintf)(comm,"%s",PETSC_AUTHOR_INFO);CHKERRQ(ierr);
365     ierr = (*PetscHelpPrintf)(comm,"See docs/changes/index.html for recent updates.\n");CHKERRQ(ierr);
366     ierr = (*PetscHelpPrintf)(comm,"See docs/faq.html for problems.\n");CHKERRQ(ierr);
367     ierr = (*PetscHelpPrintf)(comm,"See docs/manualpages/index.html for help. \n");CHKERRQ(ierr);
368     ierr = (*PetscHelpPrintf)(comm,"Libraries linked from %s\n",PETSC_LIB_DIR);CHKERRQ(ierr);
369     ierr = (*PetscHelpPrintf)(comm,"--------------------------------------------\
370 ------------------------------\n");CHKERRQ(ierr);
371   }
372 
373   /*
374        Print "higher-level" package help message
375   */
376   if (flg3){
377     if (PetscExternalHelpFunction) {
378       ierr = (*PetscExternalHelpFunction)(comm);CHKERRQ(ierr);
379     }
380   }
381 
382   /*
383       Setup the error handling
384   */
385   flg1 = PETSC_FALSE;
386   ierr = PetscOptionsGetBool(PETSC_NULL,"-on_error_abort",&flg1,PETSC_NULL);CHKERRQ(ierr);
387   if (flg1) { ierr = PetscPushErrorHandler(PetscAbortErrorHandler,0);CHKERRQ(ierr);}
388   flg1 = PETSC_FALSE;
389   ierr = PetscOptionsGetBool(PETSC_NULL,"-on_error_mpiabort",&flg1,PETSC_NULL);CHKERRQ(ierr);
390   if (flg1) { ierr = PetscPushErrorHandler(PetscMPIAbortErrorHandler,0);CHKERRQ(ierr);}
391   flg1 = PETSC_FALSE;
392   ierr = PetscOptionsGetBool(PETSC_NULL,"-mpi_return_on_error",&flg1,PETSC_NULL);CHKERRQ(ierr);
393   if (flg1) {
394     ierr = MPI_Errhandler_set(comm,MPI_ERRORS_RETURN);CHKERRQ(ierr);
395   }
396   flg1 = PETSC_FALSE;
397   ierr = PetscOptionsGetBool(PETSC_NULL,"-no_signal_handler",&flg1,PETSC_NULL);CHKERRQ(ierr);
398   if (!flg1) {ierr = PetscPushSignalHandler(PetscDefaultSignalHandler,(void*)0);CHKERRQ(ierr);}
399   flg1 = PETSC_FALSE;
400   ierr = PetscOptionsGetBool(PETSC_NULL,"-fp_trap",&flg1,PETSC_NULL);CHKERRQ(ierr);
401   if (flg1) {ierr = PetscSetFPTrap(PETSC_FP_TRAP_ON);CHKERRQ(ierr);}
402 
403   /*
404       Setup debugger information
405   */
406   ierr = PetscSetDefaultDebugger();CHKERRQ(ierr);
407   ierr = PetscOptionsGetString(PETSC_NULL,"-on_error_attach_debugger",string,64,&flg1);CHKERRQ(ierr);
408   if (flg1) {
409     MPI_Errhandler err_handler;
410 
411     ierr = PetscSetDebuggerFromString(string);CHKERRQ(ierr);
412     ierr = MPI_Errhandler_create((MPI_Handler_function*)Petsc_MPI_DebuggerOnError,&err_handler);CHKERRQ(ierr);
413     ierr = MPI_Errhandler_set(comm,err_handler);CHKERRQ(ierr);
414     ierr = PetscPushErrorHandler(PetscAttachDebuggerErrorHandler,0);CHKERRQ(ierr);
415   }
416   ierr = PetscOptionsGetString(PETSC_NULL,"-debug_terminal",string,64,&flg1);CHKERRQ(ierr);
417   if (flg1) { ierr = PetscSetDebugTerminal(string);CHKERRQ(ierr); }
418   ierr = PetscOptionsGetString(PETSC_NULL,"-start_in_debugger",string,64,&flg1);CHKERRQ(ierr);
419   ierr = PetscOptionsGetString(PETSC_NULL,"-stop_for_debugger",string,64,&flg2);CHKERRQ(ierr);
420   if (flg1 || flg2) {
421     PetscMPIInt    size;
422     PetscInt       lsize,*nodes;
423     MPI_Errhandler err_handler;
424     /*
425        we have to make sure that all processors have opened
426        connections to all other processors, otherwise once the
427        debugger has stated it is likely to receive a SIGUSR1
428        and kill the program.
429     */
430     ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
431     if (size > 2) {
432       PetscMPIInt dummy = 0;
433       MPI_Status  status;
434       for (i=0; i<size; i++) {
435         if (rank != i) {
436           ierr = MPI_Send(&dummy,1,MPI_INT,i,109,PETSC_COMM_WORLD);CHKERRQ(ierr);
437         }
438       }
439       for (i=0; i<size; i++) {
440         if (rank != i) {
441           ierr = MPI_Recv(&dummy,1,MPI_INT,i,109,PETSC_COMM_WORLD,&status);CHKERRQ(ierr);
442         }
443       }
444     }
445     /* check if this processor node should be in debugger */
446     ierr  = PetscMalloc(size*sizeof(PetscInt),&nodes);CHKERRQ(ierr);
447     lsize = size;
448     ierr  = PetscOptionsGetIntArray(PETSC_NULL,"-debugger_nodes",nodes,&lsize,&flag);CHKERRQ(ierr);
449     if (flag) {
450       for (i=0; i<lsize; i++) {
451         if (nodes[i] == rank) { flag = PETSC_FALSE; break; }
452       }
453     }
454     if (!flag) {
455       ierr = PetscSetDebuggerFromString(string);CHKERRQ(ierr);
456       ierr = PetscPushErrorHandler(PetscAbortErrorHandler,0);CHKERRQ(ierr);
457       if (flg1) {
458         ierr = PetscAttachDebugger();CHKERRQ(ierr);
459       } else {
460         ierr = PetscStopForDebugger();CHKERRQ(ierr);
461       }
462       ierr = MPI_Errhandler_create((MPI_Handler_function*)Petsc_MPI_AbortOnError,&err_handler);CHKERRQ(ierr);
463       ierr = MPI_Errhandler_set(comm,err_handler);CHKERRQ(ierr);
464     }
465     ierr = PetscFree(nodes);CHKERRQ(ierr);
466   }
467 
468   ierr = PetscOptionsGetString(PETSC_NULL,"-on_error_emacs",emacsmachinename,128,&flg1);CHKERRQ(ierr);
469   if (flg1 && !rank) {ierr = PetscPushErrorHandler(PetscEmacsClientErrorHandler,emacsmachinename);CHKERRQ(ierr);}
470 
471 #if defined(PETSC_USE_SOCKET_VIEWER)
472   /*
473     Activates new sockets for zope if needed
474   */
475   ierr = PetscOptionsHasName(PETSC_NULL,"-zope", &flgz);CHKERRQ(ierr);
476   ierr = PetscOptionsHasName(PETSC_NULL,"-nostdout", &flgzout);CHKERRQ(ierr);
477   if (flgz){
478     int  sockfd;
479     char hostname[256];
480     char username[256];
481     int  remoteport = 9999;
482 
483     ierr = PetscOptionsGetString(PETSC_NULL, "-zope", hostname, 256, &flgz);CHKERRQ(ierr);
484     if (!hostname[0]){
485       ierr = PetscGetHostName(hostname,256);CHKERRQ(ierr);
486     }
487     ierr = PetscOpenSocket(hostname, remoteport, &sockfd);CHKERRQ(ierr);
488     ierr = PetscGetUserName(username, 256);CHKERRQ(ierr);
489     PETSC_ZOPEFD = fdopen(sockfd, "w");
490     if (flgzout){
491       PETSC_STDOUT = PETSC_ZOPEFD;
492       fprintf(PETSC_STDOUT, "<<<user>>> %s\n",username);
493       fprintf(PETSC_STDOUT, "<<<start>>>");
494     } else {
495       fprintf(PETSC_ZOPEFD, "<<<user>>> %s\n",username);
496       fprintf(PETSC_ZOPEFD, "<<<start>>>");
497     }
498   }
499 #endif
500 #if defined(PETSC_USE_SERVER)
501   ierr = PetscOptionsHasName(PETSC_NULL,"-server", &flgz);CHKERRQ(ierr);
502   if (flgz){
503     PetscInt port = PETSC_DECIDE;
504     ierr = PetscOptionsGetInt(PETSC_NULL,"-server",&port,PETSC_NULL);CHKERRQ(ierr);
505     ierr = PetscWebServe(PETSC_COMM_WORLD,(int)port);CHKERRQ(ierr);
506   }
507 #endif
508 
509   /*
510         Setup profiling and logging
511   */
512 #if defined (PETSC_USE_INFO)
513   {
514     char logname[PETSC_MAX_PATH_LEN]; logname[0] = 0;
515     ierr = PetscOptionsGetString(PETSC_NULL,"-info",logname,250,&flg1);CHKERRQ(ierr);
516     if (flg1 && logname[0]) {
517       ierr = PetscInfoAllow(PETSC_TRUE,logname);CHKERRQ(ierr);
518     } else if (flg1) {
519       ierr = PetscInfoAllow(PETSC_TRUE,PETSC_NULL);CHKERRQ(ierr);
520     }
521   }
522 #endif
523 #if defined(PETSC_USE_LOG)
524   mname[0] = 0;
525   ierr = PetscOptionsGetString(PETSC_NULL,"-history",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
526   if (flg1) {
527     if (mname[0]) {
528       ierr = PetscOpenHistoryFile(mname,&petsc_history);CHKERRQ(ierr);
529     } else {
530       ierr = PetscOpenHistoryFile(0,&petsc_history);CHKERRQ(ierr);
531     }
532   }
533 #if defined(PETSC_HAVE_MPE)
534   flg1 = PETSC_FALSE;
535   ierr = PetscOptionsHasName(PETSC_NULL,"-log_mpe",&flg1);CHKERRQ(ierr);
536   if (flg1) PetscLogMPEBegin();
537 #endif
538   flg1 = PETSC_FALSE;
539   flg2 = PETSC_FALSE;
540   flg3 = PETSC_FALSE;
541   ierr = PetscOptionsGetBool(PETSC_NULL,"-log_all",&flg1,PETSC_NULL);CHKERRQ(ierr);
542   ierr = PetscOptionsGetBool(PETSC_NULL,"-log",&flg2,PETSC_NULL);CHKERRQ(ierr);
543   ierr = PetscOptionsHasName(PETSC_NULL,"-log_summary",&flg3);CHKERRQ(ierr);
544   ierr = PetscOptionsHasName(PETSC_NULL,"-log_summary_python",&flg4);CHKERRQ(ierr);
545   if (flg1)                      {  ierr = PetscLogAllBegin();CHKERRQ(ierr); }
546   else if (flg2 || flg3 || flg4) {  ierr = PetscLogBegin();CHKERRQ(ierr);}
547 
548   ierr = PetscOptionsGetString(PETSC_NULL,"-log_trace",mname,250,&flg1);CHKERRQ(ierr);
549   if (flg1) {
550     char name[PETSC_MAX_PATH_LEN],fname[PETSC_MAX_PATH_LEN];
551     FILE *file;
552     if (mname[0]) {
553       sprintf(name,"%s.%d",mname,rank);
554       ierr = PetscFixFilename(name,fname);CHKERRQ(ierr);
555       file = fopen(fname,"w");
556       if (!file) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to open trace file: %s",fname);
557     } else {
558       file = PETSC_STDOUT;
559     }
560     ierr = PetscLogTraceBegin(file);CHKERRQ(ierr);
561   }
562 #endif
563 
564   /*
565       Setup building of stack frames for all function calls
566   */
567 #if defined(PETSC_USE_DEBUG) && !defined(PETSC_USE_PTHREAD)
568   ierr = PetscStackCreate();CHKERRQ(ierr);
569 #endif
570 
571   ierr = PetscOptionsGetBool(PETSC_NULL,"-options_gui",&PetscOptionsPublish,PETSC_NULL);CHKERRQ(ierr);
572 
573   /*
574        Print basic help message
575   */
576   ierr = PetscOptionsHasName(PETSC_NULL,"-help",&flg1);CHKERRQ(ierr);
577   if (flg1) {
578     ierr = (*PetscHelpPrintf)(comm,"Options for all PETSc programs:\n");CHKERRQ(ierr);
579     ierr = (*PetscHelpPrintf)(comm," -help: prints help method for each option\n");CHKERRQ(ierr);
580     ierr = (*PetscHelpPrintf)(comm," -on_error_abort: cause an abort when an error is detected. Useful \n ");CHKERRQ(ierr);
581     ierr = (*PetscHelpPrintf)(comm,"       only when run in the debugger\n");CHKERRQ(ierr);
582     ierr = (*PetscHelpPrintf)(comm," -on_error_attach_debugger [gdb,dbx,xxgdb,ups,noxterm]\n");CHKERRQ(ierr);
583     ierr = (*PetscHelpPrintf)(comm,"       start the debugger in new xterm\n");CHKERRQ(ierr);
584     ierr = (*PetscHelpPrintf)(comm,"       unless noxterm is given\n");CHKERRQ(ierr);
585     ierr = (*PetscHelpPrintf)(comm," -start_in_debugger [gdb,dbx,xxgdb,ups,noxterm]\n");CHKERRQ(ierr);
586     ierr = (*PetscHelpPrintf)(comm,"       start all processes in the debugger\n");CHKERRQ(ierr);
587     ierr = (*PetscHelpPrintf)(comm," -on_error_emacs <machinename>\n");CHKERRQ(ierr);
588     ierr = (*PetscHelpPrintf)(comm,"    emacs jumps to error file\n");CHKERRQ(ierr);
589     ierr = (*PetscHelpPrintf)(comm," -debugger_nodes [n1,n2,..] Nodes to start in debugger\n");CHKERRQ(ierr);
590     ierr = (*PetscHelpPrintf)(comm," -debugger_pause [m] : delay (in seconds) to attach debugger\n");CHKERRQ(ierr);
591     ierr = (*PetscHelpPrintf)(comm," -stop_for_debugger : prints message on how to attach debugger manually\n");CHKERRQ(ierr);
592     ierr = (*PetscHelpPrintf)(comm,"                      waits the delay for you to attach\n");CHKERRQ(ierr);
593     ierr = (*PetscHelpPrintf)(comm," -display display: Location where graphics and debuggers are displayed\n");CHKERRQ(ierr);
594     ierr = (*PetscHelpPrintf)(comm," -no_signal_handler: do not trap error signals\n");CHKERRQ(ierr);
595     ierr = (*PetscHelpPrintf)(comm," -mpi_return_on_error: MPI returns error code, rather than abort on internal error\n");CHKERRQ(ierr);
596     ierr = (*PetscHelpPrintf)(comm," -fp_trap: stop on floating point exceptions\n");CHKERRQ(ierr);
597     ierr = (*PetscHelpPrintf)(comm,"           note on IBM RS6000 this slows run greatly\n");CHKERRQ(ierr);
598     ierr = (*PetscHelpPrintf)(comm," -malloc_dump <optional filename>: dump list of unfreed memory at conclusion\n");CHKERRQ(ierr);
599     ierr = (*PetscHelpPrintf)(comm," -malloc: use our error checking malloc\n");CHKERRQ(ierr);
600     ierr = (*PetscHelpPrintf)(comm," -malloc no: don't use error checking malloc\n");CHKERRQ(ierr);
601     ierr = (*PetscHelpPrintf)(comm," -malloc_info: prints total memory usage\n");CHKERRQ(ierr);
602     ierr = (*PetscHelpPrintf)(comm," -malloc_log: keeps log of all memory allocations\n");CHKERRQ(ierr);
603     ierr = (*PetscHelpPrintf)(comm," -malloc_debug: enables extended checking for memory corruption\n");CHKERRQ(ierr);
604     ierr = (*PetscHelpPrintf)(comm," -options_table: dump list of options inputted\n");CHKERRQ(ierr);
605     ierr = (*PetscHelpPrintf)(comm," -options_left: dump list of unused options\n");CHKERRQ(ierr);
606     ierr = (*PetscHelpPrintf)(comm," -options_left no: don't dump list of unused options\n");CHKERRQ(ierr);
607     ierr = (*PetscHelpPrintf)(comm," -tmp tmpdir: alternative /tmp directory\n");CHKERRQ(ierr);
608     ierr = (*PetscHelpPrintf)(comm," -shared_tmp: tmp directory is shared by all processors\n");CHKERRQ(ierr);
609     ierr = (*PetscHelpPrintf)(comm," -not_shared_tmp: each processor has separate tmp directory\n");CHKERRQ(ierr);
610     ierr = (*PetscHelpPrintf)(comm," -memory_info: print memory usage at end of run\n");CHKERRQ(ierr);
611 #if defined(PETSC_USE_LOG)
612     ierr = (*PetscHelpPrintf)(comm," -get_total_flops: total flops over all processors\n");CHKERRQ(ierr);
613     ierr = (*PetscHelpPrintf)(comm," -log[_all _summary]: logging objects and events\n");CHKERRQ(ierr);
614     ierr = (*PetscHelpPrintf)(comm," -log_trace [filename]: prints trace of all PETSc calls\n");CHKERRQ(ierr);
615 #if defined(PETSC_HAVE_MPE)
616     ierr = (*PetscHelpPrintf)(comm," -log_mpe: Also create logfile viewable through upshot\n");CHKERRQ(ierr);
617 #endif
618     ierr = (*PetscHelpPrintf)(comm," -info <optional filename>: print informative messages about the calculations\n");CHKERRQ(ierr);
619 #endif
620     ierr = (*PetscHelpPrintf)(comm," -v: prints PETSc version number and release date\n");CHKERRQ(ierr);
621     ierr = (*PetscHelpPrintf)(comm," -options_file <file>: reads options from file\n");CHKERRQ(ierr);
622     ierr = (*PetscHelpPrintf)(comm," -petsc_sleep n: sleeps n seconds before running program\n");CHKERRQ(ierr);
623     ierr = (*PetscHelpPrintf)(comm,"-----------------------------------------------\n");CHKERRQ(ierr);
624   }
625 
626   ierr = PetscOptionsGetReal(PETSC_NULL,"-petsc_sleep",&si,&flg1);CHKERRQ(ierr);
627   if (flg1) {
628     ierr = PetscSleep(si);CHKERRQ(ierr);
629   }
630 
631   ierr = PetscOptionsGetString(PETSC_NULL,"-info_exclude",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
632   ierr = PetscStrstr(mname,"null",&f);CHKERRQ(ierr);
633   if (f) {
634     ierr = PetscInfoDeactivateClass(PETSC_NULL);CHKERRQ(ierr);
635   }
636 
637 #if defined(PETSC_HAVE_CUSP)
638   ierr = PetscOptionsHasName(PETSC_NULL,"-log_summary",&flg3);CHKERRQ(ierr);
639   if (flg3) flg1 = PETSC_TRUE;
640   else flg1 = PETSC_FALSE;
641   ierr = PetscOptionsGetBool(PETSC_NULL,"-cusp_synchronize",&flg1,PETSC_NULL);CHKERRQ(ierr);
642   if (flg1) synchronizeCUSP = PETSC_TRUE;
643 #endif
644 
645   PetscFunctionReturn(0);
646 }
647 
648 void* PetscThreadFunc(void* arg) {
649   int ierr,iVal;
650   int* pId = (int*)arg;
651   int ThreadId = *pId;
652   PetscErrorCode iterr;
653 
654   ierr = pthread_mutex_lock(&job.mutex);
655   job.iNumReadyThreads++;
656   if(job.iNumReadyThreads==PetscMaxThreads) {
657     ierr = pthread_cond_signal(&main_cond);
658   }
659   //the while loop needs to have an exit
660   //the 'main' thread can terminate all the threads by performing a broacast
661   //and calling FuncFinish
662   while(PetscThreadGo) {
663     //need to check the condition to ensure we don't have to wait
664     //waiting when you don't have to causes problems
665     //also need to wait if another thread sneaks in and messes with the predicate
666     while(job.startJob==PETSC_FALSE&&job.iNumJobThreads==0) {
667       //upon entry, automically releases the lock and blocks
668       //upon return, has the lock
669       ierr = pthread_cond_wait(&job.cond,&job.mutex);
670     }
671     job.startJob = PETSC_FALSE;
672     job.iNumJobThreads--;
673     job.iNumReadyThreads--;
674     iVal = PetscMaxThreads-job.iNumReadyThreads-1;
675     pthread_mutex_unlock(&job.mutex);
676     if(job.pdata==NULL) {
677       iterr = (PetscErrorCode)(long int)job.pfunc(job.pdata);
678     }
679     else {
680       iterr = (PetscErrorCode)(long int)job.pfunc(job.pdata[iVal]);
681     }
682     if(iterr!=0) {
683       ithreaderr = 1;
684     }
685     //the barrier is necessary BECAUSE: look at job.iNumReadyThreads
686     //what happens if a thread finishes before they all start? BAD!
687     //what happens if a thread finishes before any else start? BAD!
688     pthread_barrier_wait(job.pbarr); //ensures all threads are finished
689     //reset job
690     if(PetscThreadGo) {
691       pthread_mutex_lock(&job.mutex);
692       job.iNumReadyThreads++;
693       if(job.iNumReadyThreads==PetscMaxThreads) {
694 	//signal the 'main' thread that the job is done! (only done once)
695 	ierr = pthread_cond_signal(&main_cond);
696       }
697     }
698   }
699   return NULL;
700 }
701 
702 #undef __FUNCT__
703 #define __FUNCT__ "PetscThreadInitialize"
704 void* PetscThreadInitialize(PetscInt N) {
705   PetscInt i;
706   int status;
707 
708   if(PetscUseThreadPool) {
709     pVal = (int*)malloc(N*sizeof(int));
710     //allocate memory in the heap for the thread structure
711     PetscThreadPoint = (pthread_t*)malloc(N*sizeof(pthread_t));
712     BarrPoint = (pthread_barrier_t*)malloc((N+1)*sizeof(pthread_barrier_t)); //BarrPoint[0] makes no sense, don't use it!
713     job.pdata = (void**)malloc(N*sizeof(void*));
714     for(i=0; i<N; i++) {
715       pVal[i] = i;
716       status = pthread_create(&PetscThreadPoint[i],NULL,PetscThreadFunc,&pVal[i]);
717       //error check to ensure proper thread creation
718       status = pthread_barrier_init(&BarrPoint[i+1],NULL,i+1);
719       //error check
720     }
721   }
722   else {
723   }
724   return NULL;
725 }
726 
727 
728 #undef __FUNCT__
729 #define __FUNCT__ "PetscThreadFinalize"
730 PetscErrorCode PetscThreadFinalize() {
731   int i,ierr;
732   void* jstatus;
733 
734   PetscFunctionBegin;
735 
736   if(PetscUseThreadPool) {
737     MainJob(FuncFinish,NULL,PetscMaxThreads);  //set up job and broadcast work
738     //join the threads
739     for(i=0; i<PetscMaxThreads; i++) {
740       ierr = pthread_join(PetscThreadPoint[i],&jstatus);
741       //do error checking
742     }
743     free(BarrPoint);
744     free(PetscThreadPoint);
745   }
746   else {
747   }
748   PetscFunctionReturn(0);
749 }
750 
751 #undef __FUNCT__
752 #define __FUNCT__ "MainWait"
753 void MainWait() {
754   int ierr;
755   ierr = pthread_mutex_lock(&job.mutex);
756   while(job.iNumReadyThreads<PetscMaxThreads||job.startJob==PETSC_TRUE) {
757     ierr = pthread_cond_wait(&main_cond,&job.mutex);
758   }
759   ierr = pthread_mutex_unlock(&job.mutex);
760 }
761 
762 #undef __FUNCT__
763 #define __FUNCT__ "MainJob"
764 PetscErrorCode MainJob(void* (*pFunc)(void*),void** data,PetscInt n) {
765   int ierr;
766   PetscErrorCode ijoberr = 0;
767   if(PetscUseThreadPool) {
768     MainWait();
769     ierr = pthread_mutex_lock(&job.mutex);
770     job.pfunc = pFunc;
771     job.pdata = data;
772     job.pbarr = &BarrPoint[n];
773     job.iNumJobThreads = n;
774     job.startJob = PETSC_TRUE;
775     ierr = pthread_cond_broadcast(&job.cond);
776     ierr = pthread_mutex_unlock(&job.mutex);
777     if(pFunc!=FuncFinish) {
778       MainWait(); //why wait after? guarantees that job gets done
779     }
780   }
781   else {
782     pthread_t* apThread = (pthread_t*)malloc(n*sizeof(pthread_t));
783     PetscThreadRun(MPI_COMM_WORLD,pFunc,n,apThread,data);
784     PetscThreadStop(MPI_COMM_WORLD,n,apThread); //ensures that all threads are finished with the job
785     free(apThread);
786   }
787   if(ithreaderr) {
788     ijoberr = ithreaderr;
789   }
790   return ijoberr;
791 }
792 
793 void* FuncFinish(void* arg) {
794   PetscThreadGo = PETSC_FALSE;
795   return(0);
796 }
797