Actual source code: zrgf.c

slepc-3.21.2 2024-09-25
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 <slepcrg.h>

 14: #if defined(PETSC_HAVE_FORTRAN_CAPS)
 15: #define rgsettype_                RGSETTYPE
 16: #define rggettype_                RGGETTYPE
 17: #define rgsetoptionsprefix_       RGSETOPTIONSPREFIX
 18: #define rgappendoptionsprefix_    RGAPPENDOPTIONSPREFIX
 19: #define rggetoptionsprefix_       RGGETOPTIONSPREFIX
 20: #define rgdestroy_                RGDESTROY
 21: #define rgview_                   RGVIEW
 22: #define rgviewfromoptions_        RGVIEWFROMOPTIONS
 23: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 24: #define rgsettype_                rgsettype
 25: #define rggettype_                rggettype
 26: #define rgsetoptionsprefix_       rgsetoptionsprefix
 27: #define rgappendoptionsprefix_    rgappendoptionsprefix
 28: #define rggetoptionsprefix_       rggetoptionsprefix
 29: #define rgdestroy_                rgdestroy
 30: #define rgview_                   rgview
 31: #define rgviewfromoptions_        rgviewfromoptions
 32: #endif

 34: SLEPC_EXTERN void rgsettype_(RG *rg,char *type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
 35: {
 36:   char *t;

 38:   FIXCHAR(type,len,t);
 39:   *ierr = RGSetType(*rg,t);
 40:   FREECHAR(type,t);
 41: }

 43: SLEPC_EXTERN void rggettype_(RG *rg,char *name,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
 44: {
 45:   RGType tname;

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

 52: SLEPC_EXTERN void rgsetoptionsprefix_(RG *rg,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
 53: {
 54:   char *t;

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

 61: SLEPC_EXTERN void rgappendoptionsprefix_(RG *rg,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
 62: {
 63:   char *t;

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

 70: SLEPC_EXTERN void rggetoptionsprefix_(RG *rg,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
 71: {
 72:   const char *tname;

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

 79: SLEPC_EXTERN void rgdestroy_(RG *rg,PetscErrorCode *ierr)
 80: {
 81:   PETSC_FORTRAN_OBJECT_F_DESTROYED_TO_C_NULL(rg);
 82:   *ierr = RGDestroy(rg); if (*ierr) return;
 83:   PETSC_FORTRAN_OBJECT_C_NULL_TO_F_DESTROYED(rg);
 84: }

 86: SLEPC_EXTERN void rgview_(RG *rg,PetscViewer *viewer,PetscErrorCode *ierr)
 87: {
 88:   PetscViewer v;
 89:   PetscPatchDefaultViewers_Fortran(viewer,v);
 90:   *ierr = RGView(*rg,v);
 91: }

 93: SLEPC_EXTERN void rgviewfromoptions_(RG *rg,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 = RGViewFromOptions(*rg,obj,t);if (*ierr) return;
100:   FREECHAR(type,t);
101: }