Subversion Repositories slepc-dev

Rev

Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
1376 slepc 1 
/*
2 
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1672 slepc 3 
   SLEPc - Scalable Library for Eigenvalue Problem Computations
2116 eromero 4 
   Copyright (c) 2002-2010, Universidad Politecnica de Valencia, Spain
1024 slepc 5 
 
1672 slepc 6 
   This file is part of SLEPc.
7 
 
8 
   SLEPc is free software: you can redistribute it and/or modify it under  the
9 
   terms of version 3 of the GNU Lesser General Public License as published by
10 
   the Free Software Foundation.
11 
 
12 
   SLEPc  is  distributed in the hope that it will be useful, but WITHOUT  ANY
13 
   WARRANTY;  without even the implied warranty of MERCHANTABILITY or  FITNESS
14 
   FOR  A  PARTICULAR PURPOSE. See the GNU Lesser General Public  License  for
15 
   more details.
16 
 
17 
   You  should have received a copy of the GNU Lesser General  Public  License
18 
   along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
1376 slepc 19 
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
20 
*/
21 
 
1469 slepc 22 
#include "private/fortranimpl.h"
1024 slepc 23 
#include "slepcst.h"
24 
 
25 
#ifdef PETSC_HAVE_FORTRAN_CAPS
1781 antodo 26 
#define stshellgetcontext_        STSHELLGETCONTEXT
1024 slepc 27 
#define stshellsetapply_          STSHELLSETAPPLY
28 
#define stshellsetapplytranspose_ STSHELLSETAPPLYTRANSPOSE
29 
#define stshellsetbacktransform_  STSHELLSETBACKTRANSFORM
1781 antodo 30 
#define stshellsetname_           STSHELLSETNAME
1024 slepc 31 
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
1781 antodo 32 
#define stshellgetcontext_        stshellgetcontext
1024 slepc 33 
#define stshellsetapply_          stshellsetapply
34 
#define stshellsetapplytranspose_ stshellsetapplytranspose
35 
#define stshellsetbacktransform_  stshellsetbacktransform
1781 antodo 36 
#define stshellsetname_           stshellsetname
1024 slepc 37 
#endif
38 
 
39 
/* These are not extern C because they are passed into non-extern C user level functions */
1780 antodo 40 
static PetscErrorCode ourshellapply(ST st,Vec x,Vec y)
1024 slepc 41 
{
42 
  PetscErrorCode ierr = 0;
1780 antodo 43 
  (*(void (PETSC_STDCALL *)(ST*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)st)->fortran_func_pointers[0]))(&st,&x,&y,&ierr);CHKERRQ(ierr);
1024 slepc 44 
  return 0;
45 
}
46 
 
1780 antodo 47 
static PetscErrorCode ourshellapplytranspose(ST st,Vec x,Vec y)
1024 slepc 48 
{
49 
  PetscErrorCode ierr = 0;
1780 antodo 50 
  (*(void (PETSC_STDCALL *)(ST*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)st)->fortran_func_pointers[1]))(&st,&x,&y,&ierr);CHKERRQ(ierr);
1024 slepc 51 
  return 0;
52 
}
53 
 
1780 antodo 54 
static PetscErrorCode ourshellbacktransform(ST st,PetscInt n,PetscScalar *eigr,PetscScalar *eigi)
1024 slepc 55 
{
56 
  PetscErrorCode ierr = 0;
1780 antodo 57 
  (*(void (PETSC_STDCALL *)(ST*,PetscInt*,PetscScalar*,PetscScalar*,PetscErrorCode*))(((PetscObject)st)->fortran_func_pointers[2]))(&st,&n,eigr,eigi,&ierr);CHKERRQ(ierr);
1024 slepc 58 
  return 0;
59 
}
60 
 
61 
EXTERN_C_BEGIN
62 
 
1780 antodo 63 
void PETSC_STDCALL stshellgetcontext_(ST *st,void **ctx,PetscErrorCode *ierr)
64 
{
65 
  *ierr = STShellGetContext(*st,ctx);
66 
}
67 
 
1024 slepc 68 
void PETSC_STDCALL stshellsetapply_(ST *st,void (PETSC_STDCALL *apply)(void*,Vec *,Vec *,PetscErrorCode*),
69 
                                    PetscErrorCode *ierr)
70 
{
1780 antodo 71 
  PetscObjectAllocateFortranPointers(*st,3);
72 
  ((PetscObject)*st)->fortran_func_pointers[0] = (PetscVoidFunction)apply;
1024 slepc 73 
  *ierr = STShellSetApply(*st,ourshellapply);
74 
}
75 
 
76 
void PETSC_STDCALL stshellsetapplytranspose_(ST *st,void (PETSC_STDCALL *applytranspose)(void*,Vec *,Vec *,PetscErrorCode*),
77 
                                             PetscErrorCode *ierr)
78 
{
1780 antodo 79 
  PetscObjectAllocateFortranPointers(*st,3);
80 
  ((PetscObject)*st)->fortran_func_pointers[1] = (PetscVoidFunction)applytranspose;
1024 slepc 81 
  *ierr = STShellSetApplyTranspose(*st,ourshellapplytranspose);
82 
}
83 
 
84 
void PETSC_STDCALL stshellsetbacktransform_(ST *st,void (PETSC_STDCALL *backtransform)(void*,PetscScalar*,PetscScalar*,PetscErrorCode*),
85 
                                    PetscErrorCode *ierr)
86 
{
1781 antodo 87 
  PetscObjectAllocateFortranPointers(*st,3);
1780 antodo 88 
  ((PetscObject)*st)->fortran_func_pointers[2] = (PetscVoidFunction)backtransform;
1024 slepc 89 
  *ierr = STShellSetBackTransform(*st,ourshellbacktransform);
90 
}
91 
 
1780 antodo 92 
void PETSC_STDCALL stshellsetname_(ST *st,CHAR name PETSC_MIXED_LEN(len), PetscErrorCode *ierr PETSC_END_LEN(len))
93 
{
94 
  char *c;
95 
  FIXCHAR(name,len,c);
96 
  *ierr = STShellSetName(*st,c);
97 
  FREECHAR(name,c);
98 
}
99 
 
1024 slepc 100 
EXTERN_C_END
101