Date: 2024-04-26T10:23:08+00:00

Actual source code: zdsf.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 <slepcds.h>

     14: #if defined(PETSC_HAVE_FORTRAN_CAPS)
     15: #define dssettype_                DSSETTYPE
     16: #define dsgettype_                DSGETTYPE
     17: #define dssetoptionsprefix_       DSSETOPTIONSPREFIX
     18: #define dsappendoptionsprefix_    DSAPPENDOPTIONSPREFIX
     19: #define dsgetoptionsprefix_       DSGETOPTIONSPREFIX
     20: #define dsdestroy_                DSDESTROY
     21: #define dsview_                   DSVIEW
     22: #define dsviewfromoptions_        DSVIEWFROMOPTIONS
     23: #define dsviewmat_                DSVIEWMAT
     24: #define dsvectors_                DSVECTORS
     25: #define dssort_                   DSSORT
     26: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
     27: #define dssettype_                dssettype
     28: #define dsgettype_                dsgettype
     29: #define dssetoptionsprefix_       dssetoptionsprefix
     30: #define dsappendoptionsprefix_    dsappendoptionsprefix
     31: #define dsgetoptionsprefix_       dsgetoptionsprefix
     32: #define dsdestroy_                dsdestroy
     33: #define dsview_                   dsview
     34: #define dsviewfromoptions_        dsviewfromoptions
     35: #define dsviewmat_                dsviewmat
     36: #define dsvectors_                dsvectors
     37: #define dssort_                   dssort
     38: #endif

     40: SLEPC_EXTERN void dssettype_(DS *ds,char *type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
     41: {
     42:   char *t;

     44:   FIXCHAR(type,len,t);
     45:   *ierr = DSSetType(*ds,t);if (*ierr) return;
     46:   FREECHAR(type,t);
     47: }

     49: SLEPC_EXTERN void dsgettype_(DS *ds,char *name,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
     50: {
     51:   DSType tname;

     53:   *ierr = DSGetType(*ds,&tname);if (*ierr) return;
     54:   *ierr = PetscStrncpy(name,tname,len);if (*ierr) return;
     55:   FIXRETURNCHAR(PETSC_TRUE,name,len);
     56: }

     58: SLEPC_EXTERN void dssetoptionsprefix_(DS *ds,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
     59: {
     60:   char *t;

     62:   FIXCHAR(prefix,len,t);
     63:   *ierr = DSSetOptionsPrefix(*ds,t);if (*ierr) return;
     64:   FREECHAR(prefix,t);
     65: }

     67: SLEPC_EXTERN void dsappendoptionsprefix_(DS *ds,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
     68: {
     69:   char *t;

     71:   FIXCHAR(prefix,len,t);
     72:   *ierr = DSAppendOptionsPrefix(*ds,t);if (*ierr) return;
     73:   FREECHAR(prefix,t);
     74: }

     76: SLEPC_EXTERN void dsgetoptionsprefix_(DS *ds,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
     77: {
     78:   const char *tname;

     80:   *ierr = DSGetOptionsPrefix(*ds,&tname); if (*ierr) return;
     81:   *ierr = PetscStrncpy(prefix,tname,len);if (*ierr) return;
     82:   FIXRETURNCHAR(PETSC_TRUE,prefix,len);
     83: }

     85: SLEPC_EXTERN void dsdestroy_(DS *ds,PetscErrorCode *ierr)
     86: {
     87:   PETSC_FORTRAN_OBJECT_F_DESTROYED_TO_C_NULL(ds);
     88:   *ierr = DSDestroy(ds); if (*ierr) return;
     89:   PETSC_FORTRAN_OBJECT_C_NULL_TO_F_DESTROYED(ds);
     90: }

     92: SLEPC_EXTERN void dsview_(DS *ds,PetscViewer *viewer,PetscErrorCode *ierr)
     93: {
     94:   PetscViewer v;
     95:   PetscPatchDefaultViewers_Fortran(viewer,v);
     96:   *ierr = DSView(*ds,v);
     97: }

     99: SLEPC_EXTERN void dsviewfromoptions_(DS *ds,PetscObject obj,char* type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
    100: {
    101:   char *t;

    103:   FIXCHAR(type,len,t);
    104:   CHKFORTRANNULLOBJECT(obj);
    105:   *ierr = DSViewFromOptions(*ds,obj,t);if (*ierr) return;
    106:   FREECHAR(type,t);
    107: }

    109: SLEPC_EXTERN void dsviewmat_(DS *ds,PetscViewer *viewer,DSMatType *m,PetscErrorCode *ierr)
    110: {
    111:   PetscViewer v;
    112:   PetscPatchDefaultViewers_Fortran(viewer,v);
    113:   *ierr = DSViewMat(*ds,v,*m);
    114: }

    116: SLEPC_EXTERN void dsvectors_(DS *ds,DSMatType *mat,PetscInt *j,PetscReal *rnorm,PetscErrorCode *ierr)
    117: {
    118:   CHKFORTRANNULLINTEGER(j);
    119:   CHKFORTRANNULLREAL(rnorm);
    120:   *ierr = DSVectors(*ds,*mat,j,rnorm);
    121: }

    123: SLEPC_EXTERN void dssort_(DS *ds,PetscScalar *eigr,PetscScalar *eigi,PetscScalar *rr,PetscScalar *ri,PetscInt *k,PetscErrorCode *ierr)
    124: {
    125:   CHKFORTRANNULLSCALAR(eigr);
    126:   CHKFORTRANNULLSCALAR(eigi);
    127:   CHKFORTRANNULLSCALAR(rr);
    128:   CHKFORTRANNULLSCALAR(ri);
    129:   CHKFORTRANNULLINTEGER(k);
    130:   *ierr = DSSort(*ds,eigr,eigi,rr,ri,k);
    131: }