Actual source code: zgasmf.c

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

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

 29: PETSC_EXTERN void pcgasmsetsubdomains_(PC *pc, PetscInt *n, IS *is, IS *isl, int *ierr)
 30: {
 31:   *ierr = PCGASMSetSubdomains(*pc, *n, is, isl);
 32: }

 34: PETSC_EXTERN void pcgasmdestroysubdomains_(PetscInt *n, IS *is, IS *isl, int *ierr)
 35: {
 36:   IS *iis, *iisl;
 37:   *ierr = PetscMalloc1(*n, &iis);
 38:   if (*ierr) return;
 39:   *ierr = PetscArraycpy(iis, is, *n);
 40:   if (*ierr) return;
 41:   *ierr = PetscMalloc1(*n, &iisl);
 42:   if (*ierr) return;
 43:   *ierr = PetscArraycpy(iisl, isl, *n);
 44:   *ierr = PCGASMDestroySubdomains(*n, &iis, &iisl);
 45: }

 47: 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)
 48: {
 49:   IS *iis, *iisl;
 50:   *ierr = PCGASMCreateSubdomains2D(*pc, *m, *n, *M, *N, *dof, *overlap, Nsub, &iis, &iisl);
 51:   if (*ierr) return;
 52:   *ierr = PetscArraycpy(is, iis, *Nsub);
 53:   if (*ierr) return;
 54:   *ierr = PetscArraycpy(isl, iisl, *Nsub);
 55:   if (*ierr) return;
 56:   *ierr = PetscFree(iis);
 57:   if (*ierr) return;
 58:   *ierr = PetscFree(iisl);
 59: }

 61: PETSC_EXTERN void pcgasmgetsubksp1_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
 62: {
 63:   KSP     *tksp;
 64:   PetscInt i, nloc;
 65:   CHKFORTRANNULLINTEGER(n_local);
 66:   CHKFORTRANNULLINTEGER(first_local);
 67:   CHKFORTRANNULLOBJECT(ksp);
 68:   *ierr = PCGASMGetSubKSP(*pc, &nloc, first_local, &tksp);
 69:   if (n_local) *n_local = nloc;
 70:   if (ksp) {
 71:     for (i = 0; i < nloc; i++) ksp[i] = tksp[i];
 72:   }
 73: }

 75: PETSC_EXTERN void pcgasmgetsubksp2_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
 76: {
 77:   pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
 78: }

 80: PETSC_EXTERN void pcgasmgetsubksp3_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
 81: {
 82:   pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
 83: }

 85: PETSC_EXTERN void pcgasmgetsubksp4_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
 86: {
 87:   pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
 88: }

 90: PETSC_EXTERN void pcgasmgetsubksp5_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
 91: {
 92:   pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
 93: }

 95: PETSC_EXTERN void pcgasmgetsubksp6_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
 96: {
 97:   pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
 98: }

100: PETSC_EXTERN void pcgasmgetsubksp7_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
101: {
102:   pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
103: }

105: PETSC_EXTERN void pcgasmgetsubksp8_(PC *pc, PetscInt *n_local, PetscInt *first_local, KSP *ksp, PetscErrorCode *ierr)
106: {
107:   pcgasmgetsubksp1_(pc, n_local, first_local, ksp, ierr);
108: }