Actual source code: zsys.c

  1: /*$Id: zsys.c,v 1.97 2001/10/04 18:48:06 balay Exp $*/

 3:  #include src/fortran/custom/zpetsc.h
 4:  #include petscsys.h
 5:  #include petscengine.h

  7: #ifdef PETSC_HAVE_FORTRAN_CAPS
  8: #define petscgetcputime_           PETSCGETCPUTIME
  9: #define petscfopen_                PETSCFOPEN
 10: #define petscfclose_               PETSCFCLOSE
 11: #define petscfprintf_              PETSCFPRINTF
 12: #define petscsynchronizedfprintf_  PETSCSYNCHRONIZEDFPRINTF
 13: #define petscsynchronizedflush_    PETSCSYNCHRONIZEDFLUSH
 14: #define chkmemfortran_             CHKMEMFORTRAN
 15: #define petscattachdebugger_       PETSCATTACHDEBUGGER
 16: #define petscobjectsetname_        PETSCOBJECTSETNAME
 17: #define petscobjectdestroy_        PETSCOBJECTDESTROY
 18: #define petscobjectgetcomm_        PETSCOBJECTGETCOMM
 19: #define petscobjectgetname_        PETSCOBJECTGETNAME
 20: #define petscgetflops_             PETSCGETFLOPS
 21: #define petscerror_                PETSCERROR
 22: #define petscrandomcreate_         PETSCRANDOMCREATE
 23: #define petscrandomdestroy_        PETSCRANDOMDESTROY
 24: #define petscrandomgetvalue_       PETSCRANDOMGETVALUE
 25: #define petsctrvalid_              PETSCTRVALID
 26: #define petscrealview_             PETSCREALVIEW
 27: #define petscintview_              PETSCINTVIEW
 28: #define petscsequentialphasebegin_ PETSCSEQUENTIALPHASEBEGIN
 29: #define petscsequentialphaseend_   PETSCSEQUENTIALPHASEEND
 30: #define petsctrlog_                PETSCTRLOG
 31: #define petscmemcpy_               PETSCMEMCPY
 32: #define petsctrdump_               PETSCTRDUMP
 33: #define petsctrlogdump_            PETSCTRLOGDUMP
 34: #define petscmemzero_              PETSCMEMZERO
 35: #define petscbinaryopen_           PETSCBINARYOPEN
 36: #define petscbinaryread_           PETSCBINARYREAD
 37: #define petscbinarywrite_          PETSCBINARYWRITE
 38: #define petscbinaryclose_          PETSCBINARYCLOSE
 39: #define petscbinaryseek_           PETSCBINARYSEEK
 40: #define petscfixfilename_          PETSCFIXFILENAME
 41: #define petscstrncpy_              PETSCSTRNCPY
 42: #define petscbarrier_              PETSCBARRIER
 43: #define petscsynchronizedflush_    PETSCSYNCHRONIZEDFLUSH
 44: #define petscsplitownership_       PETSCSPLITOWNERSHIP
 45: #define petscsplitownershipblock_  PETSCSPLITOWNERSHIPBLOCK
 46: #define petscobjectgetnewtag_      PETSCOBJECTGETNEWTAG
 47: #define petsccommgetnewtag_        PETSCCOMMGETNEWTAG
 48: #define petscfptrap_               PETSCFPTRAP
 49: #define petscoffsetfortran_        PETSCOFFSETFORTRAN
 50: #define petscmatlabenginecreate_      PETSCMATLABENGINECREATE
 51: #define petscmatlabenginedestroy_     PETSCMATLABENGINEDESTROY
 52: #define petscmatlabengineevaluate_    PETSCMATLABENGINEEVALUATE
 53: #define petscmatlabenginegetoutput_   PETSCMATLABENGINEGETOUTPUT
 54: #define petscmatlabengineprintoutput_ PETSCMATLABENGINEPRINTOUTPUT
 55: #define petscmatlabengineput_         PETSCMATLABENGINEPUT
 56: #define petscmatlabengineget_         PETSCMATLABENGINEGET
 57: #define petscmatlabengineputarray_    PETSCMATLABENGINEPUTARRAY
 58: #define petscmatlabenginegetarray_    PETSCMATLABENGINEGETARRAY
 59: #define petscgetresidentsetsize_      PETSCGETRESIDENTSETSIZE
 60: #define petsctrspace_                 PETSCTRSPACE
 61: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 62: #define petscfopen_                   petscfopen
 63: #define petscfclose_                  petscfclose
 64: #define petscfprintf_                 petscfprintf
 65: #define petscsynchronizedfprintf_     petscsynchronizedfprintf
 66: #define petscsynchronizedflush_       petscsynchronizedflush
 67: #define petscmatlabenginecreate_      petscmatlabenginecreate
 68: #define petscmatlabenginedestroy_     petscmatlabenginedestroy
 69: #define petscmatlabengineevaluate_    petscmatlabengineevaluate
 70: #define petscmatlabenginegetoutput_   petscmatlabenginegetoutput
 71: #define petscmatlabengineprintoutput_ petscmatlabengineprintoutput
 72: #define petscmatlabengineput_         petscmatlabengineput
 73: #define petscmatlabengineget_         petscmatlabengineget
 74: #define petscmatlabengineputarray_    petscmatlabengineputarray
 75: #define petscmatlabenginegetarray_    petscmatlabenginegetarray
 76: #define petscoffsetfortran_        petscoffsetfortran     
 77: #define chkmemfortran_             chkmemfortran
 78: #define petscobjectgetnewtag_      petscobjectgetnewtag
 79: #define petsccommgetnewtag_        petsccommgetnewtag
 80: #define petscsplitownership_       petscsplitownership
 81: #define petscsplitownershipblock_  petscsplitownershipblock
 82: #define petscbarrier_              petscbarrier
 83: #define petscstrncpy_              petscstrncpy
 84: #define petscfixfilename_          petscfixfilename
 85: #define petsctrlog_                petsctrlog
 86: #define petscattachdebugger_       petscattachdebugger
 87: #define petscobjectsetname_        petscobjectsetname
 88: #define petscobjectdestroy_        petscobjectdestroy
 89: #define petscobjectgetcomm_        petscobjectgetcomm
 90: #define petscobjectgetname_        petscobjectgetname
 91: #define petscgetflops_             petscgetflops 
 92: #define petscerror_                petscerror
 93: #define petscrandomcreate_         petscrandomcreate
 94: #define petscrandomdestroy_        petscrandomdestroy
 95: #define petscrandomgetvalue_       petscrandomgetvalue
 96: #define petsctrvalid_              petsctrvalid
 97: #define petscrealview_             petscrealview
 98: #define petscintview_              petscintview
 99: #define petscsequentialphasebegin_ petscsequentialphasebegin
