xref: /phasta/phSolver/common/phasta.cc (revision b4435cfe26b7e7385c644bc5a8218ede2d6189cd) 
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     if(sizeof(PetscInt) != sizeof(long long int))
168     {
169       //PetscInt and gcorp_t (gen_ncorp.c)
170       //must be the same size. hard-coded for now
171       //FIXME
172 	    if(myrank == 0)
173 	    {
174 		    printf("WARNING: PETSc Index Size Mismatch\n");
175 		    printf("WARNING: Proceed at your own risk\n");
176 	    }
177     }
178     MPI_Barrier(MPI_COMM_WORLD);
179     if(myrank == 0)
180     {
181 	    printf("PETSc Initialized\n");
182 	    fflush(stdout);
183     }
184 #endif
185     workfc.numpe = size;
186     workfc.myrank = myrank;
187 
188 #if (defined WIN32)
189     if(argc > 2 ){
190       catchDebugger();
191     }
192 #endif
193 #if (1) // ALWAYS ( defined LAUNCH_GDB ) && !( defined WIN32 )
194 
195     if ( pauseDebugger ) {
196 
197         int parent_pid = getpid();
198         int gdb_child = fork();
199         cout << "gdb_child" << gdb_child << endl;
200 
201         if( gdb_child == 0 ) {
202 
203             cout << "Debugger Process initiating" << endl;
204             stringstream exec_string;
205 
206 #if ( defined decalp )
207             exec_string <<"xterm -e idb "
208                         << " -pid "<< parent_pid <<" "<< argv[0] << endl;
209 #endif
210 #if ( defined LINUX )
211             exec_string <<"xterm -e gdb"
212                         << " -pid "<< parent_pid <<" "<< argv[0] << endl;
213 #endif
214 #if ( defined SUN4 )
215             exec_string <<"xterm -e dbx "
216                         << " - "<< parent_pid <<" "<< argv[0] << endl;
217 #endif
218 #if ( defined IRIX )
219             exec_string <<"xterm -e dbx "
220                         << " -p "<< parent_pid <<" "<< argv[0] << endl;
221 #endif
222             string s = exec_string.str();
223             system( s.c_str() );
224             exit(0);
225         }
226         catchDebugger();
227     }
228 
229 #endif
230 
231     /* Input data  */
232     if(argc > 1 ){
233         strcpy(inpfilename,argv[1]);
234     } else {
235         strcpy(inpfilename,"solver.inp");
236     }
237     string defaultConf = ".";
238     const char* path_to_config = getenv("PHASTA_CONFIG");
239     if(path_to_config)
240       defaultConf = path_to_config;
241     defaultConf.append("/input.config");
242     string userConf(inpfilename);
243     phSolver::Input ctrl(userConf, defaultConf);
244     initPhastaCommonVars();
245     ierr = input_fform(ctrl);
246     if(!ierr){
247       sprintf(inpfilename,"%d-procs_case/",size);
248       if( chdir( inpfilename ) ) {
249         cerr << "could not change to the problem directory "
250           << inpfilename << endl;
251         return -1;
252       }
253       MPI_Barrier(MPI_COMM_WORLD);
254       setIOparam();
255       outpar.input_mode = outpar.nsynciofiles; //FIXME this is awful
256       outpar.output_mode = outpar.nsynciofiles; //FIXME this is awful
257       input();
258       /* now we can start the solver */
259       proces();
260     }
261     else{
262         printf("error during reading ascii input \n");
263     }
264 #ifdef HAVE_PETSC
265     PetscFinalize();
266 #endif
267     MPI_Barrier(MPI_COMM_WORLD);
268     if ( myrank == 0 ) {
269       printf("phasta.cc - last call before finalize!\n");
270     }
271     if( cdToParent() )
272       return -1;
273     return timdat.lstep;
274 }
275