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