100: #define petscsequentialphaseend_   petscsequentialphaseend
101: #define petscmemcpy_               petscmemcpy
102: #define petsctrdump_               petsctrdump
103: #define petsctrlogdump_            petsctlogrdump
104: #define petscmemzero_              petscmemzero
105: #define petscbinaryopen_           petscbinaryopen
106: #define petscbinaryread_           petscbinaryread
107: #define petscbinarywrite_          petscbinarywrite
108: #define petscbinaryclose_          petscbinaryclose
109: #define petscbinaryseek_           petscbinaryseek
110: #define petscsynchronizedflush_    petscsynchronizedflush
111: #define petscfptrap_               petscfptrap
112: #define petscgetcputime_           petscgetcputime
113: #define petscgetresidentsetsize_   petscgetresidentsetsize
114: #define petsctrspace_              petsctrspace
115: #endif

117: EXTERN_C_BEGIN
118: /*
119:     integer i_x,i_y,shift
120:     Vec     x,y
121:     PetscScalar  v_x(1),v_y(1)

123:     call VecGetArray(x,v_x,i_x,ierr)
124:     if (x .eq. y) then
125:       call PetscOffsetFortran(y_v,x_v,shift,ierr)
126:       i_y = i_x + shift
127:     else 
128:       call VecGetArray(y,v_y,i_y,ierr)
129:     endif
130: */

