Actual source code: zrgf.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 <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: }