1: /*
  2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
  4:    Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain

  6:    This file is part of SLEPc.
  7:    SLEPc is distributed under a 2-clause BSD license (see LICENSE).
  8:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  9: */

 11: #include <petsc/private/fortranimpl.h>
 12: #include <slepcst.h>

 14: #if defined(PETSC_HAVE_FORTRAN_CAPS)
 15: #define stsettype_                STSETTYPE
 16: #define stgettype_                STGETTYPE
 17: #define stsetoptionsprefix_       STSETOPTIONSPREFIX
 18: #define stappendoptionsprefix_    STAPPENDOPTIONSPREFIX
 19: #define stgetoptionsprefix_       STGETOPTIONSPREFIX
 20: #define stdestroy_                STDESTROY
 21: #define stview_                   STVIEW
 22: #define stviewfromoptions_        STVIEWFROMOPTIONS
 23: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 24: #define stsettype_                stsettype
 25: #define stgettype_                stgettype
 26: #define stsetoptionsprefix_       stsetoptionsprefix
 27: #define stappendoptionsprefix_    stappendoptionsprefix
 28: #define stgetoptionsprefix_       stgetoptionsprefix
 29: #define stdestroy_                stdestroy
 30: #define stview_                   stview
 31: #define stviewfromoptions_        stviewfromoptions
 32: #endif

 34: SLEPC_EXTERN void stsettype_(ST *st,char *type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
 35: {
 36:   char *t;

 38:   FIXCHAR(type,len,t);
 39:   *ierr = STSetType(*st,t);if (*ierr) return;
 40:   FREECHAR(type,t);
 41: }

 43: SLEPC_EXTERN void stgettype_(ST *st,char *name,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
 44: {
 45:   STType tname;

 47:   *ierr = STGetType(*st,&tname); if (*ierr) return;
 48:   *ierr = PetscStrncpy(name,tname,len);if (*ierr) return;
 49:   FIXRETURNCHAR(PETSC_TRUE,name,len);
 50: }

 52: SLEPC_EXTERN void stsetoptionsprefix_(ST *st,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
 53: {
 54:   char *t;

 56:   FIXCHAR(prefix,len,t);
 57:   *ierr = STSetOptionsPrefix(*st,t);if (*ierr) return;
 58:   FREECHAR(prefix,t);
 59: }

 61: SLEPC_EXTERN void stappendoptionsprefix_(ST *st,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
 62: {
 63:   char *t;

 65:   FIXCHAR(prefix,len,t);
 66:   *ierr = STAppendOptionsPrefix(*st,t);if (*ierr) return;
 67:   FREECHAR(prefix,t);
 68: }

 70: SLEPC_EXTERN void stgetoptionsprefix_(ST *st,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
 71: {
 72:   const char *tname;

 74:   *ierr = STGetOptionsPrefix(*st,&tname); if (*ierr) return;
 75:   *ierr = PetscStrncpy(prefix,tname,len);if (*ierr) return;
 76:   FIXRETURNCHAR(PETSC_TRUE,prefix,len);
 77: }

 79: SLEPC_EXTERN void stdestroy_(ST *st,PetscErrorCode *ierr)
 80: {
 81:   PETSC_FORTRAN_OBJECT_F_DESTROYED_TO_C_NULL(st);
 82:   *ierr = STDestroy(st); if (*ierr) return;
 83:   PETSC_FORTRAN_OBJECT_C_NULL_TO_F_DESTROYED(st);
 84: }

 86: SLEPC_EXTERN void stview_(ST *st,PetscViewer *viewer,PetscErrorCode *ierr)
 87: {
 88:   PetscViewer v;
 89:   PetscPatchDefaultViewers_Fortran(viewer,v);
 90:   *ierr = STView(*st,v);
 91: }

 93: SLEPC_EXTERN void stviewfromoptions_(ST *st,PetscObject obj,char* type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
 94: {
 95:   char *t;

 97:   FIXCHAR(type,len,t);
 98:   CHKFORTRANNULLOBJECT(obj);
 99:   *ierr = STViewFromOptions(*st,obj,t);if (*ierr) return;
100:   FREECHAR(type,t);
101: }