132: void PETSC_STDCALL petsctrspace_(PetscLogDouble *space,PetscLogDouble *fr,PetscLogDouble *maxs, int *ierr)
133: {
134:   *PetscTrSpace(space,fr,maxs);
135: }

137: void PETSC_STDCALL petscgetresidentsetsize_(PetscLogDouble *foo, int *ierr)
138: {
139:   *PetscGetResidentSetSize(foo);
140: }

142: void PETSC_STDCALL petscoffsetfortran_(PetscScalar *x,PetscScalar *y,int *shift,int *ierr)
143: {
144:   *0;
145:   *shift = y - x;
146: }

148: void PETSC_STDCALL petscgetcputime_(PetscLogDouble *t, int *ierr)
149: {
150:   *PetscGetCPUTime(t);
151: }

153: void PETSC_STDCALL petscfopen_(MPI_Comm *comm,CHAR fname PETSC_MIXED_LEN(len1),CHAR fmode PETSC_MIXED_LEN(len2),
154:                                FILE **file,int *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
155: {
156:   char *c1,*c2;

158:   FIXCHAR(fname,len1,c1);
159:   FIXCHAR(fmode,len2,c2);
160:   *PetscFOpen((MPI_Comm)PetscToPointerComm(*comm),c1,c2,file);
161:   FREECHAR(fname,c1);
162:   FREECHAR(fmode,c2);
163: }
164: 
165: void PETSC_STDCALL petscfclose_(MPI_Comm *comm,FILE **file,int *ierr)
166: {
167:   *PetscFClose((MPI_Comm)PetscToPointerComm(*comm),*file);
168: }

170: void PETSC_STDCALL petscsynchronizedflush_(MPI_Comm *comm,int *ierr)
171: {
172:   *PetscSynchronizedFlush((MPI_Comm)PetscToPointerComm(*comm));
173: }

175: void PETSC_STDCALL petscfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
176: {
177:   char *c1;

179:   FIXCHAR(fname,len1,c1);
180:   *PetscFPrintf((MPI_Comm)PetscToPointerComm(*comm),*file,c1);
181:   FREECHAR(fname,c1);
182: }

184: void PETSC_STDCALL petscsynchronizedfprintf_(MPI_Comm *comm,FILE **file,CHAR fname PETSC_MIXED_LEN(len1),int *ierr PETSC_END_LEN(len1))
185: {
186:   char *c1;

188:   FIXCHAR(fname,len1,c1);
189:   *PetscSynchronizedFPrintf((MPI_Comm)PetscToPointerComm(*comm),*file,c1);
190:   FREECHAR(fname,c1);
191: }

193: void PETSC_STDCALL petscsetfptrap_(PetscFPTrap *flag,int *ierr)
194: {
195:   *PetscSetFPTrap(*flag);
196: }

198: void PETSC_STDCALL petscobjectgetnewtag_(PetscObject *obj,int *tag,int *ierr)
199: {
200:   *PetscObjectGetNewTag(*obj,tag);
201: }

203: void PETSC_STDCALL petsccommgetnewtag_(MPI_Comm *comm,int *tag,int *ierr)
204: {
205:   *PetscCommGetNewTag((MPI_Comm)PetscToPointerComm(*comm),tag);
206: }

208: void PETSC_STDCALL petscsplitownershipblock_(MPI_Comm *comm,int *bs,int *n,int *N,int *ierr)
209: {
210:   *PetscSplitOwnershipBlock((MPI_Comm)PetscToPointerComm(*comm),*bs,n,N);
211: }
212: void PETSC_STDCALL petscsplitownership_(MPI_Comm *comm,int *n,int *N,int *ierr)
213: {
214:   *PetscSplitOwnership((MPI_Comm)PetscToPointerComm(*comm),n,N);
215: }

217: void PETSC_STDCALL petscbarrier_(PetscObject *obj,int *ierr)
218: {
219:   *PetscBarrier(*obj);
220: }

222: void PETSC_STDCALL petscstrncpy_(CHAR s1 PETSC_MIXED_LEN(len1),CHAR s2 PETSC_MIXED_LEN(len2),int *n,
223:                                  int *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
224: {
225:   char *t1,*t2;
226:   int  m;

228: #if defined(PETSC_USES_CPTOFCD)
229:   t1 = _fcdtocp(s1);
230:   t2 = _fcdtocp(s2);
231:   m = *n; if (_fcdlen(s1) < m) m = _fcdlen(s1); if (_fcdlen(s2) < m) m = _fcdlen(s2);
232: #else
233:   t1 = s1;
234:   t2 = s2;
235:   m = *n; if (len1 < m) m = len1; if (len2 < m) m = len2;
236: #endif
237:   *PetscStrncpy(t1,t2,m);
238: }

240: void PETSC_STDCALL petscfixfilename_(CHAR filein PETSC_MIXED_LEN(len1),CHAR fileout PETSC_MIXED_LEN(len2),
241:                                      int *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
242: {
243:   int  i,n;
244:   char *in,*out;

246: #if defined(PETSC_USES_CPTOFCD)
247:   in  = _fcdtocp(filein);
248:   out = _fcdtocp(fileout);
249:   n   = _fcdlen (filein);
250: #else
251:   in  = filein;
252:   out = fileout;
253:   n   = len1;
254: #endif

256:   for (i=0; i<n; i++) {
257: #if defined(PARCH_win32)
258:     if (in[i] == '/') out[i] = '\';
259: #else
260:     if (in[i] == '\') out[i] = '/';
261: #endif
262:     else out[i] = in[i];
263:   }
264:   out[i] = 0;
265: }

267: void PETSC_STDCALL petscbinaryopen_(CHAR name PETSC_MIXED_LEN(len),int *type,int *fd,
268:                                     int *ierr PETSC_END_LEN(len))
269: {
270:   char *c1;

272:   FIXCHAR(name,len,c1);
273:   *PetscBinaryOpen(c1,*type,fd);
274:   FREECHAR(name,c1);
275: }

277: void PETSC_STDCALL petscbinarywrite_(int *fd,void *p,int *n,PetscDataType *type,int *istemp,int *ierr)
278: {
279:   *PetscBinaryWrite(*fd,p,*n,*type,*istemp);
280: }

282: void PETSC_STDCALL petscbinaryread_(int *fd,void *p,int *n,PetscDataType *type,int *ierr)
283: {
284:   *PetscBinaryRead(*fd,p,*n,*type);
285: }

287: void PETSC_STDCALL petscbinaryseek_(int *fd,int *size,PetscBinarySeekType *whence,int *offset,int *ierr)
288: {
289:   *PetscBinarySeek(*fd,*size,*whence,offset);
290: }

292: void PETSC_STDCALL petscbinaryclose_(int *fd,int *ierr)
293: {
294:   *PetscBinaryClose(*fd);
295: }

297: /* ---------------------------------------------------------------------------------*/
298: void PETSC_STDCALL petscmemzero_(void *a,int *n,int *ierr)
299: {
300:   *PetscMemzero(a,*n);
301: }

303: void PETSC_STDCALL petsctrdump_(int *ierr)
304: {
305:   *PetscTrDump(stdout);
306: }
307: void PETSC_STDCALL petsctrlogdump_(int *ierr)
308: {
309:   *PetscTrLogDump(stdout);
310: }

312: void PETSC_STDCALL petscmemcpy_(int *out,int *in,int *length,int *ierr)
313: {
314:   *PetscMemcpy(out,in,*length);
315: }

317: void PETSC_STDCALL petsctrlog_(int *ierr)
318: {
319:   *PetscTrLog();
320: }

322: /*
323:         This version does not do a malloc 
324: */
325: static char FIXCHARSTRING[1024];
326: #if defined(PETSC_USES_CPTOFCD)
327: #include <fortran.h>

329: #define CHAR _fcd
330: #define FIXCHARNOMALLOC(a,n,b) 
331: { 
332:   b = _fcdtocp(a); 
333:   n = _fcdlen (a); 
334:   if (b == PETSC_NULL_CHARACTER_Fortran) { 
335:       b = 0; 
336:   } else {  
337:     while((n > 0) && (b[n-1] == ' ')) n--; 
338:     b = FIXCHARSTRING; 
339:     *PetscStrncpy(b,_fcdtocp(a),n); 
340:     if (*ierr) return; 
341:     b[n] = 0; 
342:   } 
343: }

345: #else

347: #define CHAR char*
348: #define FIXCHARNOMALLOC(a,n,b) 
349: {
350:   if (a == PETSC_NULL_CHARACTER_Fortran) { 
351:     b = a = 0; 
352:   } else { 
353:     while((n > 0) && (a[n-1] == ' ')) n--; 
354:     if (a[n] != 0) { 
355:       b = FIXCHARSTRING; 
356:       *PetscStrncpy(b,a,n); 
357:       if (*ierr) return; 
358:       b[n] = 0; 
359:     } else b = a;
360:   } 
361: }

363: #endif

365: void PETSC_STDCALL chkmemfortran_(int *line,CHAR file PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
366: {
367:   char *c1;

369:   FIXCHARNOMALLOC(file,len,c1);
370:   *PetscTrValid(*line,"Userfunction",c1," ");
371: }

373: void PETSC_STDCALL petsctrvalid_(int *ierr)
374: {
375:   *PetscTrValid(0,"Unknown Fortran",0,0);
376: }

378: void PETSC_STDCALL petscrandomgetvalue_(PetscRandom *r,PetscScalar *val,int *ierr)
379: {
380:   *PetscRandomGetValue(*r,val);
381: }


384: void PETSC_STDCALL petscobjectgetname_(PetscObject *obj,CHAR name PETSC_MIXED_LEN(len),
385:                                        int *ierr PETSC_END_LEN(len))
386: {
387:   char *tmp;
388:   *PetscObjectGetName(*obj,&tmp);
389: #if defined(PETSC_USES_CPTOFCD)
390:   {
391:   char *t = _fcdtocp(name);
392:   int  len1 = _fcdlen(name);
393:   *PetscStrncpy(t,tmp,len1);if (*ierr) return;
394:   }
395: #else
396:   *PetscStrncpy(name,tmp,len);if (*ierr) return;
397: #endif
398: }

400: void PETSC_STDCALL petscobjectdestroy_(PetscObject *obj,int *ierr)
401: {
402:   *PetscObjectDestroy(*obj);
403: }

405: void PETSC_STDCALL petscobjectgetcomm_(PetscObject *obj,int *comm,int *ierr)
406: {
407:   MPI_Comm c;
408:   *PetscObjectGetComm(*obj,&c);
409:   *(int*)comm = PetscFromPointerComm(c);
410: }

412: void PETSC_STDCALL petscattachdebugger_(int *ierr)
413: {
414:   *PetscAttachDebugger();
415: }

417: void PETSC_STDCALL petscobjectsetname_(PetscObject *obj,CHAR name PETSC_MIXED_LEN(len),
418:                                        int *ierr PETSC_END_LEN(len))
419: {
420:   char *t1;

422:   FIXCHAR(name,len,t1);
423:   *PetscObjectSetName(*obj,t1);
424:   FREECHAR(name,t1);
425: }

427: void PETSC_STDCALL petscerror_(int *number,int *p,CHAR message PETSC_MIXED_LEN(len),
428:                                int *ierr PETSC_END_LEN(len))
429: {
430:   char *t1;
431:   FIXCHAR(message,len,t1);
432:   *PetscError(-1,"fortran_interface_unknown_file",0,0,*number,*p,t1);
433:   FREECHAR(message,t1);
434: }

436: void PETSC_STDCALL petscgetflops_(PetscLogDouble *d,int *ierr)
437: {
438: #if defined(PETSC_USE_LOG)
439:   *PetscGetFlops(d);
440: #else
441:   0;
442:   *d     = 0.0;
443: #endif
444: }

446: void PETSC_STDCALL petscrandomcreate_(MPI_Comm *comm,PetscRandomType *type,PetscRandom *r,int *ierr)
447: {
448:   *PetscRandomCreate((MPI_Comm)PetscToPointerComm(*comm),*type,r);
449: }

451: void PETSC_STDCALL petscrandomdestroy_(PetscRandom *r,int *ierr)
452: {
453:   *PetscRandomDestroy(*r);
454: }

456: void PETSC_STDCALL petscrealview_(int *n,PetscReal *d,int *viwer,int *ierr)
457: {
458:   *PetscRealView(*n,d,0);
459: }

461: void PETSC_STDCALL petscintview_(int *n,int *d,int *viwer,int *ierr)
462: {
463:   *PetscIntView(*n,d,0);
464: }

466: void PETSC_STDCALL petscsequentialphasebegin_(MPI_Comm *comm,int *ng,int *ierr){
467: *PetscSequentialPhaseBegin(
468:         (MPI_Comm)PetscToPointerComm(*comm),*ng);
469: }
470: void PETSC_STDCALL petscsequentialphaseend_(MPI_Comm *comm,int *ng,int *ierr){
471: *PetscSequentialPhaseEnd(
472:         (MPI_Comm)PetscToPointerComm(*comm),*ng);
473: }


476: #if defined(PETSC_HAVE_MATLAB_ENGINE) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)

478: void PETSC_STDCALL petscmatlabenginecreate_(MPI_Comm *comm,CHAR m PETSC_MIXED_LEN(len),PetscMatlabEngine *e,
479:                                             int *ierr PETSC_END_LEN(len))
480: {
481:   char *ms;

483:   FIXCHAR(m,len,ms);
484:   *PetscMatlabEngineCreate((MPI_Comm)PetscToPointerComm(*comm),ms,e);
485:   FREECHAR(m,ms);
486: }

488: void PETSC_STDCALL petscmatlabenginedestroy_(PetscMatlabEngine *e,int *ierr)
489: {
490:   *PetscMatlabEngineDestroy(*e);
491: }

493: void PETSC_STDCALL petscmatlabengineevaluate_(PetscMatlabEngine *e,CHAR m PETSC_MIXED_LEN(len),
494:                                               int *ierr PETSC_END_LEN(len))
495: {
496:   char *ms;
497:   FIXCHAR(m,len,ms);
498:   *PetscMatlabEngineEvaluate(*e,ms);
499:   FREECHAR(m,ms);
500: }

502: void PETSC_STDCALL petscmatlabengineput_(PetscMatlabEngine *e,PetscObject *o,int *ierr)
503: {
504:   *PetscMatlabEnginePut(*e,*o);
505: }

507: void PETSC_STDCALL petscmatlabengineget_(PetscMatlabEngine *e,PetscObject *o,int *ierr)
508: {
509:   *PetscMatlabEngineGet(*e,*o);
510: }

512: void PETSC_STDCALL petscmatlabengineputarray_(PetscMatlabEngine *e,int *m,int *n,PetscScalar *a,
513:                                               CHAR s PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
514: {
515:   char *ms;
516:   FIXCHAR(s,len,ms);
517:   *PetscMatlabEnginePutArray(*e,*m,*n,a,ms);
518:   FREECHAR(s,ms);
519: }

521: void PETSC_STDCALL petscmatlabenginegetarray_(PetscMatlabEngine *e,int *m,int *n,PetscScalar *a,
522:                                               CHAR s PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
523: {
524:   char *ms;
525:   FIXCHAR(s,len,ms);
526:   *PetscMatlabEngineGetArray(*e,*m,*n,a,ms);
527:   FREECHAR(s,ms);
528: }

530: #endif
531: /*
532: EXTERN int PetscMatlabEngineGetOutput(PetscMatlabEngine,char **);
533: EXTERN int PetscMatlabEnginePrintOutput(PetscMatlabEngine,FILE*);
534: */

536: EXTERN_C_END