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: }