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