1 2 #include "zpetsc.h" 3 #include "petscsys.h" 4 #include "petscmatlab.h" 5 6 void *PETSCNULLPOINTERADDRESS = PETSC_NULL; 7 8 #ifdef PETSC_HAVE_FORTRAN_CAPS 9 #define petscpopsignalhandler_ PETSCPOPSIGNALHANDLER 10 #define petscgetcputime_ PETSCGETCPUTIME 11 #define petscfopen_ PETSCFOPEN 12 #define petscfclose_ PETSCFCLOSE 13 #define petscfprintf_ PETSCFPRINTF 14 #define petscsynchronizedfprintf_ PETSCSYNCHRONIZEDFPRINTF 15 #define petscprintf_ PETSCPRINTF 16 #define petscsynchronizedprintf_ PETSCSYNCHRONIZEDPRINTF 17 #define petscsynchronizedflush_ PETSCSYNCHRONIZEDFLUSH 18 #define chkmemfortran_ CHKMEMFORTRAN 19 #define petscattachdebugger_ PETSCATTACHDEBUGGER 20 #define petscobjectsetname_ PETSCOBJECTSETNAME 21 #define petscobjectdestroy_ PETSCOBJECTDESTROY 22 #define petscobjectgetcomm_ PETSCOBJECTGETCOMM 23 #define petscobjectgetname_ PETSCOBJECTGETNAME 24 #define petscgetflops_ PETSCGETFLOPS 25 #define petscerror_ PETSCERROR 26 #define petscrandomcreate_ PETSCRANDOMCREATE 27 #define petscrandomdestroy_ PETSCRANDOMDESTROY 28 #define petscrandomgetvalue_ PETSCRANDOMGETVALUE 29 #define petscmallocvalidate_ PETSCMALLOCVALIDATE 30 #define petscrealview_ PETSCREALVIEW 31 #define petscintview_ PETSCINTVIEW 32 #define petscsequentialphasebegin_ PETSCSEQUENTIALPHASEBEGIN 33 #define petscsequentialphaseend_ PETSCSEQUENTIALPHASEEND 34 #define petsctrlog_ PETSCTRLOG 35 #define petscmemcpy_ PETSCMEMCPY 36 #define petscmallocdump_ PETSCMALLOCDUMP 37 #define petscmallocdumplog_ PETSCMALLOCDUMPLOG 38 #define petscmemzero_ PETSCMEMZERO 39 #define petscbinaryopen_ PETSCBINARYOPEN 40 #define petscbinaryread_ PETSCBINARYREAD 41 #define petscbinarywrite_ PETSCBINARYWRITE 42 #define petscbinaryclose_ PETSCBINARYCLOSE 43 #define petscbinaryseek_ PETSCBINARYSEEK 44 #define petscfixfilename_ PETSCFIXFILENAME 45 #define petscstrncpy_ PETSCSTRNCPY 46 #define petscbarrier_ PETSCBARRIER 47 #define petscsynchronizedflush_ PETSCSYNCHRONIZEDFLUSH 48 #define petscsplitownership_ PETSCSPLITOWNERSHIP 49 #define petscsplitownershipblock_ PETSCSPLITOWNERSHIPBLOCK 50 #define petscobjectgetnewtag_ PETSCOBJECTGETNEWTAG 51 #define petsccommgetnewtag_ PETSCCOMMGETNEWTAG 52 #define petscfptrap_ PETSCFPTRAP 53 #define petscoffsetfortran_ PETSCOFFSETFORTRAN 54 #define petscmatlabenginecreate_ PETSCMATLABENGINECREATE 55 #define petscmatlabenginedestroy_ PETSCMATLABENGINEDESTROY 56 #define petscmatlabengineevaluate_ PETSCMATLABENGINEEVALUATE 57 #define petscmatlabenginegetoutput_ PETSCMATLABENGINEGETOUTPUT 58 #define petscmatlabengineprintoutput_ PETSCMATLABENGINEPRINTOUTPUT 59 #define petscmatlabengineput_ PETSCMATLABENGINEPUT 60 #define petscmatlabengineget_ PETSCMATLABENGINEGET 61 #define petscmatlabengineputarray_ PETSCMATLABENGINEPUTARRAY 62 #define petscmatlabenginegetarray_ PETSCMATLABENGINEGETARRAY 63 #define petscgetmemoryusage _ PETSCGETMEMORYUSAGE 64 #define petscviewerasciiprintf_ PETSCVIEWERASCIIPRINTF 65 #define petscviewerasciisynchronizedprintf_ PETSCVIEWERASCIISYNCHRONIZEDPRINTF 66 #define petscviewerasciisettab_ PETSCVIEWERASCIISETTAB 67 #define petscviewerasciipushtab_ PETSCVIEWERASCIIPUSHTAB 68 #define petscviewerasciipoptab_ PETSCVIEWERASCIIPOPTAB 69 #define petscviewerasciiusetabs_ PETSCVIEWERASCIIUSETABS 70 #define petscpusherrorhandler_ PETSCPUSHERRORHANDLER 71 #define petscpoperrorhandler_ PETSCPOPERRORHANDLER 72 #define petsctracebackerrorhandler_ PETSCTRACEBACKERRORHANDLER 73 #define petscaborterrorhandler_ PETSCABORTERRORHANDLER 74 #define petscignoreerrorhandler_ PETSCIGNOREERRORHANDLER 75 #define petscemacsclienterrorhandler_ PETSCEMACSCLIENTERRORHANDLER 76 #define petscattachdebuggererrorhandler_ PETSCATTACHDEBUGGERERRORHANDLER 77 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 78 #define petscpopsignalhandler_ petscpopsignalhandler 79 #define petscfopen_ petscfopen 80 #define petscfclose_ petscfclose 81 #define petscfprintf_ petscfprintf 82 #define petscsynchronizedfprintf_ petscsynchronizedfprintf 83 #define petscprintf_ petscprintf 84 #define petscsynchronizedprintf_ petscsynchronizedprintf 85 #define petscsynchronizedflush_ petscsynchronizedflush 86 #define petscmatlabenginecreate_ petscmatlabenginecreate 87 #define petscmatlabenginedestroy_ petscmatlabenginedestroy 88 #define petscmatlabengineevaluate_ petscmatlabengineevaluate 89 #define petscmatlabenginegetoutput_ petscmatlabenginegetoutput 90 #define petscmatlabengineprintoutput_ petscmatlabengineprintoutput 91 #define petscmatlabengineput_ petscmatlabengineput 92 #define petscmatlabengineget_ petscmatlabengineget 93 #define petscmatlabengineputarray_ petscmatlabengineputarray 94 #define petscmatlabenginegetarray_ petscmatlabenginegetarray 95 #define petscoffsetfortran_ petscoffsetfortran 96 #define chkmemfortran_ chkmemfortran 97 #define petscobjectgetnewtag_ petscobjectgetnewtag 98 #define petsccommgetnewtag_ petsccommgetnewtag 99 #define petscsplitownership_ petscsplitownership 100 #define petscsplitownershipblock_ petscsplitownershipblock 101 #define petscbarrier_ petscbarrier 102 #define petscstrncpy_ petscstrncpy 103 #define petscfixfilename_ petscfixfilename 104 #define petscattachdebugger_ petscattachdebugger 105 #define petscobjectsetname_ petscobjectsetname 106 #define petscobjectdestroy_ petscobjectdestroy 107 #define petscobjectgetcomm_ petscobjectgetcomm 108 #define petscobjectgetname_ petscobjectgetname 109 #define petscgetflops_ petscgetflops 110 #define petscerror_ petscerror 111 #define petscrandomcreate_ petscrandomcreate 112 #define petscrandomdestroy_ petscrandomdestroy 113 #define petscrandomgetvalue_ petscrandomgetvalue 114 #define petscmallocvalidate_ petscmallocvalidate 115 #define petscrealview_ petscrealview 116 #define petscintview_ petscintview 117 #define petscsequentialphasebegin_ petscsequentialphasebegin 118 #define petscsequentialphaseend_ petscsequentialphaseend 119 #define petscmemcpy_ petscmemcpy 120 #define petscmallocdump_ petscmallocdump 121 #define petscmallocdumplog_ petscmallocdumplog 122 #define petscmemzero_ petscmemzero 123 #define petscbinaryopen_ petscbinaryopen 124 #define petscbinaryread_ petscbinaryread 125 #define petscbinarywrite_ petscbinarywrite 126 #define petscbinaryclose_ petscbinaryclose 127 #define petscbinaryseek_ petscbinaryseek 128 #define petscsynchronizedflush_ petscsynchronizedflush 129 #define petscfptrap_ petscfptrap 130 #define petscgetcputime_ petscgetcputime 131 #define petscgetmemoryusage_ petscgetmemoryusage 132 #define petscviewerasciiprintf_ petscviewerasciiprintf 133 #define petscviewerasciisynchronizedprintf_ petscviewerasciisynchronizedprintf 134 #define petscviewerasciisettab_ petscviewerasciisettab 135 #define petscviewerasciipushtab_ petscviewerasciipushtab 136 #define petscviewerasciipoptab_ petscviewerasciipoptab 137 #define petscviewerasciiusetabs_ petscviewerasciiusetabs 138 #define petscpusherrorhandler_ petscpusherrorhandler 139 #define petscpoperrorhandler_ petscpoperrorhandler 140 #define petsctracebackerrorhandler_ petsctracebackerrorhandler 141 #define petscaborterrorhandler_ petscaborterrorhandler 142 #define petscignoreerrorhandler_ petscignoreerrorhandler 143 #define petscemacsclienterrorhandler_ petscemacsclienterrorhandler 144 #define petscattachdebuggererrorhandler_ petscattachdebuggererrorhandler 145 #endif 146 147 EXTERN_C_BEGIN 148 static void (PETSC_STDCALL *f2)(int*,const CHAR PETSC_MIXED_LEN(len1),const CHAR PETSC_MIXED_LEN(len2),const CHAR PETSC_MIXED_LEN(len3),int*,int*,const CHAR PETSC_MIXED_LEN(len4),void*,PetscErrorCode* PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len3) PETSC_END_LEN(len4)); 149 EXTERN_C_END 150 151 /* These are not extern C because they are passed into non-extern C user level functions */ 152 static PetscErrorCode ourerrorhandler(int line,const char *fun,const char *file,const char *dir,int n,int p,const char *mess,void *ctx) 153 { 154 PetscErrorCode ierr = 0; 155 size_t len1,len2,len3,len4; 156 int l1,l2,l3,l4; 157 158 PetscStrlen(fun,&len1); l1 = (int)len1; 159 PetscStrlen(file,&len2);l2 = (int)len2; 160 PetscStrlen(dir,&len3);l3 = (int)len3; 161 PetscStrlen(mess,&len4);l4 = (int)len4; 162 163 #if defined(PETSC_USES_CPTOFCD) 164 { 165 CHAR fun_c,file_c,dir_c,mess_c; 166 167 fun_c = _cptofcd(fun,len1); 168 file_c = _cptofcd(file,len2); 169 dir_c = _cptofcd(dir,len3); 170 mess_c = _cptofcd(mess,len4); 171 (*f2)(&line,fun_c,file_c,dir_c,&n,&p,mess_c,ctx,&ierr,len1,len2,len3,len4); 172 173 } 174 #elif defined(PETSC_HAVE_FORTRAN_MIXED_STR_ARG) 175 (*f2)(&line,fun,l1,file,l2,dir,l3,&n,&p,mess,l4,ctx,&ierr); 176 #else 177 (*f2)(&line,fun,file,dir,&n,&p,mess,ctx,&ierr,l1,l2,l3,l4); 178 #endif 179 return ierr; 180 } 181 182 EXTERN_C_BEGIN 183 /* 184 integer i_x,i_y,shift 185 Vec x,y 186 PetscScalar v_x(1),v_y(1) 187 188 call VecGetArray(x,v_x,i_x,ierr) 189 if (x .eq. y) then 190 call PetscOffsetFortran(y_v,x_v,shift,ierr) 191 i_y = i_x + shift 192 else 193 call VecGetArray(y,v_y,i_y,ierr) 194 endif 195 */ 196 197 /* 198 These are not usually called from Fortran but allow Fortran users 199 to transparently set these monitors from .F code 200 201 functions, hence no STDCALL 202 */ 203 void petsctracebackerrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr) 204 { 205 *ierr = PetscTraceBackErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx); 206 } 207 208 void petscaborterrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr) 209 { 210 *ierr = PetscAbortErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx); 211 } 212 213 void petscattachdebuggererrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr) 214 { 215 *ierr = PetscAttachDebuggerErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx); 216 } 217 218 void petscemacsclienterrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr) 219 { 220 *ierr = PetscEmacsClientErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx); 221 } 222 223 void petscignoreerrorhandler_(int *line,const char *fun,const char *file,const char *dir,int *n,int *p,const char *mess,void *ctx,PetscErrorCode *ierr) 224 { 225 *ierr = PetscIgnoreErrorHandler(*line,fun,file,dir,*n,*p,mess,ctx); 226 } 227 228 void PETSC_STDCALL petscpusherrorhandler_(void (PETSC_STDCALL *handler)(int*,const CHAR PETSC_MIXED_LEN(len1),const CHAR PETSC_MIXED_LEN(len2),const CHAR PETSC_MIXED_LEN(len3),int*,int*,const CHAR PETSC_MIXED_LEN(len4),void*,PetscErrorCode* PETSC_END_LEN(len1) PETSC_END_LEN(len2) PETSC_END_LEN(len3) PETSC_END_LEN(len4)),void *ctx,PetscErrorCode *ierr) 229 { 230 if ((void(*)(void))handler == (void(*)(void))petsctracebackerrorhandler_) { 231 *ierr = PetscPushErrorHandler(PetscTraceBackErrorHandler,0); 232 } else { 233 f2 = handler; 234 *ierr = PetscPushErrorHandler(ourerrorhandler,ctx); 235 } 236 } 237 238 void PETSC_STDCALL petscpopsignalhandler_(PetscErrorCode *ierr) 239 { 240 *ierr = PetscPopSignalHandler(); 241 } 242 243 void PETSC_STDCALL petscpoperrorhandler_(PetscErrorCode *ierr) 244 { 245 *ierr = PetscPopErrorHandler(); 246 } 247 248 void PETSC_STDCALL petscviewerasciisettab_(PetscViewer *viewer,PetscInt *tabs,PetscErrorCode *ierr) 249 { 250 *ierr = PetscViewerASCIISetTab(*viewer,*tabs); 251 } 252 253 void PETSC_STDCALL petscviewerasciipushtab_(PetscViewer *viewer,PetscErrorCode *ierr) 254 { 255 *ierr = PetscViewerASCIIPushTab(*viewer); 256 } 257 258 void PETSC_STDCALL petscviewerasciipoptab_(PetscViewer *viewer,PetscErrorCode *ierr) 259 { 260 *ierr = PetscViewerASCIIPopTab(*viewer); 261 } 262 263 void PETSC_STDCALL petscviewerasciiusetabs_(PetscViewer *viewer,PetscTruth *flg,PetscErrorCode *ierr) 264 { 265 *ierr = PetscViewerASCIIUseTabs(*viewer,*flg); 266 } 267 268 void PETSC_STDCALL petscviewerasciiprintf_(PetscViewer *viewer,CHAR str PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1)) 269 { 270 char *c1; 271 272 FIXCHAR(str,len1,c1); 273 *ierr = PetscViewerASCIIPrintf(*viewer,c1); 274 FREECHAR(str,c1); 275 } 276 277 void PETSC_STDCALL petscviewerasciisynchronizedprintf_(PetscViewer *viewer,CHAR str PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1)) 278 { 279 char *c1; 280 281 FIXCHAR(str,len1,c1); 282 *ierr = PetscViewerASCIISynchronizedPrintf(*viewer,c1); 283 FREECHAR(str,c1); 284 } 285 286 void PETSC_STDCALL petscmemorygetcurrentusage_(PetscLogDouble *foo, PetscErrorCode *ierr) 287 { 288 *ierr = PetscMemoryGetCurrentUsage(foo); 289 } 290 291 void PETSC_STDCALL petscmemorygetmaximumusage_(PetscLogDouble *foo, PetscErrorCode *ierr) 292 { 293 *ierr = PetscMemoryGetMaximumUsage(foo); 294 } 295 296 void PETSC_STDCALL petscoffsetfortran_(PetscScalar *x,PetscScalar *y,size_t *shift,PetscErrorCode *ierr) 297 { 298 *ierr = 0; 299 *shift = y - x; 300 } 301 302 void PETSC_STDCALL petscgetcputime_(PetscLogDouble *t, PetscErrorCode *ierr) 303 { 304 *ierr = PetscGetCPUTime(t); 305 } 306 307 void PETSC_STDCALL petscfopen_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),CHAR fmode PETSC_MIXED_LEN(len2), 308 FILE **file,PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 309 { 310 char *c1,*c2; 311 312 FIXCHAR(fname,len1,c1); 313 FIXCHAR(fmode,len2,c2); 314 *ierr = PetscFOpen((MPI_Comm)PetscToPointerComm(*comm),c1,c2,file); 315 FREECHAR(fname,c1); 316 FREECHAR(fmode,c2); 317 } 318 319 void PETSC_STDCALL petscfclose_(MPI_Comm *comm,FILE **file,PetscErrorCode *ierr) 320 { 321 *ierr = PetscFClose((MPI_Comm)PetscToPointerComm(*comm),*file); 322 } 323 324 void PETSC_STDCALL petscsynchronizedflush_(MPI_Comm *comm,PetscErrorCode *ierr) 325 { 326 *ierr = PetscSynchronizedFlush((MPI_Comm)PetscToPointerComm(*comm)); 327 } 328 329 void PETSC_STDCALL petscfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1)) 330 { 331 char *c1; 332 333 FIXCHAR(fname,len1,c1); 334 *ierr = PetscFPrintf((MPI_Comm)PetscToPointerComm(*comm),*file,c1); 335 FREECHAR(fname,c1); 336 } 337 338 void PETSC_STDCALL petscprintf_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1)) 339 { 340 char *c1; 341 342 FIXCHAR(fname,len1,c1); 343 *ierr = PetscPrintf((MPI_Comm)PetscToPointerComm(*comm),c1); 344 FREECHAR(fname,c1); 345 } 346 347 void PETSC_STDCALL petscsynchronizedfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1)) 348 { 349 char *c1; 350 351 FIXCHAR(fname,len1,c1); 352 *ierr = PetscSynchronizedFPrintf((MPI_Comm)PetscToPointerComm(*comm),*file,c1); 353 FREECHAR(fname,c1); 354 } 355 356 void PETSC_STDCALL petscsynchronizedprintf_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),PetscErrorCode *ierr PETSC_END_LEN(len1)) 357 { 358 char *c1; 359 360 FIXCHAR(fname,len1,c1); 361 *ierr = PetscSynchronizedPrintf((MPI_Comm)PetscToPointerComm(*comm),c1); 362 FREECHAR(fname,c1); 363 } 364 365 void PETSC_STDCALL petscsetfptrap_(PetscFPTrap *flag,PetscErrorCode *ierr) 366 { 367 *ierr = PetscSetFPTrap(*flag); 368 } 369 370 void PETSC_STDCALL petscobjectgetnewtag_(PetscObject *obj,PetscMPIInt *tag,PetscErrorCode *ierr) 371 { 372 *ierr = PetscObjectGetNewTag(*obj,tag); 373 } 374 375 void PETSC_STDCALL petsccommgetnewtag_(MPI_Comm *comm,PetscMPIInt *tag,PetscErrorCode *ierr) 376 { 377 *ierr = PetscCommGetNewTag((MPI_Comm)PetscToPointerComm(*comm),tag); 378 } 379 380 void PETSC_STDCALL petscsplitownershipblock_(MPI_Comm *comm,PetscInt *bs,PetscInt *n,PetscInt *N,PetscErrorCode *ierr) 381 { 382 *ierr = PetscSplitOwnershipBlock((MPI_Comm)PetscToPointerComm(*comm),*bs,n,N); 383 } 384 void PETSC_STDCALL petscsplitownership_(MPI_Comm *comm,PetscInt *n,PetscInt *N,PetscErrorCode *ierr) 385 { 386 *ierr = PetscSplitOwnership((MPI_Comm)PetscToPointerComm(*comm),n,N); 387 } 388 389 void PETSC_STDCALL petscbarrier_(PetscObject *obj,PetscErrorCode *ierr) 390 { 391 *ierr = PetscBarrier(*obj); 392 } 393 394 void PETSC_STDCALL petscstrncpy_(CHAR s1 PETSC_MIXED_LEN(len1),CHAR s2 PETSC_MIXED_LEN(len2),int *n, 395 PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 396 { 397 char *t1,*t2; 398 int m; 399 400 #if defined(PETSC_USES_CPTOFCD) 401 t1 = _fcdtocp(s1); 402 t2 = _fcdtocp(s2); 403 m = *n; if (_fcdlen(s1) < m) m = _fcdlen(s1); if (_fcdlen(s2) < m) m = _fcdlen(s2); 404 #else 405 t1 = s1; 406 t2 = s2; 407 m = *n; if (len1 < m) m = len1; if (len2 < m) m = len2; 408 #endif 409 *ierr = PetscStrncpy(t1,t2,m); 410 } 411 412 void PETSC_STDCALL petscfixfilename_(CHAR filein PETSC_MIXED_LEN(len1),CHAR fileout PETSC_MIXED_LEN(len2), 413 PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)) 414 { 415 PetscInt i,n; 416 char *in,*out; 417 418 #if defined(PETSC_USES_CPTOFCD) 419 in = _fcdtocp(filein); 420 out = _fcdtocp(fileout); 421 n = _fcdlen (filein); 422 #else 423 in = filein; 424 out = fileout; 425 n = len1; 426 #endif 427 428 for (i=0; i<n; i++) { 429 if (in[i] == PETSC_REPLACE_DIR_SEPARATOR) out[i] = PETSC_DIR_SEPARATOR; 430 else out[i] = in[i]; 431 } 432 out[i] = 0; 433 } 434 435 void PETSC_STDCALL petscbinaryopen_(CHAR name PETSC_MIXED_LEN(len),PetscViewerFileType *type,int *fd, 436 PetscErrorCode *ierr PETSC_END_LEN(len)) 437 { 438 char *c1; 439 440 FIXCHAR(name,len,c1); 441 *ierr = PetscBinaryOpen(c1,*type,fd); 442 FREECHAR(name,c1); 443 } 444 445 void PETSC_STDCALL petscbinarywrite_(int *fd,void *p,PetscInt *n,PetscDataType *type,PetscTruth *istemp,PetscErrorCode *ierr) 446 { 447 *ierr = PetscBinaryWrite(*fd,p,*n,*type,*istemp); 448 } 449 450 void PETSC_STDCALL petscbinaryread_(int *fd,void *p,PetscInt *n,PetscDataType *type,PetscErrorCode *ierr) 451 { 452 *ierr = PetscBinaryRead(*fd,p,*n,*type); 453 } 454 455 void PETSC_STDCALL petscbinaryseek_(int *fd,PetscInt *size,PetscBinarySeekType *whence,off_t *offset,PetscErrorCode *ierr) 456 { 457 *ierr = PetscBinarySeek(*fd,*size,*whence,offset); 458 } 459 460 void PETSC_STDCALL petscbinaryclose_(int *fd,PetscErrorCode *ierr) 461 { 462 *ierr = PetscBinaryClose(*fd); 463 } 464 465 /* ---------------------------------------------------------------------------------*/ 466 void PETSC_STDCALL petscmemzero_(void *a,PetscInt *n,PetscErrorCode *ierr) 467 { 468 *ierr = PetscMemzero(a,*n); 469 } 470 471 void PETSC_STDCALL petscmallocdump_(PetscErrorCode *ierr) 472 { 473 *ierr = PetscMallocDump(stdout); 474 } 475 void PETSC_STDCALL petscmallocdumplog_(PetscErrorCode *ierr) 476 { 477 *ierr = PetscMallocDumpLog(stdout); 478 } 479 480 void PETSC_STDCALL petscmemcpy_(int *out,int *in,int *length,PetscErrorCode *ierr) 481 { 482 *ierr = PetscMemcpy(out,in,*length); 483 } 484 485 /* 486 This version does not do a malloc 487 */ 488 static char FIXCHARSTRING[1024]; 489 #if defined(PETSC_USES_CPTOFCD) 490 #include <fortran.h> 491 492 #define CHAR _fcd 493 #define FIXCHARNOMALLOC(a,n,b) \ 494 { \ 495 b = _fcdtocp(a); \ 496 n = _fcdlen (a); \ 497 if (b == PETSC_NULL_CHARACTER_Fortran) { \ 498 b = 0; \ 499 } else { \ 500 while((n > 0) && (b[n-1] == ' ')) n--; \ 501 b = FIXCHARSTRING; \ 502 *ierr = PetscStrncpy(b,_fcdtocp(a),n); \ 503 if (*ierr) return; \ 504 b[n] = 0; \ 505 } \ 506 } 507 508 #else 509 510 #define CHAR char* 511 #define FIXCHARNOMALLOC(a,n,b) \ 512 {\ 513 if (a == PETSC_NULL_CHARACTER_Fortran) { \ 514 b = a = 0; \ 515 } else { \ 516 while((n > 0) && (a[n-1] == ' ')) n--; \ 517 if (a[n] != 0) { \ 518 b = FIXCHARSTRING; \ 519 *ierr = PetscStrncpy(b,a,n); \ 520 if (*ierr) return; \ 521 b[n] = 0; \ 522 } else b = a;\ 523 } \ 524 } 525 526 #endif 527 528 void PETSC_STDCALL chkmemfortran_(int *line,CHAR file PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 529 { 530 char *c1; 531 532 FIXCHARNOMALLOC(file,len,c1); 533 *ierr = PetscMallocValidate(*line,"Userfunction",c1," "); 534 } 535 536 void PETSC_STDCALL petscmallocvalidate_(PetscErrorCode *ierr) 537 { 538 *ierr = PetscMallocValidate(0,"Unknown Fortran",0,0); 539 } 540 541 void PETSC_STDCALL petscrandomgetvalue_(PetscRandom *r,PetscScalar *val,PetscErrorCode *ierr) 542 { 543 *ierr = PetscRandomGetValue(*r,val); 544 } 545 546 547 void PETSC_STDCALL petscobjectgetname_(PetscObject *obj,CHAR name PETSC_MIXED_LEN(len), 548 PetscErrorCode *ierr PETSC_END_LEN(len)) 549 { 550 const char *tmp; 551 *ierr = PetscObjectGetName(*obj,&tmp); 552 #if defined(PETSC_USES_CPTOFCD) 553 { 554 char *t = _fcdtocp(name); 555 int len1 = _fcdlen(name); 556 *ierr = PetscStrncpy(t,tmp,len1);if (*ierr) return; 557 } 558 #else 559 *ierr = PetscStrncpy(name,tmp,len);if (*ierr) return; 560 #endif 561 } 562 563 void PETSC_STDCALL petscobjectdestroy_(PetscObject *obj,PetscErrorCode *ierr) 564 { 565 *ierr = PetscObjectDestroy(*obj); 566 } 567 568 void PETSC_STDCALL petscobjectgetcomm_(PetscObject *obj,int *comm,PetscErrorCode *ierr) 569 { 570 MPI_Comm c; 571 *ierr = PetscObjectGetComm(*obj,&c); 572 *(int*)comm = PetscFromPointerComm(c); 573 } 574 575 void PETSC_STDCALL petscattachdebugger_(PetscErrorCode *ierr) 576 { 577 *ierr = PetscAttachDebugger(); 578 } 579 580 void PETSC_STDCALL petscobjectsetname_(PetscObject *obj,CHAR name PETSC_MIXED_LEN(len), 581 PetscErrorCode *ierr PETSC_END_LEN(len)) 582 { 583 char *t1; 584 585 FIXCHAR(name,len,t1); 586 *ierr = PetscObjectSetName(*obj,t1); 587 FREECHAR(name,t1); 588 } 589 590 void PETSC_STDCALL petscerror_(int *number,int *p,CHAR message PETSC_MIXED_LEN(len), 591 PetscErrorCode *ierr PETSC_END_LEN(len)) 592 { 593 char *t1; 594 FIXCHAR(message,len,t1); 595 *ierr = PetscError(-1,0,0,0,*number,*p,t1); 596 FREECHAR(message,t1); 597 } 598 599 void PETSC_STDCALL petscgetflops_(PetscLogDouble *d,PetscErrorCode *ierr) 600 { 601 #if defined(PETSC_USE_LOG) 602 *ierr = PetscGetFlops(d); 603 #else 604 ierr = 0; 605 *d = 0.0; 606 #endif 607 } 608 609 void PETSC_STDCALL petscrandomcreate_(MPI_Comm *comm,PetscRandomType *type,PetscRandom *r,PetscErrorCode *ierr) 610 { 611 *ierr = PetscRandomCreate((MPI_Comm)PetscToPointerComm(*comm),*type,r); 612 } 613 614 void PETSC_STDCALL petscrandomdestroy_(PetscRandom *r,PetscErrorCode *ierr) 615 { 616 *ierr = PetscRandomDestroy(*r); 617 } 618 619 void PETSC_STDCALL petscrealview_(PetscInt *n,PetscReal *d,int *viwer,PetscErrorCode *ierr) 620 { 621 *ierr = PetscRealView(*n,d,0); 622 } 623 624 void PETSC_STDCALL petscintview_(PetscInt *n,PetscInt *d,int *viwer,PetscErrorCode *ierr) 625 { 626 *ierr = PetscIntView(*n,d,0); 627 } 628 629 void PETSC_STDCALL petscsequentialphasebegin_(MPI_Comm *comm,PetscInt *ng,PetscErrorCode *ierr){ 630 *ierr = PetscSequentialPhaseBegin( 631 (MPI_Comm)PetscToPointerComm(*comm),*ng); 632 } 633 void PETSC_STDCALL petscsequentialphaseend_(MPI_Comm *comm,PetscInt *ng,PetscErrorCode *ierr){ 634 *ierr = PetscSequentialPhaseEnd( 635 (MPI_Comm)PetscToPointerComm(*comm),*ng); 636 } 637 638 639 #if defined(PETSC_HAVE_MATLAB) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE) && !defined(PETSC_USE_MAT_SINGLE) 640 641 void PETSC_STDCALL petscmatlabenginecreate_(MPI_Comm *comm,CHAR m PETSC_MIXED_LEN(len),PetscMatlabEngine *e, 642 PetscErrorCode *ierr PETSC_END_LEN(len)) 643 { 644 char *ms; 645 646 FIXCHAR(m,len,ms); 647 *ierr = PetscMatlabEngineCreate((MPI_Comm)PetscToPointerComm(*comm),ms,e); 648 FREECHAR(m,ms); 649 } 650 651 void PETSC_STDCALL petscmatlabenginedestroy_(PetscMatlabEngine *e,PetscErrorCode *ierr) 652 { 653 *ierr = PetscMatlabEngineDestroy(*e); 654 } 655 656 void PETSC_STDCALL petscmatlabengineevaluate_(PetscMatlabEngine *e,CHAR m PETSC_MIXED_LEN(len), 657 PetscErrorCode *ierr PETSC_END_LEN(len)) 658 { 659 char *ms; 660 FIXCHAR(m,len,ms); 661 *ierr = PetscMatlabEngineEvaluate(*e,ms); 662 FREECHAR(m,ms); 663 } 664 665 void PETSC_STDCALL petscmatlabengineput_(PetscMatlabEngine *e,PetscObject *o,PetscErrorCode *ierr) 666 { 667 *ierr = PetscMatlabEnginePut(*e,*o); 668 } 669 670 void PETSC_STDCALL petscmatlabengineget_(PetscMatlabEngine *e,PetscObject *o,PetscErrorCode *ierr) 671 { 672 *ierr = PetscMatlabEngineGet(*e,*o); 673 } 674 675 void PETSC_STDCALL petscmatlabengineputarray_(PetscMatlabEngine *e,PetscInt *m,PetscInt *n,PetscScalar *a, 676 CHAR s PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 677 { 678 char *ms; 679 FIXCHAR(s,len,ms); 680 *ierr = PetscMatlabEnginePutArray(*e,*m,*n,a,ms); 681 FREECHAR(s,ms); 682 } 683 684 void PETSC_STDCALL petscmatlabenginegetarray_(PetscMatlabEngine *e,PetscInt *m,PetscInt *n,PetscScalar *a, 685 CHAR s PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 686 { 687 char *ms; 688 FIXCHAR(s,len,ms); 689 *ierr = PetscMatlabEngineGetArray(*e,*m,*n,a,ms); 690 FREECHAR(s,ms); 691 } 692 693 #endif 694 /* 695 EXTERN int PetscMatlabEngineGetOutput(PetscMatlabEngine,char **); 696 EXTERN int PetscMatlabEnginePrintOutput(PetscMatlabEngine,FILE*); 697 */ 698 699 EXTERN_C_END 700 701 702