Actual source code: zmat.c

     2:  #include src/mat/impls/adj/mpi/mpiadj.h
     3:  #include src/fortran/custom/zpetsc.h
     4:  #include petscmat.h

      7: #ifdef PETSC_HAVE_FORTRAN_CAPS
      8: #define matpartitioningsetvertexweights_ MATPARTITIONINGSETVERTEXWEIGHTS
      9: #define matsettype_                      MATSETTYPE
     10: #define matmpiaijgetseqaij_              MATMPIAIJGETSEQAIJ
     11: #define matmpibaijgetseqbaij_            MATMPIBAIJGETSEQBAIJ
     12: #define matgetrowij_                     MATGETROWIJ
     13: #define matrestorerowij_                 MATRESTOREROWIJ
     14: #define matsetfromoptions_               MATSETFROMOPTIONS
     15: #define matcreateseqaijwitharrays_       MATCREATESEQAIJWITHARRAYS
     16: #define matpartitioningdestroy_          MATPARTITIONINGDESTROY
     17: #define matsetvalue_                     MATSETVALUE
     18: #define matsetvaluelocal_                MATSETVALUELOCAL
     19: #define matgetrow_                       MATGETROW
     20: #define matrestorerow_                   MATRESTOREROW
     21: #define matgetordering_                  MATGETORDERING
     22: #define matdestroy_                      MATDESTROY
     23: #define matcreatempiaij_                 MATCREATEMPIAIJ
     24: #define matcreateseqaij_                 MATCREATESEQAIJ
     25: #define matcreatempibaij_                MATCREATEMPIBAIJ
     26: #define matcreateseqbaij_                MATCREATESEQBAIJ
     27: #define matcreatempisbaij_               MATCREATEMPISBAIJ
     28: #define matcreateseqsbaij_               MATCREATESEQSBAIJ
     29: #define matcreate_                       MATCREATE
     30: #define matcreateshell_                  MATCREATESHELL
     31: #define matshellsetcontext_              MATSHELLSETCONTEXT
     32: #define matorderingregisterdestroy_      MATORDERINGREGISTERDESTROY
     33: #define matcreatempirowbs_               MATCREATEMPIROWBS
     34: #define matcreateseqbdiag_               MATCREATESEQBDIAG
     35: #define matcreatempibdiag_               MATCREATEMPIBDIAG
     36: #define matcreateseqdense_               MATCREATESEQDENSE
     37: #define matcreatempidense_               MATCREATEMPIDENSE
     38: #define matconvert_                      MATCONVERT
     39: #define matload_                         MATLOAD
     40: #define mattranspose_                    MATTRANSPOSE
     41: #define matgetarray_                     MATGETARRAY
     42: #define matrestorearray_                 MATRESTOREARRAY
     43: #define matgettype_                      MATGETTYPE
     44: #define matgetinfo_                      MATGETINFO
     45: #define matshellsetoperation_            MATSHELLSETOPERATION
     46: #define matview_                         MATVIEW
     47: #define matfdcoloringcreate_             MATFDCOLORINGCREATE
     48: #define matfdcoloringdestroy_            MATFDCOLORINGDESTROY
     49: #define matfdcoloringsetfunctionsnes_    MATFDCOLORINGSETFUNCTIONSNES
     50: #define matfdcoloringsetfunctionts_      MATFDCOLORINGSETFUNCTIONTS
     51: #define matcopy_                         MATCOPY
     52: #define matgetsubmatrices_               MATGETSUBMATRICES
     53: #define matgetcoloring_                  MATGETCOLORING
     54: #define matpartitioningsettype_          MATPARTITIONINGSETTYPE
     55: #define matduplicate_                    MATDUPLICATE
     56: #define matzerorows_                     MATZEROROWS
     57: #define matzerorowsis_                   MATZEROROWSIS
     58: #define matzerorowslocal_                MATZEROROWSLOCAL
     59: #define matzerorowslocalis_              MATZEROROWSLOCALIS
     60: #define matpartitioningview_             MATPARTITIONINGVIEW
     61: #define matpartitioningcreate_           MATPARTITIONINGCREATE
     62: #define matpartitioningsetadjacency_     MATPARTITIONINGSETADJACENCY
     63: #define matpartitioningapply_            MATPARTITIONINGAPPLY
     64: #define matcreatempiadj_                 MATCREATEMPIADJ
     65: #define matsetvaluesstencil_             MATSETVALUESSTENCIL
     66: #define matseqaijsetpreallocation_       MATSEQAIJSETPREALLOCATION
     67: #define matmpiaijsetpreallocation_       MATMPIAIJSETPREALLOCATION
     68: #define matseqbaijsetpreallocation_      MATSEQBAIJSETPREALLOCATION
     69: #define matmpibaijsetpreallocation_      MATMPIBAIJSETPREALLOCATION
     70: #define matseqsbaijsetpreallocation_     MATSEQSBAIJSETPREALLOCATION
     71: #define matmpisbaijsetpreallocation_     MATMPISBAIJSETPREALLOCATION
     72: #define matseqbdiagsetpreallocation_     MATSEQBDIAGSETPREALLOCATION
     73: #define matmpibdiagsetpreallocation_     MATMPIBDIAGSETPREALLOCATION
     74: #define matseqdensesetpreallocation_     MATSEQDENSESETPREALLOCATION
     75: #define matmpidensesetpreallocation_     MATMPIDENSESETPREALLOCATION
     76: #define matmpiadjsetpreallocation_       MATMPIADJSETPREALLOCATION
     77: #define matmpirowbssetpreallocation_     MATMPIROWBSSETPREALLOCATION
     78: #define matpartitioningpartysetglobal_   MATPARTITIONINGPARTYSETGLOBAL
     79: #define matpartitioningpartysetlocal_    MATPARTITIONINGPARTYSETLOCAL
     80: #define matpartitioningscotchsetstrategy_ MATPARTITIONINGSCOTCHSETSTRATEGY
     81: #define matpartitioningscotchsetarch_    MATPARTITIONINGSCOTCHSETARCH
     82: #define matpartitioningscotchsethostlist_ MATPARTITIONINGSCOTCHSETHOSTLIST
     83: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
     84: #define matpartitioningsetvertexweights_ matpartitioningsetvertexweights
     85: #define matsettype_                      matsettype
     86: #define matmpiaijgetseqaij_              matmpiaijgetseqaij
     87: #define matmpibaijgetseqbaij_            matmpibaijgetseqbaij
     88: #define matrestorerowij_                 matrestorerowij
     89: #define matgetrowij_                     matgetrowij
     90: #define matcreateseqaijwitharrays_       matcreateseqaijwitharrays
     91: #define matpartitioningdestroy_          matpartitioningdestroy
     92: #define matpartitioningsettype_          matpartitioningsettype
     93: #define matsetvalue_                     matsetvalue
     94: #define matsetvaluelocal_                matsetvaluelocal
     95: #define matgetrow_                       matgetrow
     96: #define matrestorerow_                   matrestorerow
     97: #define matview_                         matview
     98: #define matgetinfo_                      matgetinfo
     99: #define matgettype_                      matgettype
    100: #define matdestroy_                      matdestroy
    101: #define matcreatempiaij_                 matcreatempiaij
    102: #define matcreateseqaij_                 matcreateseqaij
    103: #define matcreatempibaij_                matcreatempibaij
    104: #define matcreateseqbaij_                matcreateseqbaij
    105: #define matcreatempisbaij_               matcreatempisbaij
    106: #define matcreateseqsbaij_               matcreateseqsbaij
    107: #define matcreate_                       matcreate
    108: #define matcreateshell_                  matcreateshell
    109: #define matshellsetcontext_              matshellsetcontext
    110: #define matorderingregisterdestroy_      matorderingregisterdestroy
    111: #define matgetordering_                  matgetordering
    112: #define matcreatempirowbs_               matcreatempirowbs
    113: #define matcreateseqbdiag_               matcreateseqbdiag
    114: #define matcreatempibdiag_               matcreatempibdiag
    115: #define matcreateseqdense_               matcreateseqdense
    116: #define matcreatempidense_               matcreatempidense
    117: #define matconvert_                      matconvert
    118: #define matload_                         matload
    119: #define mattranspose_                    mattranspose
    120: #define matgetarray_                     matgetarray
    121: #define matrestorearray_                 matrestorearray
    122: #define matshellsetoperation_            matshellsetoperation
    123: #define matfdcoloringcreate_             matfdcoloringcreate
    124: #define matfdcoloringdestroy_            matfdcoloringdestroy
    125: #define matfdcoloringsetfunctionsnes_    matfdcoloringsetfunctionsnes
    126: #define matfdcoloringsetfunctionts_      matfdcoloringsetfunctionts
    127: #define matcopy_                         matcopy
    128: #define matgetsubmatrices_               matgetsubmatrices
    129: #define matgetcoloring_                  matgetcoloring
    130: #define matduplicate_                    matduplicate
    131: #define matzerorows_                     matzerorows
    132: #define matzerorowsis_                   matzerorowsis
    133: #define matzerorowslocal_                matzerorowslocal
    134: #define matzerorowslocalis_              matzerorowslocalis
    135: #define matpartitioningview_             matpartitioningview
    136: #define matpartitioningcreate_           matpartitioningcreate
    137: #define matpartitioningsetadjacency_     matpartitioningsetadjacency
    138: #define matpartitioningapply_            matpartitioningapply
    139: #define matcreatempiadj_                 matcreatempiadj
    140: #define matsetfromoptions_               matsetfromoptions
    141: #define matsetvaluesstencil_             matsetvaluesstencil
    142: #define matseqaijsetpreallocation_       matseqaijsetpreallocation
    143: #define matmpiaijsetpreallocation_       matmpiaijsetpreallocation
    144: #define matseqbaijsetpreallocation_      matseqbaijsetpreallocation
    145: #define matmpibaijsetpreallocation_      matmpibaijsetpreallocation
    146: #define matseqsbaijsetpreallocation_     matseqsbaijsetpreallocation
    147: #define matmpisbaijsetpreallocation_     matmpisbaijsetpreallocation
    148: #define matseqbdiagsetpreallocation_     matseqbdiagsetpreallocation
    149: #define matmpibdiagsetpreallocation_     matmpibdiagsetpreallocation
    150: #define matseqdensesetpreallocation_     matseqdensesetpreallocation
    151: #define matmpidensesetpreallocation_     matmpidensesetpreallocation
    152: #define matmpiadjsetpreallocation_       matmpiadjsetpreallocation
    153: #define matmpirowbssetpreallocation_     matmpirowbssetpreallocation
    154: #define matpartitioningpartysetglobal_   matpartitioningpartysetglobal
    155: #define matpartitioningpartysetlocal_    matpartitioningpartysetlocal
    156: #define matpartitioningscotchsetstrategy_ matpartitioningscotchsetstrategy
    157: #define matpartitioningscotchsetarch_    matpartitioningscotchsetarch
    158: #define matpartitioningscotchsethostlist_ matpartitioningscotchsethostlist
    159: #endif

    161:  #include petscts.h

    164: static void (PETSC_STDCALL *f7)(TS*,double*,Vec*,Vec*,void*,PetscErrorCode*);
    165: static void (PETSC_STDCALL *f8)(SNES*,Vec*,Vec*,void*,PetscErrorCode*);

    169: static PetscErrorCode ourmatfdcoloringfunctionts(TS ts,double t,Vec x,Vec y,void *ctx)
    170: {
    171:   PetscErrorCode 0;
    172:   (*f7)(&ts,&t,&x,&y,ctx,&ierr);
    173:   return ierr;
    174: }

    176: static PetscErrorCode ourmatfdcoloringfunctionsnes(SNES ts,Vec x,Vec y,void *ctx)
    177: {
    178:   PetscErrorCode 0;
    179:   (*f8)(&ts,&x,&y,ctx,&ierr);
    180:   return ierr;
    181: }

    185: void PETSC_STDCALL matpartitioningsetvertexweights_(MatPartitioning *part,const PetscInt weights[],PetscErrorCode *ierr)
    186: {
    187:   PetscInt len;
    188:   PetscInt *array;
    189:   *MatGetLocalSize((*part)->adj,&len,0); if (*ierr) return;
    190:   *PetscMalloc(len*sizeof(PetscInt),&array); if (*ierr) return;
    191:   *PetscMemcpy(array,weights,len*sizeof(PetscInt));if (*ierr) return;
    192:   *MatPartitioningSetVertexWeights(*part,array);
    193: }

    196: void PETSC_STDCALL matsettype_(Mat *x,CHAR type_name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
    197: {
    198:   char *t;

    200:   FIXCHAR(type_name,len,t);
    201:   *MatSetType(*x,t);
    202:   FREECHAR(type_name,t);
    203: }

    205: void PETSC_STDCALL matsetvaluesstencil_(Mat *mat,PetscInt *m,MatStencil *idxm,PetscInt *n,MatStencil *idxn,PetscScalar *v,InsertMode *addv,
    206:                                         PetscErrorCode *ierr)
    207: {
    208:   *MatSetValuesStencil(*mat,*m,idxm,*n,idxn,v,*addv);
    209: }

    211: void PETSC_STDCALL matmpiaijgetseqaij_(Mat *A,Mat *Ad,Mat *Ao,PetscInt *ic,size_t *iic,PetscErrorCode *ierr)
    212: {
    213:   PetscInt *i;
    214:   *MatMPIAIJGetSeqAIJ(*A,Ad,Ao,&i);if (*ierr) return;
    215:   *iic  = PetscIntAddressToFortran(ic,i);
    216: }

    218: void PETSC_STDCALL matmpibaijgetseqbaij_(Mat *A,Mat *Ad,Mat *Ao,PetscInt *ic,size_t *iic,PetscErrorCode *ierr)
    219: {
    220:   PetscInt *i;
    221:   *MatMPIBAIJGetSeqBAIJ(*A,Ad,Ao,&i);if (*ierr) return;
    222:   *iic  = PetscIntAddressToFortran(ic,i);
    223: }

    225: void PETSC_STDCALL matgetrowij_(Mat *B,PetscInt *shift,PetscTruth *sym,PetscInt *n,PetscInt *ia,size_t *iia,PetscInt *ja,size_t *jja,
    226:                                 PetscTruth *done,PetscErrorCode *ierr)
    227: {
    228:   PetscInt *IA,*JA;
    229:   *MatGetRowIJ(*B,*shift,*sym,n,&IA,&JA,done);if (*ierr) return;
    230:   *iia  = PetscIntAddressToFortran(ia,IA);
    231:   *jja  = PetscIntAddressToFortran(ja,JA);
    232: }

    234: void PETSC_STDCALL matrestorerowij_(Mat *B,PetscInt *shift,PetscTruth *sym,PetscInt *n,PetscInt *ia,size_t *iia,PetscInt *ja,size_t *jja,
    235:                                     PetscTruth *done,PetscErrorCode *ierr)
    236: {
    237:   PetscInt *IA = PetscIntAddressFromFortran(ia,*iia),*JA = PetscIntAddressFromFortran(ja,*jja);
    238:   *MatRestoreRowIJ(*B,*shift,*sym,n,&IA,&JA,done);
    239: }

    241: void PETSC_STDCALL matsetfromoptions_(Mat *B,PetscErrorCode *ierr)
    242: {
    243:   *MatSetFromOptions(*B);
    244: }

    246: void PETSC_STDCALL matcreateseqaijwitharrays_(MPI_Comm *comm,PetscInt *m,PetscInt *n,PetscInt *i,PetscInt *j,PetscScalar *a,Mat *mat,PetscErrorCode *ierr)
    247: {
    248:   *MatCreateSeqAIJWithArrays((MPI_Comm)PetscToPointerComm(*comm),*m,*n,i,j,a,mat);
    249: }

    251: void PETSC_STDCALL matcreatempiadj_(MPI_Comm *comm,PetscInt *m,PetscInt *n,PetscInt *i,PetscInt *j,PetscInt *values,Mat *A,PetscErrorCode *ierr)
    252: {
    253:   Mat_MPIAdj *adj;

    255:   CHKFORTRANNULLINTEGER(values);
    256:   *MatCreateMPIAdj((MPI_Comm)PetscToPointerComm(*comm),*m,*n,i,j,values,A);
    257:   adj = (Mat_MPIAdj*)(*A)->data;
    258:   adj->freeaij = PETSC_FALSE;
    259: }

    261: void PETSC_STDCALL matpartitioningdestroy_(MatPartitioning *part,PetscErrorCode *ierr)
    262: {
    263:   *MatPartitioningDestroy(*part);
    264: }

    266: void PETSC_STDCALL matpartitioningcreate_(MPI_Comm *comm,MatPartitioning *part, PetscErrorCode *ierr)
    267: {
    268:   *MatPartitioningCreate((MPI_Comm)PetscToPointerComm(*comm),part);
    269: }

    271: void PETSC_STDCALL matpartitioningapply_(MatPartitioning *part,IS *is,PetscErrorCode *ierr)
    272: {
    273:   *MatPartitioningApply(*part,is);
    274: }

    276: void PETSC_STDCALL matpartitioningsetadjacency_(MatPartitioning *part,Mat *mat,PetscErrorCode *ierr)
    277: {
    278:   *MatPartitioningSetAdjacency(*part,*mat);
    279: }

    281: void PETSC_STDCALL matpartitioningview_(MatPartitioning  *part,PetscViewer *viewer, PetscErrorCode *ierr)
    282: {
    283:   PetscViewer v;
    284:   PetscPatchDefaultViewers_Fortran(viewer,v);
    285:   *MatPartitioningView(*part,v);
    286: }

    288: void PETSC_STDCALL matpartitioningsettype_(MatPartitioning *part,CHAR type PETSC_MIXED_LEN(len),
    289:                                            PetscErrorCode *ierr PETSC_END_LEN(len))
    290: {
    291:   char *t;
    292:   FIXCHAR(type,len,t);
    293:   *MatPartitioningSetType(*part,t);
    294:   FREECHAR(type,t);
    295: }

    297: void PETSC_STDCALL matgetcoloring_(Mat *mat,CHAR type PETSC_MIXED_LEN(len),ISColoring *iscoloring,
    298:                                    PetscErrorCode *ierr PETSC_END_LEN(len))
    299: {
    300:   char *t;
    301:   FIXCHAR(type,len,t);
    302:   *MatGetColoring(*mat,t,iscoloring);
    303:   FREECHAR(type,t);
    304: }

    306: void PETSC_STDCALL matsetvalue_(Mat *mat,PetscInt *i,PetscInt *j,PetscScalar *va,InsertMode *mode,PetscErrorCode *ierr)
    307: {
    308:   /* cannot use MatSetValue() here since that usesCHKERRQ() which has a return in it */
    309:   *MatSetValues(*mat,1,i,1,j,va,*mode);
    310: }

    312: void PETSC_STDCALL matsetvaluelocal_(Mat *mat,PetscInt *i,PetscInt *j,PetscScalar *va,InsertMode *mode,PetscErrorCode *ierr)
    313: {
    314:   /* cannot use MatSetValueLocal() here since that usesCHKERRQ() which has a return in it */
    315:   *MatSetValuesLocal(*mat,1,i,1,j,va,*mode);
    316: }

    318: void PETSC_STDCALL matfdcoloringcreate_(Mat *mat,ISColoring *iscoloring,MatFDColoring *color,PetscErrorCode *ierr)
    319: {
    320:   *MatFDColoringCreate(*mat,*iscoloring,color);
    321: }

    323: /*
    324:    This is a poor way of storing the column and value pointers
    325:   generated by MatGetRow() to be returned with MatRestoreRow()
    326:   but there is not natural,good place else to store them. Hence
    327:   Fortran programmers can only have one outstanding MatGetRows()
    328:   at a time.
    329: */
    330: static PetscErrorCode    matgetrowactive = 0;
    331: static const PetscInt    *my_ocols = 0;
    332: static const PetscScalar *my_ovals = 0;

    334: void PETSC_STDCALL matgetrow_(Mat *mat,PetscInt *row,PetscInt *ncols,PetscInt *cols,PetscScalar *vals,PetscErrorCode *ierr)
    335: {
    336:   const PetscInt    **oocols = &my_ocols;
    337:   const PetscScalar **oovals = &my_ovals;

    339:   if (matgetrowactive) {
    340:      PetscError(__LINE__,"MatGetRow_Fortran",__FILE__,__SDIR__,1,0,
    341:                "Cannot have two MatGetRow() active simultaneously\n\
    342:                call MatRestoreRow() before calling MatGetRow() a second time");
    343:      *1;
    344:      return;
    345:   }

    347:   CHKFORTRANNULLINTEGER(cols); if (!cols) oocols = PETSC_NULL;
    348:   CHKFORTRANNULLSCALAR(vals);  if (!vals) oovals = PETSC_NULL;

    350:   *MatGetRow(*mat,*row,ncols,oocols,oovals);
    351:   if (*ierr) return;

    353:   if (oocols) { *PetscMemcpy(cols,my_ocols,(*ncols)*sizeof(PetscInt)); if (*ierr) return;}
    354:   if (oovals) { *PetscMemcpy(vals,my_ovals,(*ncols)*sizeof(PetscScalar)); if (*ierr) return; }
    355:   matgetrowactive = 1;
    356: }

    358: void PETSC_STDCALL matrestorerow_(Mat *mat,PetscInt *row,PetscInt *ncols,PetscInt *cols,PetscScalar *vals,PetscErrorCode *ierr)
    359: {
    360:   const PetscInt         **oocols = &my_ocols;
    361:   const PetscScalar **oovals = &my_ovals;
    362:   if (!matgetrowactive) {
    363:      PetscError(__LINE__,"MatRestoreRow_Fortran",__FILE__,__SDIR__,1,0,
    364:                "Must call MatGetRow() first");
    365:      *1;
    366:      return;
    367:   }
    368:   CHKFORTRANNULLINTEGER(cols); if (!cols) oocols = PETSC_NULL;
    369:   CHKFORTRANNULLSCALAR(vals);  if (!vals) oovals = PETSC_NULL;

    371:   *MatRestoreRow(*mat,*row,ncols,oocols,oovals);
    372:   matgetrowactive = 0;
    373: }

    375: void PETSC_STDCALL matview_(Mat *mat,PetscViewer *vin,PetscErrorCode *ierr)
    376: {
    377:   PetscViewer v;
    378:   PetscPatchDefaultViewers_Fortran(vin,v);
    379:   *MatView(*mat,v);
    380: }

    382: void PETSC_STDCALL matcopy_(Mat *A,Mat *B,MatStructure *str,PetscErrorCode *ierr)
    383: {
    384:   *MatCopy(*A,*B,*str);
    385: }

    387: void PETSC_STDCALL matgetinfo_(Mat *mat,MatInfoType *flag,double *finfo,PetscErrorCode *ierr)
    388: {
    389:   *MatGetInfo(*mat,*flag,(MatInfo*)finfo);
    390: }

    392: void PETSC_STDCALL matgetarray_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr)
    393: {
    394:   PetscScalar *mm;
    395:   PetscInt    m,n;

    397:   *MatGetArray(*mat,&mm); if (*ierr) return;
    398:   *MatGetSize(*mat,&m,&n);  if (*ierr) return;
    399:   *PetscScalarAddressToFortran((PetscObject)*mat,fa,mm,m*n,ia); if (*ierr) return;
    400: }

    402: void PETSC_STDCALL matrestorearray_(Mat *mat,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr)
    403: {
    404:   PetscScalar          *lx;
    405:   PetscInt                  m,n;

    407:   *MatGetSize(*mat,&m,&n); if (*ierr) return;
    408:   *PetscScalarAddressFromFortran((PetscObject)*mat,fa,*ia,m*n,&lx);if (*ierr) return;
    409:   *MatRestoreArray(*mat,&lx);if (*ierr) return;
    410: }

    412: void PETSC_STDCALL mattranspose_(Mat *mat,Mat *B,PetscErrorCode *ierr)
    413: {
    414:   CHKFORTRANNULLOBJECT(B);
    415:   *MatTranspose(*mat,B);
    416: }

    418: void PETSC_STDCALL matload_(PetscViewer *viewer,CHAR outtype PETSC_MIXED_LEN(len),Mat *newmat,PetscErrorCode *ierr PETSC_END_LEN(len))
    419: {
    420:   char *t;
    421:   PetscViewer v;
    422:   FIXCHAR(outtype,len,t);
    423:   PetscPatchDefaultViewers_Fortran(viewer,v);
    424:   *MatLoad(v,t,newmat);
    425:   FREECHAR(outtype,t);
    426: }

    428: void PETSC_STDCALL matconvert_(Mat *mat,CHAR outtype PETSC_MIXED_LEN(len),MatReuse *reuse,Mat *M,PetscErrorCode *ierr PETSC_END_LEN(len))
    429: {
    430:   char *t;
    431:   FIXCHAR(outtype,len,t);
    432:   *MatConvert(*mat,t,*reuse,M);
    433:   FREECHAR(outtype,t);
    434: }

    436: void PETSC_STDCALL matcreateseqdense_(MPI_Comm *comm,PetscInt *m,PetscInt *n,PetscScalar *data,Mat *newmat,PetscErrorCode *ierr)
    437: {
    438:   CHKFORTRANNULLSCALAR(data);
    439:   *MatCreateSeqDense((MPI_Comm)PetscToPointerComm(*comm),*m,*n,data,newmat);
    440: }

    442: void PETSC_STDCALL matcreatempidense_(MPI_Comm *comm,PetscInt *m,PetscInt *n,PetscInt *M,PetscInt *N,PetscScalar *data,Mat *newmat,
    443:                         PetscErrorCode *ierr)
    444: {
    445:   CHKFORTRANNULLSCALAR(data);
    446:   *MatCreateMPIDense((MPI_Comm)PetscToPointerComm(*comm),*m,*n,*M,*N,data,newmat);
    447: }

    449: /* Fortran ignores diagv */
    450: void PETSC_STDCALL matcreatempibdiag_(MPI_Comm *comm,PetscInt *m,PetscInt *M,PetscInt *N,PetscInt *nd,PetscInt *bs,
    451:                         PetscInt *diag,PetscScalar **diagv,Mat *newmat,PetscErrorCode *ierr)
    452: {
    453:   CHKFORTRANNULLINTEGER(diag);
    454:   *MatCreateMPIBDiag((MPI_Comm)PetscToPointerComm(*comm),
    455:                               *m,*M,*N,*nd,*bs,diag,PETSC_NULL,newmat);
    456: }

    458: /* Fortran ignores diagv */
    459: void PETSC_STDCALL matcreateseqbdiag_(MPI_Comm *comm,PetscInt *m,PetscInt *n,PetscInt *nd,PetscInt *bs,
    460:                         PetscInt *diag,PetscScalar **diagv,Mat *newmat,PetscErrorCode *ierr)
    461: {
    462:   CHKFORTRANNULLINTEGER(diag);
    463:   *MatCreateSeqBDiag((MPI_Comm)PetscToPointerComm(*comm),*m,*n,*nd,*bs,diag,
    464:                                PETSC_NULL,newmat);
    465: }

    467: #if defined(PETSC_HAVE_BLOCKSOLVE)
    468: /*  Fortran cannot pass in procinfo,hence ignored */
    469: void PETSC_STDCALL matcreatempirowbs_(MPI_Comm *comm,PetscInt *m,PetscInt *M,PetscInt *nz,PetscInt *nnz,Mat *newmat,PetscErrorCode *ierr)
    470: {
    471:   CHKFORTRANNULLINTEGER(nnz);
    472:   *MatCreateMPIRowbs((MPI_Comm)PetscToPointerComm(*comm),*m,*M,*nz,nnz,newmat);
    473: }
    474: #endif

    476: void PETSC_STDCALL matgetordering_(Mat *mat,CHAR type PETSC_MIXED_LEN(len),IS *rperm,IS *cperm,
    477:                        PetscErrorCode *ierr PETSC_END_LEN(len))
    478: {
    479:   char *t;
    480:   FIXCHAR(type,len,t);
    481:   *MatGetOrdering(*mat,t,rperm,cperm);
    482:   FREECHAR(type,t);
    483: }

    485: void PETSC_STDCALL matorderingregisterdestroy_(PetscErrorCode *ierr)
    486: {
    487:   *MatOrderingRegisterDestroy();
    488: }

    490: void PETSC_STDCALL matgettype_(Mat *mm,CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
    491: {
    492:   const char *tname;

    494:   *MatGetType(*mm,&tname);
    495: #if defined(PETSC_USES_CPTOFCD)
    496:   {
    497:     char *t = _fcdtocp(name); int len1 = _fcdlen(name);
    498:     if (t != PETSC_NULL_CHARACTER_Fortran) {
    499:       *PetscStrncpy(t,tname,len1);if (*ierr) return;
    500:     }
    501:   }
    502: #else
    503:   if (name != PETSC_NULL_CHARACTER_Fortran) {
    504:     *PetscStrncpy(name,tname,len);if (*ierr) return;
    505:   }
    506: #endif
    507:   FIXRETURNCHAR(name,len);

    509: }

    511: void PETSC_STDCALL matcreate_(MPI_Comm *comm,Mat *M,PetscErrorCode *ierr)
    512: {
    513:   *MatCreate((MPI_Comm)PetscToPointerComm(*comm),M);
    514: }

    516: void PETSC_STDCALL matcreateseqaij_(MPI_Comm *comm,PetscInt *m,PetscInt *n,PetscInt *nz,
    517:                            PetscInt *nnz,Mat *newmat,PetscErrorCode *ierr)
    518: {
    519:   CHKFORTRANNULLINTEGER(nnz);
    520:   *MatCreateSeqAIJ((MPI_Comm)PetscToPointerComm(*comm),*m,*n,*nz,nnz,newmat);
    521: }

    523: void PETSC_STDCALL matcreateseqbaij_(MPI_Comm *comm,PetscInt *bs,PetscInt *m,PetscInt *n,PetscInt *nz,
    524:                            PetscInt *nnz,Mat *newmat,PetscErrorCode *ierr)
    525: {
    526:   CHKFORTRANNULLINTEGER(nnz);
    527:   *MatCreateSeqBAIJ((MPI_Comm)PetscToPointerComm(*comm),*bs,*m,*n,*nz,nnz,newmat);
    528: }

    530: void PETSC_STDCALL matcreateseqsbaij_(MPI_Comm *comm,PetscInt *bs,PetscInt *m,PetscInt *n,PetscInt *nz,
    531:                            PetscInt *nnz,Mat *newmat,PetscErrorCode *ierr)
    532: {
    533:   CHKFORTRANNULLINTEGER(nnz);
    534:   *MatCreateSeqSBAIJ((MPI_Comm)PetscToPointerComm(*comm),*bs,*m,*n,*nz,nnz,newmat);
    535: }

    537: void PETSC_STDCALL matfdcoloringdestroy_(MatFDColoring *mat,PetscErrorCode *ierr)
    538: {
    539:   *MatFDColoringDestroy(*mat);
    540: }

    542: void PETSC_STDCALL matdestroy_(Mat *mat,PetscErrorCode *ierr)
    543: {
    544:   *MatDestroy(*mat);
    545: }

    547: void PETSC_STDCALL matcreatempiaij_(MPI_Comm *comm,PetscInt *m,PetscInt *n,PetscInt *M,PetscInt *N,
    548:          PetscInt *d_nz,PetscInt *d_nnz,PetscInt *o_nz,PetscInt *o_nnz,Mat *newmat,PetscErrorCode *ierr)
    549: {
    550:   CHKFORTRANNULLINTEGER(d_nnz);
    551:   CHKFORTRANNULLINTEGER(o_nnz);

    553:   *MatCreateMPIAIJ((MPI_Comm)PetscToPointerComm(*comm),
    554:                              *m,*n,*M,*N,*d_nz,d_nnz,*o_nz,o_nnz,newmat);
    555: }
    556: void PETSC_STDCALL matcreatempibaij_(MPI_Comm *comm,PetscInt *bs,PetscInt *m,PetscInt *n,PetscInt *M,PetscInt *N,
    557:          PetscInt *d_nz,PetscInt *d_nnz,PetscInt *o_nz,PetscInt *o_nnz,Mat *newmat,PetscErrorCode *ierr)
    558: {
    559:   CHKFORTRANNULLINTEGER(d_nnz);
    560:   CHKFORTRANNULLINTEGER(o_nnz);
    561:   *MatCreateMPIBAIJ((MPI_Comm)PetscToPointerComm(*comm),
    562:                              *bs,*m,*n,*M,*N,*d_nz,d_nnz,*o_nz,o_nnz,newmat);
    563: }
    564: void PETSC_STDCALL matcreatempisbaij_(MPI_Comm *comm,PetscInt *bs,PetscInt *m,PetscInt *n,PetscInt *M,PetscInt *N,
    565:          PetscInt *d_nz,PetscInt *d_nnz,PetscInt *o_nz,PetscInt *o_nnz,Mat *newmat,PetscErrorCode *ierr)
    566: {
    567:   CHKFORTRANNULLINTEGER(d_nnz);
    568:   CHKFORTRANNULLINTEGER(o_nnz);
    569:   *MatCreateMPISBAIJ((MPI_Comm)PetscToPointerComm(*comm),
    570:                              *bs,*m,*n,*M,*N,*d_nz,d_nnz,*o_nz,o_nnz,newmat);
    571: }

    573: /*
    574:       The MatShell Matrix Vector product requires a C routine.
    575:    This C routine then calls the corresponding Fortran routine that was
    576:    set by the user.
    577: */
    578: void PETSC_STDCALL matcreateshell_(MPI_Comm *comm,PetscInt *m,PetscInt *n,PetscInt *M,PetscInt *N,void **ctx,Mat *mat,PetscErrorCode *ierr)
    579: {
    580:   *MatCreateShell((MPI_Comm)PetscToPointerComm(*comm),*m,*n,*M,*N,*ctx,mat);
    581:   if (*ierr) return;
    582:   *PetscMalloc(4*sizeof(void*),&((PetscObject)*mat)->fortran_func_pointers);
    583: }

    585: void PETSC_STDCALL   matshellsetcontext_(Mat *mat,void**ctx, int *__ierr ){
    586:   *__MatShellSetContext(*mat,*ctx);
    587: }

    589: static PetscErrorCode ourmult(Mat mat,Vec x,Vec y)
    590: {
    591:   PetscErrorCode 0;
    592:   (*(PetscErrorCode (PETSC_STDCALL *)(Mat*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)mat)->fortran_func_pointers[0]))(&mat,&x,&y,&ierr);
    593:   return ierr;
    594: }

    596: static PetscErrorCode ourmulttranspose(Mat mat,Vec x,Vec y)
    597: {
    598:   PetscErrorCode 0;
    599:   (*(PetscErrorCode (PETSC_STDCALL *)(Mat*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)mat)->fortran_func_pointers[2]))(&mat,&x,&y,&ierr);
    600:   return ierr;
    601: }

    603: static PetscErrorCode ourmultadd(Mat mat,Vec x,Vec y,Vec z)
    604: {
    605:   PetscErrorCode 0;
    606:   (*(PetscErrorCode (PETSC_STDCALL *)(Mat*,Vec*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)mat)->fortran_func_pointers[1]))(&mat,&x,&y,&z,&ierr);
    607:   return ierr;
    608: }

    610: static PetscErrorCode ourmulttransposeadd(Mat mat,Vec x,Vec y,Vec z)
    611: {
    612:   PetscErrorCode 0;
    613:   (*(PetscErrorCode (PETSC_STDCALL *)(Mat*,Vec*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)mat)->fortran_func_pointers[3]))(&mat,&x,&y,&z,&ierr);
    614:   return ierr;
    615: }

    617: void PETSC_STDCALL matshellsetoperation_(Mat *mat,MatOperation *op,PetscErrorCode (PETSC_STDCALL *f)(Mat*,Vec*,Vec*,PetscErrorCode*),PetscErrorCode *ierr)
    618: {
    619:   if (*op == MATOP_MULT) {
    620:     *MatShellSetOperation(*mat,*op,(FCNVOID)ourmult);
    621:     ((PetscObject)*mat)->fortran_func_pointers[0] = (FCNVOID)f;
    622:   } else if (*op == MATOP_MULT_TRANSPOSE) {
    623:     *MatShellSetOperation(*mat,*op,(FCNVOID)ourmulttranspose);
    624:     ((PetscObject)*mat)->fortran_func_pointers[2] = (FCNVOID)f;
    625:   } else if (*op == MATOP_MULT_ADD) {
    626:     *MatShellSetOperation(*mat,*op,(FCNVOID)ourmultadd);
    627:     ((PetscObject)*mat)->fortran_func_pointers[1] = (FCNVOID)f;
    628:   } else if (*op == MATOP_MULT_TRANSPOSE_ADD) {
    629:     *MatShellSetOperation(*mat,*op,(FCNVOID)ourmulttransposeadd);
    630:     ((PetscObject)*mat)->fortran_func_pointers[3] = (FCNVOID)f;
    631:   } else {
    632:     PetscError(__LINE__,"MatShellSetOperation_Fortran",__FILE__,__SDIR__,1,0,
    633:                "Cannot set that matrix operation");
    634:     *1;
    635:   }
    636: }

    638: /*
    639:         MatFDColoringSetFunction sticks the Fortran function into the fortran_func_pointers
    640:     this function is then accessed by ourmatfdcoloringfunction()

    642:    NOTE: FORTRAN USER CANNOT PUT IN A NEW J OR B currently.

    644:    USER CAN HAVE ONLY ONE MatFDColoring in code Because there is no place to hang f7!
    645: */

    648: void PETSC_STDCALL matfdcoloringsetfunctionts_(MatFDColoring *fd,void (PETSC_STDCALL *f)(TS*,double*,Vec*,Vec*,void*,PetscErrorCode*),
    649:                                  void *ctx,PetscErrorCode *ierr)
    650: {
    651:   f7 = f;
    652:   *MatFDColoringSetFunction(*fd,(FCNINTVOID)ourmatfdcoloringfunctionts,ctx);
    653: }

    656: void PETSC_STDCALL matfdcoloringsetfunctionsnes_(MatFDColoring *fd,void (PETSC_STDCALL *f)(SNES*,Vec*,Vec*,void*,PetscErrorCode*),
    657:                                  void *ctx,PetscErrorCode *ierr)
    658: {
    659:   f8 = f;
    660:   *MatFDColoringSetFunction(*fd,(FCNINTVOID)ourmatfdcoloringfunctionsnes,ctx);
    661: }

    663: /*
    664:     MatGetSubmatrices() is slightly different from C since the
    665:     Fortran provides the array to hold the submatrix objects,while in C that
    666:     array is allocated by the MatGetSubmatrices()
    667: */
    668: void PETSC_STDCALL matgetsubmatrices_(Mat *mat,PetscInt *n,IS *isrow,IS *iscol,MatReuse *scall,Mat *smat,PetscErrorCode *ierr)
    669: {
    670:   Mat *lsmat;
    671:   PetscInt i;

    673:   if (*scall == MAT_INITIAL_MATRIX) {
    674:     *MatGetSubMatrices(*mat,*n,isrow,iscol,*scall,&lsmat);
    675:     for (i=0; i<*n; i++) {
    676:       smat[i] = lsmat[i];
    677:     }
    678:     PetscFree(lsmat);
    679:   } else {
    680:     *MatGetSubMatrices(*mat,*n,isrow,iscol,*scall,&smat);
    681:   }
    682: }

    684: void PETSC_STDCALL matduplicate_(Mat *matin,MatDuplicateOption *op,Mat *matout,PetscErrorCode *ierr)
    685: {
    686:   *MatDuplicate(*matin,*op,matout);
    687: }

    689: void PETSC_STDCALL matzerorows_(Mat *mat,PetscInt *numRows,PetscInt *rows,PetscScalar *diag,PetscErrorCode *ierr)
    690: {
    691:   CHKFORTRANNULLSCALAR(diag);
    692:   *MatZeroRows(*mat,*numRows,rows,*diag);
    693: }

    695: void PETSC_STDCALL matzerorowsis_(Mat *mat,IS *is,PetscScalar *diag,PetscErrorCode *ierr)
    696: {
    697:   CHKFORTRANNULLSCALAR(diag);
    698:   *MatZeroRowsIS(*mat,*is,*diag);
    699: }

    701: void PETSC_STDCALL matzerorowslocal_(Mat *mat,PetscInt *numRows,PetscInt *rows,PetscScalar *diag,PetscErrorCode *ierr)
    702: {
    703:   CHKFORTRANNULLSCALAR(diag);
    704:   *MatZeroRowsLocal(*mat,*numRows,rows,*diag);
    705: }

    707: void PETSC_STDCALL matzerorowslocalis_(Mat *mat,IS *is,PetscScalar *diag,PetscErrorCode *ierr)
    708: {
    709:   CHKFORTRANNULLSCALAR(diag);
    710:   *MatZeroRowsLocalIS(*mat,*is,*diag);
    711: }

    713: void PETSC_STDCALL matseqaijsetpreallocation_(Mat *mat,PetscInt *nz,PetscInt *nnz,PetscErrorCode *ierr)
    714: {
    715:   CHKFORTRANNULLINTEGER(nnz);
    716:   *MatSeqAIJSetPreallocation(*mat,*nz,nnz);
    717: }

    719: void PETSC_STDCALL matmpiaijsetpreallocation_(Mat *mat,PetscInt *d_nz,PetscInt *d_nnz,PetscInt *o_nz,PetscInt *o_nnz,PetscErrorCode *ierr)
    720: {
    721:   CHKFORTRANNULLINTEGER(d_nnz);
    722:   CHKFORTRANNULLINTEGER(o_nnz);
    723:   *MatMPIAIJSetPreallocation(*mat,*d_nz,d_nnz,*o_nz,o_nnz);
    724: }

    726: void PETSC_STDCALL matseqbaijsetpreallocation_(Mat *mat,PetscInt *bs,PetscInt *nz,PetscInt *nnz,PetscErrorCode *ierr)
    727: {
    728:   CHKFORTRANNULLINTEGER(nnz);
    729:   *MatSeqBAIJSetPreallocation(*mat,*bs,*nz,nnz);
    730: }

    732: void PETSC_STDCALL matmpibaijsetpreallocation_(Mat *mat,PetscInt *bs,PetscInt *d_nz,PetscInt *d_nnz,PetscInt *o_nz,PetscInt *o_nnz,PetscErrorCode *ierr)
    733: {
    734:   CHKFORTRANNULLINTEGER(d_nnz);
    735:   CHKFORTRANNULLINTEGER(o_nnz);
    736:   *MatMPIBAIJSetPreallocation(*mat,*bs,*d_nz,d_nnz,*o_nz,o_nnz);
    737: }

    739: void PETSC_STDCALL matseqsbaijsetpreallocation_(Mat *mat,PetscInt *bs,PetscInt *nz,PetscInt *nnz,PetscErrorCode *ierr)
    740: {
    741:   CHKFORTRANNULLINTEGER(nnz);
    742:   *MatSeqSBAIJSetPreallocation(*mat,*bs,*nz,nnz);
    743: }

    745: void PETSC_STDCALL matmpisbaijsetpreallocation_(Mat *mat,PetscInt *bs,PetscInt *d_nz,PetscInt *d_nnz,PetscInt *o_nz,PetscInt *o_nnz,PetscErrorCode *ierr)
    746: {
    747:   CHKFORTRANNULLINTEGER(d_nnz);
    748:   CHKFORTRANNULLINTEGER(o_nnz);
    749:   *MatMPISBAIJSetPreallocation(*mat,*bs,*d_nz,d_nnz,*o_nz,o_nnz);
    750: }

    752: /* Fortran ignores diagv */
    753: void PETSC_STDCALL matseqbdiagsetpreallocation_(Mat *mat,PetscInt *nd,PetscInt *bs,PetscInt *diag,PetscScalar **diagv,PetscErrorCode *ierr)
    754: {
    755:   CHKFORTRANNULLINTEGER(diag);
    756:   *MatSeqBDiagSetPreallocation(*mat,*nd,*bs,diag,PETSC_NULL);
    757: }
    758: /* Fortran ignores diagv */
    759: void PETSC_STDCALL matmpibdiagsetpreallocation_(Mat *mat,PetscInt *nd,PetscInt *bs,PetscInt *diag,PetscScalar **diagv,PetscErrorCode *ierr)
    760: {
    761:   CHKFORTRANNULLINTEGER(diag);
    762:   *MatMPIBDiagSetPreallocation(*mat,*nd,*bs,diag,PETSC_NULL);
    763: }

    765: void PETSC_STDCALL matseqdensesetpreallocation_(Mat *mat,PetscScalar *data,PetscErrorCode *ierr)
    766: {
    767:   CHKFORTRANNULLSCALAR(data);
    768:   *MatSeqDenseSetPreallocation(*mat,data);
    769: }
    770: void PETSC_STDCALL matmpidensesetpreallocation_(Mat *mat,PetscScalar *data,PetscErrorCode *ierr)
    771: {
    772:   CHKFORTRANNULLSCALAR(data);
    773:   *MatMPIDenseSetPreallocation(*mat,data);
    774: }
    775: void PETSC_STDCALL matmpiadjsetpreallocation_(Mat *mat,PetscInt *i,PetscInt *j,PetscInt *values, PetscErrorCode *ierr)
    776: {
    777:   CHKFORTRANNULLINTEGER(values);
    778:   *MatMPIAdjSetPreallocation(*mat,i,j,values);
    779: }

    781: #if defined(PETSC_HAVE_BLOCKSOLVE)
    782: void PETSC_STDCALL matmpirowbssetpreallocation_(Mat *mat,PetscInt *nz,PetscInt *nnz,PetscErrorCode *ierr)
    783: {
    784:   CHKFORTRANNULLINTEGER(nnz);
    785:   *MatMPIRowbsSetPreallocation(*mat,*nz,nnz);
    786: }
    787: #endif

    789: #if defined(PETSC_HAVE_PARTY)
    790: void PETSC_STDCALL matpartitioningpartysetglobal_(MatPartitioning *part,CHAR method PETSC_MIXED_LEN(len),
    791:                                            PetscErrorCode *ierr PETSC_END_LEN(len))
    792: {
    793:   char *t;
    794:   FIXCHAR(method,len,t);
    795:   *MatPartitioningPartySetGlobal(*part,t);
    796:   FREECHAR(method,t);
    797: }

    799: void PETSC_STDCALL matpartitioningpartysetlocal_(MatPartitioning *part,CHAR method PETSC_MIXED_LEN(len),
    800:                                            PetscErrorCode *ierr PETSC_END_LEN(len))
    801: {
    802:   char *t;
    803:   FIXCHAR(method,len,t);
    804:   *MatPartitioningPartySetLocal(*part,t);
    805:   FREECHAR(method,t);
    806: }
    807: #endif

    809: #if defined(PETSC_HAVE_SCOTCH)
    810: void PETSC_STDCALL matpartitioningscotchsetstrategy_(MatPartitioning *part,CHAR strategy PETSC_MIXED_LEN(len),
    811:                                            PetscErrorCode *ierr PETSC_END_LEN(len))
    812: {
    813:   char *t;
    814:   FIXCHAR(strategy,len,t);
    815:   *MatPartitioningScotchSetStrategy(*part,t);
    816:   FREECHAR(strategy,t);
    817: }

    819: void PETSC_STDCALL matpartitioningscotchsetarch_(MatPartitioning *part,CHAR filename PETSC_MIXED_LEN(len),
    820:                                            PetscErrorCode *ierr PETSC_END_LEN(len))
    821: {
    822:   char *t;
    823:   FIXCHAR(filename,len,t);
    824:   *MatPartitioningScotchSetArch(*part,t);
    825:   FREECHAR(filename,t);
    826: }
    827: #endif

    829: #if defined(PETSC_HAVE_SCOTCH)
    830: void PETSC_STDCALL matpartitioningscotchsethostlist_(MatPartitioning *part,CHAR filename PETSC_MIXED_LEN(len),
    831:                                            PetscErrorCode *ierr PETSC_END_LEN(len))
    832: {
    833:   char *t;
    834:   FIXCHAR(filename,len,t);
    835:   *MatPartitioningScotchSetHostList(*part,t);
    836:   FREECHAR(filename,t);
    837: }
    838: #endif