IS routines without a Fortran interface

[Barry Smith]

   Stephen,

    The difficulty with this routine is that it returns an array (the procs 
and numprocs argument) and an array of arrays (2d array) as the last argument.
Returning 2d arrays from C to Fortran is not doable.

   Thus I have devised a slightly different calling sequence for Fortran;
     Fortran Usage: 
$        ISLocalToGlobalMpngGetInfoSize(ISLocalToGlobalMapping,PetscInt nproc,PetscInt numprocmax,ierr) followed by 
$        ISLocalToGlobalMappingGetInfo(ISLocalToGlobalMapping,PetscInt nproc, PetscInt procs[nproc],PetscInt numprocs[nproc],
           PetscInt indices[nproc][numprocmax],ierr)
         There is no ISLocalToGlobalMappingRestoreInfo() in Fortran. You must make sure that procs[], numprocs[] and
         indices[][] are large enough arrays, either by allocating them dynamically or defining static ones large enough.

   Attached is the new code, just drop it into src/vec/is/utisl/ftn-custom to replace the 
current zisltogf.c and run "make lib shared" in that directory.

   Please let us know if you have any difficulties with it,

   Barry



On Fri, 9 Jun 2006, Stephen R Ball wrote:

>
>
> Hi
>
> I am keen to use some of the indexing IS routines in my Fortan code but have
> discovered that several of them do not have a Fortran interface. In
> particular I would like to use ISLocalToGlobalMappingGetInfo() and
> ISLocalToGlobalMappingRestoreInfo(). Would it be possible for you to include
> these, and possibly any other missing IS routines not having a Fortran
> interface, in PETSc v2.3.1 as a new patch version.
>
> Regards
>
> Stephen
> --
> _______________________________________________________________________________
>
> The information in this email and in any attachment(s) is commercial in confidence. If you are not the named addressee(s) or if you receive this email in error then any distribution, copying or use of this communication or the information in it is strictly prohibited.  Please notify us immediately by email at admin.internet(at)awe.co.uk, and then delete this message from your computer.  While attachments are virus checked, AWE plc does not accept any liability in respect of any virus which is not detected.
>
> AWE Plc
> Registered in England and Wales
> Registration No 02763902
> AWE, Aldermaston, Reading, RG7 4PR
>
>
-------------- next part --------------
#include "zpetsc.h"
#include "petscis.h"

#if defined(PETSC_HAVE_FORTRAN_CAPS)
#define islocaltoglobalmappingview_       ISLOCALTOGLOBALMAPPINGVIEW
#define islocaltoglobalmpnggetinfosize_   ISLOCALTOGLOBALMPNGGETINFOSIZE
#define islocaltoglobalmappinggetinfo_    ISLOCALTOGLOBALMAPPINGGETINFO
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
#define islocaltoglobalmappingview_       islocaltoglobalmappingview
#define islocaltoglobalmpnggetinfosize_   islocaltoglobalmpnggetinfosize
#define islocaltoglobalmappinggetinfo_    islocaltoglobalmappinggetinfo
#endif

EXTERN_C_BEGIN

void PETSC_STDCALL islocaltoglobalmappingview_(ISLocalToGlobalMapping *mapping,PetscViewer *viewer,PetscErrorCode *ierr)
{
  PetscViewer v;
  PetscPatchDefaultViewers_Fortran(viewer,v);
  *ierr = ISLocalToGlobalMappingView(*mapping,v);
}

static PetscInt   *sprocs, *snumprocs, **sindices;
static PetscTruth called;
void PETSC_STDCALL islocaltoglobalmpnggetinfosize_(ISLocalToGlobalMapping *mapping,PetscInt *nprocs,PetscInt *maxnumprocs,PetscErrorCode *ierr)
{
  PetscInt i;
  if (!called) {*ierr = PETSC_ERR_ARG_WRONGSTATE; return;}
  *ierr        = ISLocalToGlobalMappingGetInfo(*mapping,nprocs,&sprocs,&snumprocs,&sindices); if (*ierr) return;
  *maxnumprocs = 0;
  for (i=0; i<*nprocs; i++) {
    *maxnumprocs = PetscMax(*maxnumprocs,snumprocs[i]);
  }
  called = PETSC_TRUE;
}

void PETSC_STDCALL islocaltoglobalmappinggetinfo_(ISLocalToGlobalMapping *mapping,PetscInt *nprocs,PetscInt *procs,PetscInt *numprocs,
                                                  PetscInt *indices,PetscErrorCode *ierr)
{
  PetscInt i,j;
  if (!called) {*ierr = PETSC_ERR_ARG_WRONGSTATE; return;}
  *ierr = PetscMemcpy(procs,sprocs,*nprocs*sizeof(PetscInt)); if (*ierr) return;
  *ierr = PetscMemcpy(numprocs,snumprocs,*nprocs*sizeof(PetscInt)); if (*ierr) return;
  for (i=0; i<*nprocs; i++) {
    for (j=0; j<numprocs[i]; j++) {
      indices[i + (*nprocs)*j] = sindices[i][j];
    }
  }
  *ierr = ISLocalToGlobalMappingRestoreInfo(*mapping,nprocs,&sprocs,&snumprocs,&sindices); if (*ierr) return;
  called = PETSC_FALSE;
}

EXTERN_C_END