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