Date: 2025-03-28T21:11:22+00:00

Actual source code: zvectorf90.c

      1: #include <petscvec.h>
      2: #include <petsc/private/f90impl.h>

      4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
      5:   #define vecgetarrayf90_         VECGETARRAYF90
      6:   #define vecrestorearrayf90_     VECRESTOREARRAYF90
      7:   #define vecgetarrayreadf90_     VECGETARRAYREADF90
      8:   #define vecrestorearrayreadf90_ VECRESTOREARRAYREADF90
      9:   #define vecduplicatevecsf90_    VECDUPLICATEVECSF90
     10:   #define vecdestroyvecsf90_      VECDESTROYVECSF90
     11: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
     12:   #define vecgetarrayf90_         vecgetarrayf90
     13:   #define vecrestorearrayf90_     vecrestorearrayf90
     14:   #define vecgetarrayreadf90_     vecgetarrayreadf90
     15:   #define vecrestorearrayreadf90_ vecrestorearrayreadf90
     16:   #define vecduplicatevecsf90_    vecduplicatevecsf90
     17:   #define vecdestroyvecsf90_      vecdestroyvecsf90
     18: #endif

     20: PETSC_EXTERN void vecgetarrayf90_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     21: {
     22:   PetscScalar *fa;
     23:   PetscInt     len;
     24:   if (!ptr) {
     25:     *ierr = PetscError(((PetscObject)*x)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "ptr==NULL, maybe #include <petsc/finclude/petscvec.h> is missing?");
     26:     return;
     27:   }
     28:   *ierr = VecGetArray(*x, &fa);
     29:   if (*ierr) return;
     30:   *ierr = VecGetLocalSize(*x, &len);
     31:   if (*ierr) return;
     32:   *ierr = F90Array1dCreate(fa, MPIU_SCALAR, 1, len, ptr PETSC_F90_2PTR_PARAM(ptrd));
     33: }
     34: PETSC_EXTERN void vecrestorearrayf90_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     35: {
     36:   PetscScalar *fa;
     37:   *ierr = F90Array1dAccess(ptr, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
     38:   if (*ierr) return;
     39:   *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
     40:   if (*ierr) return;
     41:   *ierr = VecRestoreArray(*x, &fa);
     42: }

     44: PETSC_EXTERN void vecgetarrayreadf90_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     45: {
     46:   const PetscScalar *fa;
     47:   PetscInt           len;
     48:   if (!ptr) {
     49:     *ierr = PetscError(((PetscObject)*x)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "ptr==NULL, maybe #include <petsc/finclude/petscvec.h> is missing?");
     50:     return;
     51:   }
     52:   *ierr = VecGetArrayRead(*x, &fa);
     53:   if (*ierr) return;
     54:   *ierr = VecGetLocalSize(*x, &len);
     55:   if (*ierr) return;
     56:   *ierr = F90Array1dCreate((PetscScalar *)fa, MPIU_SCALAR, 1, len, ptr PETSC_F90_2PTR_PARAM(ptrd));
     57: }
     58: PETSC_EXTERN void vecrestorearrayreadf90_(Vec *x, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     59: {
     60:   const PetscScalar *fa;
     61:   *ierr = F90Array1dAccess(ptr, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
     62:   if (*ierr) return;
     63:   *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
     64:   if (*ierr) return;
     65:   *ierr = VecRestoreArrayRead(*x, &fa);
     66: }

     68: PETSC_EXTERN void vecduplicatevecsf90_(Vec *v, int *m, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     69: {
     70:   Vec              *lV;
     71:   PetscFortranAddr *newvint;
     72:   int               i;
     73:   *ierr = VecDuplicateVecs(*v, *m, &lV);
     74:   if (*ierr) return;
     75:   *ierr = PetscMalloc1(*m, &newvint);
     76:   if (*ierr) return;

     78:   for (i = 0; i < *m; i++) newvint[i] = (PetscFortranAddr)lV[i];
     79:   *ierr = PetscFree(lV);
     80:   if (*ierr) return;
     81:   *ierr = F90Array1dCreate(newvint, MPIU_FORTRANADDR, 1, *m, ptr PETSC_F90_2PTR_PARAM(ptrd));
     82: }

     84: PETSC_EXTERN void vecdestroyvecsf90_(int *m, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     85: {
     86:   Vec *vecs;
     87:   int  i;

     89:   *ierr = F90Array1dAccess(ptr, MPIU_FORTRANADDR, (void **)&vecs PETSC_F90_2PTR_PARAM(ptrd));
     90:   if (*ierr) return;
     91:   for (i = 0; i < *m; i++) {
     92:     PETSC_FORTRAN_OBJECT_F_DESTROYED_TO_C_NULL(&vecs[i]);
     93:     *ierr = VecDestroy(&vecs[i]);
     94:     if (*ierr) return;
     95:     PETSC_FORTRAN_OBJECT_C_NULL_TO_F_DESTROYED(&vecs[i]);
     96:   }
     97:   *ierr = F90Array1dDestroy(ptr, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd));
     98:   if (*ierr) return;
     99:   *ierr = PetscFree(vecs);
    100: }