Actual source code: zf90vec.c

  1: /*$Id: zf90vec.c,v 1.19 2001/08/07 03:05:21 balay Exp $*/

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

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

 31: EXTERN_C_BEGIN

 33: /* --------------------------------------------------------------- */

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

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

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


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

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

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

 92: /* ---------------------------------------------------------------*/

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

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

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

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

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

139: EXTERN_C_END