Date: 2025-03-28T21:10:56+00:00

Actual source code: zgasmf.c

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

      4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
      5:   #define pcgasmdestroysubdomains_  PCGASMDESTROYSUBDOMAINS
      6:   #define pcgasmgetsubksp1_         PCGASMGETSUBKSP1
      7:   #define pcgasmgetsubksp2_         PCGASMGETSUBKSP2
      8:   #define pcgasmgetsubksp3_         PCGASMGETSUBKSP3
      9:   #define pcgasmgetsubksp4_         PCGASMGETSUBKSP4
     10:   #define pcgasmgetsubksp5_         PCGASMGETSUBKSP5
     11:   #define pcgasmgetsubksp6_         PCGASMGETSUBKSP6
     12:   #define pcgasmgetsubksp7_         PCGASMGETSUBKSP7
     13:   #define pcgasmgetsubksp8_         PCGASMGETSUBKSP8
     14:   #define pcgasmcreatesubdomains2d_ PCGASMCREATESUBDOMAINS2D
     15: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
     16:   #define pcgasmdestroysubdomains_  pcgasmdestroysubdomains
     17:   #define pcgasmgetsubksp2_         pcgasmgetsubksp2
     18:   #define pcgasmgetsubksp3_         pcgasmgetsubksp3
     19:   #define pcgasmgetsubksp4_         pcgasmgetsubksp4
     20:   #define pcgasmgetsubksp5_         pcgasmgetsubksp5
     21:   #define pcgasmgetsubksp6_         pcgasmgetsubksp6
     22:   #define pcgasmgetsubksp7_         pcgasmgetsubksp7
     23:   #define pcgasmgetsubksp8_         pcgasmgetsubksp8
     24:   #define pcgasmcreatesubdomains2d_ pcgasmcreatesubdomains2d
     25: #endif

     27: PETSC_EXTERN void pcgasmdestroysubdomains_(PetscInt *n, IS *is, IS *isl, int *ierr)
     28: {
     29:   IS *iis, *iisl;
     30:   *ierr = PetscMalloc1(*n, &iis);
     31:   if (*ierr) return;
     32:   *ierr = PetscArraycpy(iis, is, *n);
     33:   if (*ierr) return;
     34:   *ierr = PetscMalloc1(*n, &iisl);
     35:   if (*ierr) return;
     36:   *ierr = PetscArraycpy(iisl, isl, *n);
     37:   *ierr = PCGASMDestroySubdomains(*n, &iis, &iisl);
     38: }

     40: PETSC_EXTERN void pcgasmcreatesubdomains2d_(PC *pc, PetscInt *m, PetscInt *n, PetscInt *M, PetscInt *N, PetscInt *dof, PetscInt *overlap, PetscInt *Nsub, IS *is, IS *isl, int *ierr)
     41: {
     42:   IS *iis, *iisl;
     43:   *ierr = PCGASMCreateSubdomains2D(*pc, *m, *n, *M, *N, *dof, *overlap, Nsub, &iis, &iisl);
     44:   if (*ierr) return;
     45:   *ierr = PetscArraycpy(is, iis, *Nsub);
     46:   if (*ierr) return;
     47:   *ierr = PetscArraycpy(isl, iisl, *Nsub);
     48:   if (*ierr) return;
     49:   *ierr = PetscFree(iis);
     50:   if (*ierr) return;
     51:   *ierr = PetscFree(iisl);
     52: }

     54: PETSC_EXTERN void pcgasmgetsubksp1_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
     55: {
     56:   KSP     *tksp;
     57:   PetscInt i, nloc;
     58:   CHKFORTRANNULLINTEGER(n_local);
     59:   CHKFORTRANNULLINTEGER(first_local);
     60:   CHKFORTRANNULLOBJECT(ksp);
     61:   *ierr = PCGASMGetSubKSP(*pc, &nloc, first_local, &tksp);
     62:   if (n_local) *n_local = nloc;
     63:   if (ksp) {
     64:     for (i = 0; i < nloc; i++) ksp[i] = tksp[i];
     65:   }
     66: }

     68: PETSC_EXTERN void pcgasmgetsubksp2_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
     69: {
     70:   pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
     71: }

     73: PETSC_EXTERN void pcgasmgetsubksp3_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
     74: {
     75:   pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
     76: }

     78: PETSC_EXTERN void pcgasmgetsubksp4_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
     79: {
     80:   pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
     81: }

     83: PETSC_EXTERN void pcgasmgetsubksp5_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
     84: {
     85:   pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
     86: }

     88: PETSC_EXTERN void pcgasmgetsubksp6_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
     89: {
     90:   pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
     91: }

     93: PETSC_EXTERN void pcgasmgetsubksp7_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
     94: {
     95:   pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
     96: }

     98: PETSC_EXTERN void pcgasmgetsubksp8_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
     99: {
    100:   pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
    101: }