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