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