Actual source code: zf90vec.c

  2: #include "petscis.h"
  3: #include "petscvec.h"
  4: #include "petscf90.h"

  6: #ifdef PETSC_HAVE_FORTRAN_CAPS
  7: #define isgetindicesf90_           ISGETINDICESF90
  8: #define isblockgetindicesf90_      ISBLOCKGETINDICESF90
  9: #define isrestoreindicesf90_       ISRESTOREINDICESF90
 10: #define isblockrestoreindicesf90_  ISBLOCKRESTOREINDICESF90
 11: #define iscoloringgetisf90_        ISCOLORINGGETISF90
 12: #define iscoloringrestoreisf90_    ISCOLORINGRESTOREF90
 13: #define vecgetarrayf90_            VECGETARRAYF90
 14: #define vecrestorearrayf90_        VECRESTOREARRAYF90
 15: #define vecduplicatevecsf90_       VECDUPLICATEVECSF90
 16: #define vecdestroyvecsf90_         VECDESTROYVECSF90
 17: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 18: #define isgetindicesf90_           isgetindicesf90
 19: #define isblockgetindicesf90_      isblockgetindicesf90
 20: #define isrestoreindicesf90_       isrestoreindicesf90 
 21: #define isblockrestoreindicesf90_  isblockrestoreindicesf90
 22: #define iscoloringgetisf90_        iscoloringgetisf90
 23: #define iscoloringrestoreisf90_    iscoloringrestoreisf90
 24: #define vecgetarrayf90_            vecgetarrayf90
 25: #define vecrestorearrayf90_        vecrestorearrayf90
 26: #define vecduplicatevecsf90_       vecduplicatevecsf90
 27: #define vecdestroyvecsf90_         vecdestroyvecsf90
 28: #endif


 32: /* --------------------------------------------------------------- */

 34: void PETSC_STDCALL isgetindicesf90_(IS *x,F90Array1d *ptr,int *__ierr)
 35: {
 36:   int    *fa;
 37:   int    len;

 39:   *__ISGetIndices(*x,&fa); if (*__ierr) return;
 40:   *__ISGetLocalSize(*x,&len);   if (*__ierr) return;
 41:   *__F90Array1dCreate(fa,PETSC_INT,1,len,ptr);
 42: }
 43: void PETSC_STDCALL isrestoreindicesf90_(IS *x,F90Array1d *ptr,int *__ierr)
 44: {
 45:   int    *fa;
 46:   *__F90Array1dAccess(ptr,(void**)&fa);if (*__ierr) return;
 47:   *__F90Array1dDestroy(ptr);if (*__ierr) return;
 48:   *__ISRestoreIndices(*x,&fa);
 49: }

 51: void PETSC_STDCALL isblockgetindicesf90_(IS *x,F90Array1d *ptr,int *__ierr)
 52: {
 53:   int    *fa;
 54:   int    len;
 55:   *__ISBlockGetIndices(*x,&fa);      if (*__ierr) return;
 56:   *__ISBlockGetSize(*x,&len);        if (*__ierr) return;
 57:   *__F90Array1dCreate(fa,PETSC_INT,1,len,ptr);
 58: }
 59: void PETSC_STDCALL isblockrestoreindicesf90_(IS *x,F90Array1d *ptr,int *__ierr)
 60: {
 61:   int    *fa;
 62:   *__F90Array1dAccess(ptr,(void**)&fa);if (*__ierr) return;
 63:   *__F90Array1dDestroy(ptr);if (*__ierr) return;
 64:   *__ISBlockRestoreIndices(*x,&fa);
 65: }


 68: void PETSC_STDCALL iscoloringgetisf90_(ISColoring *iscoloring,int *n,F90Array1d *ptr,int *__ierr)
 69: {
 70:   IS *lis;
 71:   PetscFortranAddr *newisint;
 72:   int i;
 73:   *__ISColoringGetIS(*iscoloring,n,&lis); if (*__ierr) return;
 74:   *__PetscMalloc((*n)*sizeof(PetscFortranAddr),&newisint); if (*__ierr) return;
 75:   for (i=0; i<*n; i++) {
 76:     newisint[i] = (PetscFortranAddr)lis[i];
 77:   }
 78:   *__F90Array1dCreate(newisint,PETSC_FORTRANADDR,1,*n,ptr);
 79: }

 81: void PETSC_STDCALL iscoloringrestoreisf90_(ISColoring *iscoloring,F90Array1d *ptr,int *__ierr)
 82: {
 83:   PetscFortranAddr *is;

 85:   *__F90Array1dAccess(ptr,(void**)&is);if (*__ierr) return;
 86:   *__F90Array1dDestroy(ptr);if (*__ierr) return;
 87:   *__ISColoringRestoreIS(*iscoloring,(IS **)is);if (*__ierr) return;
 88:   *__PetscFree(is);
 89: }

 91: /* ---------------------------------------------------------------*/

 93: void PETSC_STDCALL vecgetarrayf90_(Vec *x,F90Array1d *ptr,int *__ierr)
 94: {
 95:   PetscScalar *fa;
 96:   int    len;
 97:   *__VecGetArray(*x,&fa);      if (*__ierr) return;
 98:   *__VecGetLocalSize(*x,&len); if (*__ierr) return;
 99:   *__F90Array1dCreate(fa,PETSC_SCALAR,1,len,ptr);
100: }
101: void PETSC_STDCALL vecrestorearrayf90_(Vec *x,F90Array1d *ptr,int *__ierr)
102: {
103:   PetscScalar *fa;
104:   *__F90Array1dAccess(ptr,(void**)&fa);if (*__ierr) return;
105:   *__F90Array1dDestroy(ptr);if (*__ierr) return;
106:   *__VecRestoreArray(*x,&fa);
107: }

109: void PETSC_STDCALL vecduplicatevecsf90_(Vec *v,int *m,F90Array1d *ptr,int *__ierr)
110: {
111:   Vec *lV;
112:   PetscFortranAddr *newvint;
113:   int i;
114:   *__VecDuplicateVecs(*v,*m,&lV); if (*__ierr) return;
115:   *__PetscMalloc((*m)*sizeof(PetscFortranAddr),&newvint);  if (*__ierr) return;

117:   for (i=0; i<*m; i++) {
118:     newvint[i] = (PetscFortranAddr)lV[i];
119:   }
120:   *__PetscFree(lV); if (*__ierr) return;
121:   *__F90Array1dCreate(newvint,PETSC_FORTRANADDR,1,*m,ptr);
122: }

124: void PETSC_STDCALL vecdestroyvecsf90_(F90Array1d *ptr,int *m,int *__ierr)
125: {
126:   PetscFortranAddr *vecs;
127:   int       i;

129:   *__F90Array1dAccess(ptr,(void**)&vecs);if (*__ierr) return;
130:   for (i=0; i<*m; i++) {
131:     *__VecDestroy((Vec)vecs[i]);
132:     if (*__ierr) return;
133:   }
134:   *__F90Array1dDestroy(ptr);if (*__ierr) return;
135:   *__PetscFree(vecs);
136: }