Actual source code: zstf.c
slepc-3.21.1 2024-04-26
Report Typos and Errors

      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: }