xref: /phasta/phSolver/common/phasta.cc (revision 6dec897590ea7451b200e0f9bd1df35a683b735b) 
1 #define OMPI_SKIP_MPICXX 1
2 #include <mpi.h>
3 #include <stdio.h>
4 #include <stdlib.h>
5 #include <string.h>
6 #include <cassert>
7 #ifdef HAVE_PETSC
8 #include <petscsys.h>
9 #include <petscviewer.h>
10 #endif
11 #include <sys/types.h>
12 #include <sys/stat.h>
13 
14 #include "common_c.h"
15 #include "Input.h"
16 #include "phstream.h"
17 #include "streamio.h"
18 
19 #if !(defined IOSTREAMH)
20 #include <iostream>
21 #include <sstream>
22 using namespace std;
23 #endif
24 
25 #include <FCMangle.h>
26 #define input FortranCInterface_GLOBAL_(input,INPUT)
27 #define proces FortranCInterface_GLOBAL_(proces,PROCES)
28 #define timer FortranCInterface_GLOBAL_(timer,TIMER)
29 
30 #ifdef intel
31 #include <direct.h>
32 #define chdir _chdir
33 #else
34 #include <unistd.h>
35 #endif
36 
37 extern "C" char phasta_iotype[80];
38 char phasta_iotype[80];
39 
40 extern int SONFATH;
41 extern "C" void proces();
42 extern "C" void input();
43 extern int input_fform(phSolver::Input&);
44 extern void setIOparam(); // For SyncIO
45 extern "C" void initPhastaCommonVars();
46 
47 int myrank; /* made file global for ease in debugging */
48 
49 void
50 catchDebugger() {
51     while (1) {
52       int debuggerPresent=0;
53       int fakeSTOP = 1; // please stop HERE and assign as next line
54       // assign or set debuggerPresent=1
55       if(debuggerPresent) {
56         break;
57       }
58     }
59 }
60 
61 // some useful debugging functions
62 
63 void
64 pdarray( void* darray , int start, int end ) {
65     for( int i=start; i < end; i++ ){
66         cout << ((double*)darray)[i] << endl;
67     }
68 }
69 
70 void
71 piarray( void* iarray , int start, int end ) {
72     for( int i=start; i < end; i++ ){
73         cout << ((int*)iarray)[i] << endl;
74     }
75 }
76 
77 namespace {
78   int cdToParent() {
79     if( chdir("..") ) {
80       fprintf(stderr,"could not change to the parent directory\n");
81       return 1;
82     } else {
83       return 0;
84     }
85   }
86   int run(phSolver::Input& ctrl) {
87     int size,ierr;
88     char inpfilename[100];
89     MPI_Comm_size (MPI_COMM_WORLD, &size);
90     MPI_Comm_rank (MPI_COMM_WORLD, &myrank);
91 
92     workfc.numpe = size;
93     workfc.myrank = myrank;
94 
95     initPhastaCommonVars();
96     /* Input data  */
97     ierr = input_fform(ctrl);
98     if(!ierr){
99       sprintf(inpfilename,"%d-procs_case/",size);
100       if( chdir( inpfilename ) ) {
101         cerr << "could not change to the problem directory "
102           << inpfilename << endl;
103         return -1;
104       }
105       MPI_Barrier(MPI_COMM_WORLD);
106       input();
107       /* now we can start the solver */
108       proces();
109     }
110     else{
111       printf("error during reading ascii input \n");
112     }
113     MPI_Barrier(MPI_COMM_WORLD);
114     if ( myrank == 0 ) {
115       printf("phasta.cc - last call before finalize!\n");
116     }
117     if( cdToParent() )
118       return -1;
119     return timdat.lstep;
120   }
121 }
122 
123 int phasta(phSolver::Input& ctrl) {
124   outpar.input_mode = 0; //FIXME magic value for posix
125   outpar.output_mode = 0; //FIXME magic value for posix
126   return run(ctrl);
127 }
128 
129 int phasta(phSolver::Input& ctrl, grstream grs) {
130   assert(grs);
131   outpar.input_mode = -1; //FIXME magic value for streams
132   outpar.output_mode = 1; //FIXME magic value for syncio
133   streamio_set_gr(grs);
134   return run(ctrl);
135 }
136 
137 int phasta(phSolver::Input& ctrl, RStream* rs) {
138   fprintf(stderr, "HEY! if you see this email Cameron and tell him "
139       "to implement %s(...) on line %d of %s "
140       "... returning an error\n", __func__, __LINE__, __FILE__);
141   return -1;
142 }
143 
144 int phasta(phSolver::Input& ctrl, GRStream* grs, RStream* rs) {
145   outpar.input_mode = -1; //FIXME magic value for streams
146   outpar.output_mode = -1; //FIXME magic value for streams
147   assert(grs);
148   assert(rs);
149   streamio_set_gr(grs);
150   streamio_set_r(rs);
151   return run(ctrl);
152 }
153 
154 int phasta( int argc, char *argv[] ) {
155     int size,ierr;
156     char inpfilename[100];
157     char* pauseDebugger = getenv("catchDebugger");
158     MPI_Comm_size (MPI_COMM_WORLD, &size);
159     MPI_Comm_rank (MPI_COMM_WORLD, &myrank);
160 
161 #ifdef HAVE_PETSC
162     PETSC_COMM_WORLD=MPI_COMM_WORLD;
163     PetscInitialize(&argc,&argv,PETSC_NULL,PETSC_NULL);
164     PetscInitializeFortran();
165     PetscPopSignalHandler(); //Let us segfault in peace ;-)
166     PetscOptionsView(NULL,PETSC_VIEWER_STDOUT_WORLD);
167 // ok with Master    PetscOptionsView(NULL,PETSC_VIEWER_STDOUT_WORLD);
168 // ok with 3.6x    PetscOptionsView(PETSC_VIEWER_STDOUT_WORLD);
169     MPI_Barrier(MPI_COMM_WORLD);
170     if(myrank == 0)
171     {
172 	    printf("PETSc Initialized\n");
173 	    fflush(stdout);
174     }
175 #endif
176     workfc.numpe = size;
177     workfc.myrank = myrank;
178 
179 #if (defined WIN32)
180     if(argc > 2 ){
181       catchDebugger();
182     }
183 #endif
184 #if (1) // ALWAYS ( defined LAUNCH_GDB ) && !( defined WIN32 )
185 
186     if ( pauseDebugger ) {
187 
188         int parent_pid = getpid();
189         int gdb_child = fork();
190         cout << "gdb_child" << gdb_child << endl;
191 
192         if( gdb_child == 0 ) {
193 
194             cout << "Debugger Process initiating" << endl;
195             stringstream exec_string;
196 
197 #if ( defined decalp )
198             exec_string <<"xterm -e idb "
199                         << " -pid "<< parent_pid <<" "<< argv[0] << endl;
200 #endif
201 #if ( defined LINUX )
202             exec_string <<"xterm -e gdb"
203                         << " -pid "<< parent_pid <<" "<< argv[0] << endl;
204 #endif
205 #if ( defined SUN4 )
206             exec_string <<"xterm -e dbx "
207                         << " - "<< parent_pid <<" "<< argv[0] << endl;
208 #endif
209 #if ( defined IRIX )
210             exec_string <<"xterm -e dbx "
211                         << " -p "<< parent_pid <<" "<< argv[0] << endl;
212 #endif
213             string s = exec_string.str();
214             system( s.c_str() );
215             exit(0);
216         }
217         catchDebugger();
218     }
219 
220 #endif
221 
222     /* Input data  */
223     if(argc > 1 ){
224         strcpy(inpfilename,argv[1]);
225     } else {
226         strcpy(inpfilename,"solver.inp");
227     }
228     string defaultConf = ".";
229     const char* path_to_config = getenv("PHASTA_CONFIG");
230     if(path_to_config)
231       defaultConf = path_to_config;
232     defaultConf.append("/input.config");
233     string userConf(inpfilename);
234     phSolver::Input ctrl(userConf, defaultConf);
235     initPhastaCommonVars();
236     ierr = input_fform(ctrl);
237     if(!ierr){
238       sprintf(inpfilename,"%d-procs_case/",size);
239       if( chdir( inpfilename ) ) {
240         cerr << "could not change to the problem directory "
241           << inpfilename << endl;
242         return -1;
243       }
244       MPI_Barrier(MPI_COMM_WORLD);
245       setIOparam();
246       outpar.input_mode = outpar.nsynciofiles; //FIXME this is awful
247       outpar.output_mode = outpar.nsynciofiles; //FIXME this is awful
248       input();
249       /* now we can start the solver */
250       proces();
251     }
252     else{
253         printf("error during reading ascii input \n");
254     }
255 #ifdef HAVE_PETSC
256     PetscFinalize();
257 #endif
258     MPI_Barrier(MPI_COMM_WORLD);
259     if ( myrank == 0 ) {
260       printf("phasta.cc - last call before finalize!\n");
261     }
262     if( cdToParent() )
263       return -1;
264     return timdat.lstep;
265 }
266