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