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