1 #include "zpetsc.h" 2 #include "petscksp.h" 3 4 #if defined(PETSC_HAVE_FORTRAN_CAPS) 5 #define pcasmgetsubksp_ PCASMGETSUBKSP 6 #define pcasmsetlocalsubdomains_ PCASMSETLOCALSUBDOMAINS 7 #define pcasmsetglobalsubdomains_ PCASMSETGLOBALSUBDOMAINS 8 #define pcasmgetlocalsubmatrices_ PCASMGETLOCALSUBMATRICES 9 #define pcasmgetlocalsubdomains_ PCASMGETLOCALSUBDOMAINS 10 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 11 #define pcasmgetsubksp_ pcasmgetsubksp 12 #define pcasmsetlocalsubdomains_ pcasmsetlocalsubdomains 13 #define pcasmsetglobalsubdomains_ pcasmsetglobalsubdomains 14 #define pcasmgetlocalsubmatrices_ pcasmgetlocalsubmatrices 15 #define pcasmgetlocalsubdomains_ pcasmgetlocalsubdomains 16 #endif 17 18 EXTERN_C_BEGIN 19 void PETSC_STDCALL pcasmgetsubksp_(PC *pc,PetscInt *n_local,PetscInt *first_local,KSP *ksp,PetscErrorCode *ierr) 20 { 21 KSP *tksp; 22 PetscInt i,nloc; 23 CHKFORTRANNULLINTEGER(n_local); 24 CHKFORTRANNULLINTEGER(first_local); 25 *ierr = PCASMGetSubKSP(*pc,&nloc,first_local,&tksp); 26 if (n_local) *n_local = nloc; 27 for (i=0; i<nloc; i++){ 28 ksp[i] = tksp[i]; 29 } 30 } 31 32 void PETSC_STDCALL pcasmsetlocalsubdomains_(PC *pc,PetscInt *n,IS *is, PetscErrorCode *ierr) 33 { 34 CHKFORTRANNULLOBJECT(is); 35 *ierr = PCASMSetLocalSubdomains(*pc,*n,is); 36 } 37 38 void PETSC_STDCALL pcasmsettotalsubdomains_(PC *pc,PetscInt *N,IS *is, PetscErrorCode *ierr) 39 { 40 CHKFORTRANNULLOBJECT(is); 41 *ierr = PCASMSetTotalSubdomains(*pc,*N,is); 42 } 43 44 void PETSC_STDCALL pcasmgetlocalsubmatrices_(PC *pc,PetscInt *n,Mat *mat, PetscErrorCode *ierr) 45 { 46 PetscInt nloc,i; 47 Mat *tmat; 48 CHKFORTRANNULLOBJECT(mat); 49 CHKFORTRANNULLINTEGER(n); 50 *ierr = PCASMGetLocalSubmatrices(*pc,&nloc,&tmat); 51 if (n) *n = nloc; 52 if (mat) { 53 for (i=0; i<nloc; i++){ 54 mat[i] = tmat[i]; 55 } 56 } 57 } 58 void PETSC_STDCALL pcasmgetlocalsubdomains_(PC *pc,PetscInt *n,IS *is, PetscErrorCode *ierr) 59 { 60 PetscInt nloc,i; 61 IS *tis; 62 CHKFORTRANNULLOBJECT(is); 63 CHKFORTRANNULLINTEGER(n); 64 *ierr = PCASMGetLocalSubdomains(*pc,&nloc,&tis); 65 if (n) *n = nloc; 66 if (is) { 67 for (i=0; i<nloc; i++){ 68 is[i] = tis[i]; 69 } 70 } 71 } 72 73 EXTERN_C_END 74