Subversion Repositories slepc-dev

Rev

Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
1376 slepc 1
/*
2
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3
      SLEPc - Scalable Library for Eigenvalue Problem Computations
4
      Copyright (c) 2002-2007, Universidad Politecnica de Valencia, Spain
986 slepc 5
 
1376 slepc 6
      This file is part of SLEPc. See the README file for conditions of use
7
      and additional information.
8
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
9
*/
10
 
986 slepc 11
#include "zpetsc.h"
12
#include "slepcst.h"
13
 
14
#ifdef PETSC_HAVE_FORTRAN_CAPS
15
#define stsettype_                STSETTYPE          
16
#define stgettype_                STGETTYPE
17
#define stcreate_                 STCREATE
18
#define stgetoperators_           STGETOPERATORS
19
#define stsetoptionsprefix_       STSETOPTIONSPREFIX
20
#define stappendoptionsprefix_    STAPPENDOPTIONSPREFIX
21
#define stgetoptionsprefix_       STGETOPTIONSPREFIX
22
#define stview_                   STVIEW
23
#define stgetmatmode_             STGETMATMODE
24
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
25
#define stsettype_                stsettype
26
#define stgettype_                stgettype
27
#define stcreate_                 stcreate
28
#define stgetoperators_           stgetoperators
29
#define stsetoptionsprefix_       stsetoptionsprefix
30
#define stappendoptionsprefix_    stappendoptionsprefix
31
#define stgetoptionsprefix_       stgetoptionsprefix
32
#define stview_                   stview
33
#define stgetmatmode_             stgetmatmode
34
#endif
35
 
36
EXTERN_C_BEGIN
37
 
38
void PETSC_STDCALL stsettype_(ST *st,CHAR type PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
39
{
40
  char *t;
41
 
42
  FIXCHAR(type,len,t);
43
  *ierr = STSetType(*st,t);
44
  FREECHAR(type,t);
45
}
46
 
47
void PETSC_STDCALL stgettype_(ST *st,CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
48
{
1004 slepc 49
  const char *tname;
986 slepc 50
 
51
  *ierr = STGetType(*st,&tname);
52
#if defined(PETSC_USES_CPTOFCD)
53
  {
54
  char *t = _fcdtocp(name); int len1 = _fcdlen(name);
55
  *ierr = PetscStrncpy(t,tname,len1); if (*ierr) return;
56
  }
57
#else
58
  *ierr = PetscStrncpy(name,tname,len);if (*ierr) return;
59
#endif
60
  FIXRETURNCHAR(name,len);
61
}
62
 
1345 slepc 63
void PETSC_STDCALL stcreate_(MPI_Fint *comm,ST *newst,PetscErrorCode *ierr)
986 slepc 64
{
1345 slepc 65
  *ierr = STCreate(MPI_Comm_f2c(*(comm)),newst);
986 slepc 66
}
67
 
68
void PETSC_STDCALL stgetoperators_(ST *st,Mat *mat,Mat *pmat,PetscErrorCode *ierr)
69
{
70
  if (FORTRANNULLOBJECT(mat))   mat = PETSC_NULL;
71
  if (FORTRANNULLOBJECT(pmat))  pmat = PETSC_NULL;
72
  *ierr = STGetOperators(*st,mat,pmat);
73
}
74
 
75
void PETSC_STDCALL stsetoptionsprefix_(ST *st,CHAR prefix PETSC_MIXED_LEN(len),
76
                                       PetscErrorCode *ierr PETSC_END_LEN(len))
77
{
78
  char *t;
79
 
80
  FIXCHAR(prefix,len,t);
81
  *ierr = STSetOptionsPrefix(*st,t);
82
  FREECHAR(prefix,t);
83
}
84
 
85
void PETSC_STDCALL stappendoptionsprefix_(ST *st,CHAR prefix PETSC_MIXED_LEN(len),
86
                                          PetscErrorCode *ierr PETSC_END_LEN(len))
87
{
88
  char *t;
89
 
90
  FIXCHAR(prefix,len,t);
91
  *ierr = STAppendOptionsPrefix(*st,t);
92
  FREECHAR(prefix,t);
93
}
94
 
95
void PETSC_STDCALL stgetoptionsprefix_(ST *st,CHAR prefix PETSC_MIXED_LEN(len),
96
                                       PetscErrorCode *ierr PETSC_END_LEN(len))
97
{
98
  const char *tname;
99
 
100
  *ierr = STGetOptionsPrefix(*st,&tname);
101
#if defined(PETSC_USES_CPTOFCD)
102
  {
103
    char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
104
    *ierr = PetscStrncpy(t,tname,len1);if (*ierr) return;
105
  }
106
#else
107
  *ierr = PetscStrncpy(prefix,tname,len);if (*ierr) return;
108
#endif
109
  FIXRETURNCHAR(prefix,len);
110
}
111
 
112
void PETSC_STDCALL stview_(ST *st,PetscViewer *viewer, PetscErrorCode *ierr)
113
{
114
  PetscViewer v;
115
  PetscPatchDefaultViewers_Fortran(viewer,v);
116
  *ierr = STView(*st,v);
117
}
118
 
119
void PETSC_STDCALL  stgetmatmode_(ST *st,STMatMode *mode,int *ierr)
120
{
121
  *ierr = STGetMatMode(*st,mode);
122
}
123
 
124
EXTERN_C_END
125