Date: 2025-03-29T05:58:29+00:00

Actual source code: zasmf.c

      1: #include <petsc/private/ftnimpl.h>
      2: #include <petscksp.h>

      4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
      5:   #define pcasmgetsubksp_           PCASMGETSUBKSP
      6:   #define pcasmgetlocalsubmatrices_ PCASMGETLOCALSUBMATRICES
      7:   #define pcasmgetlocalsubdomains_  PCASMGETLOCALSUBDOMAINS
      8:   #define pcasmcreatesubdomains_    PCASMCREATESUBDOMAINS
      9:   #define pcasmdestroysubdomains_   PCASMDESTROYSUBDOMAINS
     10:   #define pcasmcreatesubdomains2d_  PCASMCREATESUBDOMAINS2D
     11: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
     12:   #define pcasmgetsubksp_           pcasmgetsubksp
     13:   #define pcasmgetlocalsubmatrices_ pcasmgetlocalsubmatrices
     14:   #define pcasmgetlocalsubdomains_  pcasmgetlocalsubdomains
     15:   #define pcasmcreatesubdomains_    pcasmcreatesubdomains
     16:   #define pcasmdestroysubdomains_   pcasmdestroysubdomains
     17:   #define pcasmcreatesubdomains2d_  pcasmcreatesubdomains2d
     18: #endif

     20: PETSC_EXTERN void pcasmcreatesubdomains_(Mat *mat, PetscInt n, F90Array1d *is, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd1))
     21: {
     22:   IS *insubs;

     24:   CHKFORTRANNULLOBJECT(is);
     25:   *ierr = PCASMCreateSubdomains(*mat, n, &insubs);
     26:   if (*ierr) return;
     27:   if (insubs) *ierr = F90Array1dCreate(insubs, MPIU_FORTRANADDR, 1, n, is PETSC_F90_2PTR_PARAM(ptrd1));
     28: }

     30: PETSC_EXTERN void pcasmgetlocalsubmatrices_(PC *pc, PetscInt *n, F90Array1d *mat, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
     31: {
     32:   PetscInt nloc;
     33:   Mat     *tmat;

     35:   CHKFORTRANNULLOBJECT(mat);
     36:   CHKFORTRANNULLINTEGER(n);
     37:   *ierr = PCASMGetLocalSubmatrices(*pc, &nloc, &tmat);
     38:   if (n) *n = nloc;
     39:   if (mat) *ierr = F90Array1dCreate(tmat, MPIU_FORTRANADDR, 1, nloc, mat PETSC_F90_2PTR_PARAM(ptrd));
     40: }

     42: PETSC_EXTERN void pcasmgetlocalsubdomains_(PC *pc, PetscInt *n, F90Array1d *is, F90Array1d *is_local, int *ierr PETSC_F90_2PTR_PROTO(ptrd1) PETSC_F90_2PTR_PROTO(ptrd2))
     43: {
     44:   PetscInt nloc;
     45:   IS      *tis, *tis_local;

     47:   CHKFORTRANNULLOBJECT(is);
     48:   CHKFORTRANNULLOBJECT(is_local);
     49:   CHKFORTRANNULLINTEGER(n);
     50:   *ierr = PCASMGetLocalSubdomains(*pc, &nloc, &tis, &tis_local);
     51:   if (*ierr) return;
     52:   if (n) *n = nloc;
     53:   if (is) *ierr = F90Array1dCreate(tis, MPIU_FORTRANADDR, 1, nloc, is PETSC_F90_2PTR_PARAM(ptrd1));
     54:   if (*ierr) return;
     55:   if (is_local) *ierr = F90Array1dCreate(tis_local, MPIU_FORTRANADDR, 1, nloc, is_local PETSC_F90_2PTR_PARAM(ptrd2));
     56:   if (*ierr) return;
     57: }

     59: PETSC_EXTERN void pcasmdestroysubdomains_(PetscInt *n, F90Array1d *is1, F90Array1d *is2, int *ierr PETSC_F90_2PTR_PROTO(ptrd1) PETSC_F90_2PTR_PROTO(ptrd2))
     60: {
     61:   IS *isa, *isb;

     63:   *ierr = F90Array1dAccess(is1, MPIU_FORTRANADDR, (void **)&isa PETSC_F90_2PTR_PARAM(ptrd1));
     64:   if (*ierr) return;
     65:   *ierr = F90Array1dAccess(is2, MPIU_FORTRANADDR, (void **)&isb PETSC_F90_2PTR_PARAM(ptrd2));
     66:   if (*ierr) return;
     67:   *ierr = PCASMDestroySubdomains(*n, &isa, &isb);
     68:   if (*ierr) return;
     69:   *ierr = F90Array1dDestroy(is1, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd1));
     70:   if (*ierr) return;
     71:   *ierr = F90Array1dDestroy(is2, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd2));
     72:   if (*ierr) return;
     73: }

     75: PETSC_EXTERN void pcasmcreatesubdomains2d_(PetscInt *m, PetscInt *n, PetscInt *M, PetscInt *N, PetscInt *dof, PetscInt *overlap, PetscInt *Nsub, F90Array1d *is1, F90Array1d *is2, int *ierr PETSC_F90_2PTR_PROTO(ptrd1) PETSC_F90_2PTR_PROTO(ptrd2))
     76: {
     77:   IS *iis, *iisl;

     79:   *ierr = PCASMCreateSubdomains2D(*m, *n, *M, *N, *dof, *overlap, Nsub, &iis, &iisl);
     80:   if (*ierr) return;
     81:   *ierr = F90Array1dCreate(iis, MPIU_FORTRANADDR, 1, *Nsub, is1 PETSC_F90_2PTR_PARAM(ptrd1));
     82:   if (*ierr) return;
     83:   *ierr = F90Array1dCreate(iisl, MPIU_FORTRANADDR, 1, *Nsub, is2 PETSC_F90_2PTR_PARAM(ptrd2));
     84:   if (*ierr) return;
     85: }

     87: PETSC_EXTERN void pcasmgetsubksp_(PC *pc, PetscInt *n_local, PetscInt *first_local, F90Array1d *ksp, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
     88: {
     89:   KSP     *tksp;
     90:   PetscInt nloc, flocal;

     92:   CHKFORTRANNULLINTEGER(n_local);
     93:   CHKFORTRANNULLINTEGER(first_local);
     94:   *ierr = PCASMGetSubKSP(*pc, &nloc, &flocal, &tksp);
     95:   if (n_local) *n_local = nloc;
     96:   if (first_local) *first_local = flocal;
     97:   *ierr = F90Array1dCreate(tksp, MPIU_FORTRANADDR, 1, nloc, ksp PETSC_F90_2PTR_PARAM(ptrd));
     98: }