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