Date: 2016-03-29T14:56:39+00:00

Actual source code: slepcsc.c
slepc-3.6.3 2016-03-29
Report Typos and Errors

      1: /*
      2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
      4:    Copyright (c) 2002-2015, Universitat Politecnica de Valencia, Spain

      6:    This file is part of SLEPc.

      8:    SLEPc is free software: you can redistribute it and/or modify it under  the
      9:    terms of version 3 of the GNU Lesser General Public License as published by
     10:    the Free Software Foundation.

     12:    SLEPc  is  distributed in the hope that it will be useful, but WITHOUT  ANY
     13:    WARRANTY;  without even the implied warranty of MERCHANTABILITY or  FITNESS
     14:    FOR  A  PARTICULAR PURPOSE. See the GNU Lesser General Public  License  for
     15:    more details.

     17:    You  should have received a copy of the GNU Lesser General  Public  License
     18:    along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
     19:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     20: */

     22: #include <slepc/private/slepcimpl.h>     /*I "slepcsys.h" I*/
     23: #include <slepcrg.h>
     24: #include <slepcst.h>

     28: /*@
     29:    SlepcSCCompare - Compares two (possibly complex) values according
     30:    to a certain criterion.

     32:    Not Collective

     34:    Input Parameters:
     35: +  sc  - the sorting criterion context
     36: .  ar  - real part of the 1st value
     37: .  ai  - imaginary part of the 1st value
     38: .  br  - real part of the 2nd value
     39: -  bi  - imaginary part of the 2nd value

     41:    Output Parameter:
     42: .  res - result of comparison

     44:    Notes:
     45:    Returns an integer less than, equal to, or greater than zero if the first
     46:    value is considered to be respectively less than, equal to, or greater
     47:    than the second one.

     49:    Level: developer

     51: .seealso: SlepcSortEigenvalues(), SlepcSC
     52: @*/
     53: PetscErrorCode SlepcSCCompare(SlepcSC sc,PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *res)
     54: {
     56:   PetscScalar    re[2],im[2];
     57:   PetscInt       cin[2];
     58:   PetscBool      inside[2];

     62: #if defined(PETSC_USE_DEBUG)
     63:   if (!sc->comparison) SETERRQ(PETSC_COMM_SELF,1,"Undefined comparison function");
     64: #endif
     65:   re[0] = ar; re[1] = br;
     66:   im[0] = ai; im[1] = bi;
     67:   if (sc->map) {
     68:     (*sc->map)(sc->mapobj,2,re,im);
     69:   }
     70:   if (sc->rg) {
     71:     RGCheckInside(sc->rg,2,re,im,cin);
     72:     inside[0] = (cin[0]>0)? PETSC_TRUE: PETSC_FALSE;
     73:     inside[1] = (cin[1]>0)? PETSC_TRUE: PETSC_FALSE;
     74:     if (inside[0] && !inside[1]) *res = -1;
     75:     else if (!inside[0] && inside[1]) *res = 1;
     76:     else {
     77:       (*sc->comparison)(re[0],im[0],re[1],im[1],res,sc->comparisonctx);
     78:     }
     79:   } else {
     80:     (*sc->comparison)(re[0],im[0],re[1],im[1],res,sc->comparisonctx);
     81:   }
     82:   return(0);
     83: }

     87: /*@
     88:    SlepcSortEigenvalues - Sorts a list of eigenvalues according to the
     89:    sorting criterion specified in a SlepcSC context.

     91:    Not Collective

     93:    Input Parameters:
     94: +  sc   - the sorting criterion context
     95: .  n    - number of eigenvalues in the list
     96: .  eigr - pointer to the array containing the eigenvalues
     97: -  eigi - imaginary part of the eigenvalues (only when using real numbers)

     99:    Input/Output Parameter:
    100: .  perm - permutation array. Must be initialized to 0:n-1 on input.

    102:    Note:
    103:    The result is a list of indices in the original eigenvalue array
    104:    corresponding to the first n eigenvalues sorted in the specified
    105:    criterion.

    107:    Level: developer

    109: .seealso: SlepcSCCompare(), SlepcSC
    110: @*/
    111: PetscErrorCode SlepcSortEigenvalues(SlepcSC sc,PetscInt n,PetscScalar *eigr,PetscScalar *eigi,PetscInt *perm)
    112: {
    114:   PetscScalar    re,im;
    115:   PetscInt       i,j,result,tmp;

    122:   /* insertion sort */
    123:   for (i=n-1;i>=0;i--) {
    124:     re = eigr[perm[i]];
    125:     im = eigi[perm[i]];
    126:     j = i+1;
    127: #if !defined(PETSC_USE_COMPLEX)
    128:     if (im!=0) {
    129:       /* complex eigenvalue */
    130:       i--;
    131:       im = eigi[perm[i]];
    132:     }
    133: #endif
    134:     while (j<n) {
    135:       SlepcSCCompare(sc,re,im,eigr[perm[j]],eigi[perm[j]],&result);
    136:       if (result<0) break;
    137: #if !defined(PETSC_USE_COMPLEX)
    138:       /* keep together every complex conjugated eigenpair */
    139:       if (!im) {
    140:         if (eigi[perm[j]] == 0.0) {
    141: #endif
    142:           tmp = perm[j-1]; perm[j-1] = perm[j]; perm[j] = tmp;
    143:           j++;
    144: #if !defined(PETSC_USE_COMPLEX)
    145:         } else {
    146:           tmp = perm[j-1]; perm[j-1] = perm[j]; perm[j] = perm[j+1]; perm[j+1] = tmp;
    147:           j+=2;
    148:         }
    149:       } else {
    150:         if (eigi[perm[j]] == 0.0) {
    151:           tmp = perm[j-2]; perm[j-2] = perm[j]; perm[j] = perm[j-1]; perm[j-1] = tmp;
    152:           j++;
    153:         } else {
    154:           tmp = perm[j-2]; perm[j-2] = perm[j]; perm[j] = tmp;
    155:           tmp = perm[j-1]; perm[j-1] = perm[j+1]; perm[j+1] = tmp;
    156:           j+=2;
    157:         }
    158:       }
    159: #endif
    160:     }
    161:   }
    162:   return(0);
    163: }

    167: /*
    168:    SlepcMap_ST - Gateway function to call STBackTransform from outside ST.
    169: */
    170: PetscErrorCode SlepcMap_ST(PetscObject obj,PetscInt n,PetscScalar* eigr,PetscScalar* eigi)
    171: {

    175:   STBackTransform((ST)obj,n,eigr,eigi);
    176:   return(0);
    177: }

    181: PetscErrorCode SlepcCompareLargestMagnitude(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
    182: {
    183:   PetscReal a,b;

    186:   a = SlepcAbsEigenvalue(ar,ai);
    187:   b = SlepcAbsEigenvalue(br,bi);
    188:   if (a<b) *result = 1;
    189:   else if (a>b) *result = -1;
    190:   else *result = 0;
    191:   return(0);
    192: }

    196: PetscErrorCode SlepcCompareSmallestMagnitude(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
    197: {
    198:   PetscReal a,b;

    201:   a = SlepcAbsEigenvalue(ar,ai);
    202:   b = SlepcAbsEigenvalue(br,bi);
    203:   if (a>b) *result = 1;
    204:   else if (a<b) *result = -1;
    205:   else *result = 0;
    206:   return(0);
    207: }

    211: PetscErrorCode SlepcCompareLargestReal(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
    212: {
    213:   PetscReal a,b;

    216:   a = PetscRealPart(ar);
    217:   b = PetscRealPart(br);
    218:   if (a<b) *result = 1;
    219:   else if (a>b) *result = -1;
    220:   else *result = 0;
    221:   return(0);
    222: }

    226: PetscErrorCode SlepcCompareSmallestReal(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
    227: {
    228:   PetscReal a,b;

    231:   a = PetscRealPart(ar);
    232:   b = PetscRealPart(br);
    233:   if (a>b) *result = 1;
    234:   else if (a<b) *result = -1;
    235:   else *result = 0;
    236:   return(0);
    237: }

    241: PetscErrorCode SlepcCompareLargestImaginary(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
    242: {
    243:   PetscReal a,b;

    246: #if defined(PETSC_USE_COMPLEX)
    247:   a = PetscImaginaryPart(ar);
    248:   b = PetscImaginaryPart(br);
    249: #else
    250:   a = PetscAbsReal(ai);
    251:   b = PetscAbsReal(bi);
    252: #endif
    253:   if (a<b) *result = 1;
    254:   else if (a>b) *result = -1;
    255:   else *result = 0;
    256:   return(0);
    257: }

    261: PetscErrorCode SlepcCompareSmallestImaginary(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
    262: {
    263:   PetscReal a,b;

    266: #if defined(PETSC_USE_COMPLEX)
    267:   a = PetscImaginaryPart(ar);
    268:   b = PetscImaginaryPart(br);
    269: #else
    270:   a = PetscAbsReal(ai);
    271:   b = PetscAbsReal(bi);
    272: #endif
    273:   if (a>b) *result = 1;
    274:   else if (a<b) *result = -1;
    275:   else *result = 0;
    276:   return(0);
    277: }

    281: PetscErrorCode SlepcCompareTargetMagnitude(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
    282: {
    283:   PetscReal   a,b;
    284:   PetscScalar *target = (PetscScalar*)ctx;

    287:   /* complex target only allowed if scalartype=complex */
    288:   a = SlepcAbsEigenvalue(ar-(*target),ai);
    289:   b = SlepcAbsEigenvalue(br-(*target),bi);
    290:   if (a>b) *result = 1;
    291:   else if (a<b) *result = -1;
    292:   else *result = 0;
    293:   return(0);
    294: }

    298: PetscErrorCode SlepcCompareTargetReal(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
    299: {
    300:   PetscReal   a,b;
    301:   PetscScalar *target = (PetscScalar*)ctx;

    304:   a = PetscAbsReal(PetscRealPart(ar-(*target)));
    305:   b = PetscAbsReal(PetscRealPart(br-(*target)));
    306:   if (a>b) *result = 1;
    307:   else if (a<b) *result = -1;
    308:   else *result = 0;
    309:   return(0);
    310: }

    314: PetscErrorCode SlepcCompareTargetImaginary(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
    315: {
    316:   PetscReal   a,b;
    317: #if defined(PETSC_USE_COMPLEX)
    318:   PetscScalar *target = (PetscScalar*)ctx;
    319: #endif

    322: #if !defined(PETSC_USE_COMPLEX)
    323:   /* complex target only allowed if scalartype=complex */
    324:   a = PetscAbsReal(ai);
    325:   b = PetscAbsReal(bi);
    326: #else
    327:   a = PetscAbsReal(PetscImaginaryPart(ar-(*target)));
    328:   b = PetscAbsReal(PetscImaginaryPart(br-(*target)));
    329: #endif
    330:   if (a>b) *result = 1;
    331:   else if (a<b) *result = -1;
    332:   else *result = 0;
    333:   return(0);
    334: }

    338: /*
    339:    Used in the SVD for computing smallest singular values
    340:    from the cyclic matrix.
    341: */
    342: PetscErrorCode SlepcCompareSmallestPosReal(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
    343: {
    344:   PetscReal a,b;
    345:   PetscBool aisright,bisright;

    348:   if (PetscRealPart(ar)>0.0) aisright = PETSC_TRUE;
    349:   else aisright = PETSC_FALSE;
    350:   if (PetscRealPart(br)>0.0) bisright = PETSC_TRUE;
    351:   else bisright = PETSC_FALSE;
    352:   if (aisright == bisright) { /* same sign */
    353:     a = SlepcAbsEigenvalue(ar,ai);
    354:     b = SlepcAbsEigenvalue(br,bi);
    355:     if (a>b) *result = 1;
    356:     else if (a<b) *result = -1;
    357:     else *result = 0;
    358:   } else if (aisright && !bisright) *result = -1; /* 'a' is on the right */
    359:   else *result = 1;  /* 'b' is on the right */
    360:   return(0);
    361: }