| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | /* | ||
| 2 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 3 | SLEPc - Scalable Library for Eigenvalue Problem Computations | ||
| 4 | Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain | ||
| 5 | |||
| 6 | This file is part of SLEPc. | ||
| 7 | SLEPc is distributed under a 2-clause BSD license (see LICENSE). | ||
| 8 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 9 | */ | ||
| 10 | /* | ||
| 11 | Utility subroutines common to several impls | ||
| 12 | */ | ||
| 13 | |||
| 14 | #include <slepc/private/dsimpl.h> /*I "slepcds.h" I*/ | ||
| 15 | #include <slepcblaslapack.h> | ||
| 16 | |||
| 17 | /* | ||
| 18 | Compute the (real) Schur form of A. At the end, A is (quasi-)triangular and Q | ||
| 19 | contains the unitary matrix of Schur vectors. Eigenvalues are returned in wr,wi | ||
| 20 | */ | ||
| 21 | 40309 | PetscErrorCode DSSolve_NHEP_Private(DS ds,DSMatType mA,DSMatType mQ,PetscScalar *wr,PetscScalar *wi) | |
| 22 | { | ||
| 23 | 40309 | PetscScalar *work,*tau,*A,*Q; | |
| 24 | 40309 | PetscInt i,j; | |
| 25 | 40309 | PetscBLASInt ilo,lwork,n,k,ld; | |
| 26 | |||
| 27 |
1/2✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
|
40309 | PetscFunctionBegin; |
| 28 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
40309 | PetscCall(MatDenseGetArray(ds->omat[mA],&A)); |
| 29 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
40309 | PetscCall(MatDenseGetArray(ds->omat[mQ],&Q)); |
| 30 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
40309 | PetscCall(PetscBLASIntCast(ds->n,&n)); |
| 31 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
40309 | PetscCall(PetscBLASIntCast(ds->ld,&ld)); |
| 32 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
40309 | PetscCall(PetscBLASIntCast(ds->l+1,&ilo)); |
| 33 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
40309 | PetscCall(PetscBLASIntCast(ds->k,&k)); |
| 34 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
40309 | PetscCall(DSAllocateWork_Private(ds,ld+6*ld,0,0)); |
| 35 | 40309 | tau = ds->work; | |
| 36 | 40309 | work = ds->work+ld; | |
| 37 | 40309 | lwork = 6*ld; | |
| 38 | |||
| 39 | /* initialize orthogonal matrix */ | ||
| 40 |
4/6✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
40309 | PetscCall(PetscArrayzero(Q,ld*ld)); |
| 41 |
2/2✓ Branch 0 taken 10 times.
✓ Branch 1 taken 10 times.
|
777774 | for (i=0;i<n;i++) Q[i+i*ld] = 1.0; |
| 42 |
2/2✓ Branch 0 taken 10 times.
✓ Branch 1 taken 10 times.
|
40309 | if (n==1) { /* quick return */ |
| 43 | 460 | wr[0] = A[0]; | |
| 44 |
1/2✓ Branch 0 taken 10 times.
✗ Branch 1 not taken.
|
460 | if (wi) wi[0] = 0.0; |
| 45 |
6/12✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 2 times.
✓ Branch 4 taken 2 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 2 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 2 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✓ Branch 11 taken 2 times.
|
460 | PetscFunctionReturn(PETSC_SUCCESS); |
| 46 | } | ||
| 47 | |||
| 48 | /* reduce to upper Hessenberg form */ | ||
| 49 |
2/2✓ Branch 0 taken 10 times.
✓ Branch 1 taken 10 times.
|
39849 | if (ds->state<DS_STATE_INTERMEDIATE) { |
| 50 |
13/28✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✓ Branch 3 taken 8 times.
✓ Branch 4 taken 2 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 10 times.
✓ Branch 8 taken 2 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✓ Branch 11 taken 2 times.
✓ Branch 12 taken 2 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 2 times.
✗ Branch 15 not taken.
✗ Branch 16 not taken.
✓ Branch 17 taken 2 times.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
✗ Branch 20 not taken.
✓ Branch 21 taken 2 times.
✗ Branch 22 not taken.
✗ Branch 23 not taken.
✗ Branch 24 not taken.
✓ Branch 25 taken 2 times.
✗ Branch 26 not taken.
✗ Branch 27 not taken.
|
27105 | PetscCallLAPACKInfo("LAPACKgehrd",LAPACKgehrd_(&n,&ilo,&n,A,&ld,tau,work,&lwork,&info)); |
| 51 |
2/2✓ Branch 0 taken 10 times.
✓ Branch 1 taken 10 times.
|
505779 | for (j=0;j<n-1;j++) { |
| 52 |
2/2✓ Branch 0 taken 10 times.
✓ Branch 1 taken 10 times.
|
6090004 | for (i=j+2;i<n;i++) { |
| 53 | 5611330 | Q[i+j*ld] = A[i+j*ld]; | |
| 54 | 5611330 | A[i+j*ld] = 0.0; | |
| 55 | } | ||
| 56 | } | ||
| 57 |
13/28✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✓ Branch 3 taken 8 times.
✓ Branch 4 taken 2 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 10 times.
✓ Branch 8 taken 2 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✓ Branch 11 taken 2 times.
✓ Branch 12 taken 2 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 2 times.
✗ Branch 15 not taken.
✗ Branch 16 not taken.
✓ Branch 17 taken 2 times.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
✗ Branch 20 not taken.
✓ Branch 21 taken 2 times.
✗ Branch 22 not taken.
✗ Branch 23 not taken.
✗ Branch 24 not taken.
✓ Branch 25 taken 2 times.
✗ Branch 26 not taken.
✗ Branch 27 not taken.
|
27105 | PetscCallLAPACKInfo("LAPACKorghr",LAPACKorghr_(&n,&ilo,&n,Q,&ld,tau,work,&lwork,&info)); |
| 58 | } | ||
| 59 | |||
| 60 | /* compute the (real) Schur form */ | ||
| 61 | #if !PetscDefined(USE_COMPLEX) | ||
| 62 |
13/28✓ Branch 0 taken 1 times.
✓ Branch 1 taken 4 times.
✓ Branch 2 taken 1 times.
✓ Branch 3 taken 4 times.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 5 times.
✓ Branch 8 taken 1 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✓ Branch 11 taken 1 times.
✓ Branch 12 taken 1 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 1 times.
✗ Branch 15 not taken.
✗ Branch 16 not taken.
✓ Branch 17 taken 1 times.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
✗ Branch 20 not taken.
✓ Branch 21 taken 1 times.
✗ Branch 22 not taken.
✗ Branch 23 not taken.
✗ Branch 24 not taken.
✓ Branch 25 taken 1 times.
✗ Branch 26 not taken.
✗ Branch 27 not taken.
|
20046 | PetscCallLAPACKInfo("LAPACKhseqr",LAPACKhseqr_("S","V",&n,&ilo,&n,A,&ld,wr,wi,Q,&ld,work,&lwork,&info)); |
| 63 |
2/2✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
|
39083 | for (j=0;j<ds->l;j++) { |
| 64 |
3/4✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 5 times.
✓ Branch 3 taken 5 times.
|
19037 | if (j==n-1 || A[j+1+j*ld] == 0.0) { |
| 65 | /* real eigenvalue */ | ||
| 66 | 17290 | wr[j] = A[j+j*ld]; | |
| 67 | 17290 | wi[j] = 0.0; | |
| 68 | } else { | ||
| 69 | /* complex eigenvalue */ | ||
| 70 | 1747 | wr[j] = A[j+j*ld]; | |
| 71 | 1747 | wr[j+1] = A[j+j*ld]; | |
| 72 | 1747 | wi[j] = PetscSqrtReal(PetscAbsReal(A[j+1+j*ld]))*PetscSqrtReal(PetscAbsReal(A[j+(j+1)*ld])); | |
| 73 | 1747 | wi[j+1] = -wi[j]; | |
| 74 | 1747 | j++; | |
| 75 | } | ||
| 76 | } | ||
| 77 | #else | ||
| 78 |
13/28✓ Branch 0 taken 1 times.
✓ Branch 1 taken 4 times.
✓ Branch 2 taken 1 times.
✓ Branch 3 taken 4 times.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 5 times.
✓ Branch 8 taken 1 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✓ Branch 11 taken 1 times.
✓ Branch 12 taken 1 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 1 times.
✗ Branch 15 not taken.
✗ Branch 16 not taken.
✓ Branch 17 taken 1 times.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
✗ Branch 20 not taken.
✓ Branch 21 taken 1 times.
✗ Branch 22 not taken.
✗ Branch 23 not taken.
✗ Branch 24 not taken.
✓ Branch 25 taken 1 times.
✗ Branch 26 not taken.
✗ Branch 27 not taken.
|
19803 | PetscCallLAPACKInfo("LAPACKhseqr",LAPACKhseqr_("S","V",&n,&ilo,&n,A,&ld,wr,Q,&ld,work,&lwork,&info)); |
| 79 |
4/4✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
✓ Branch 2 taken 5 times.
✓ Branch 3 taken 5 times.
|
352519 | if (wi) for (i=ds->l;i<n;i++) wi[i] = 0.0; |
| 80 | #endif | ||
| 81 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
39849 | PetscCall(MatDenseRestoreArray(ds->omat[mA],&A)); |
| 82 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
39849 | PetscCall(MatDenseRestoreArray(ds->omat[mQ],&Q)); |
| 83 |
6/12✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 2 times.
✓ Branch 4 taken 2 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 2 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 2 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✓ Branch 11 taken 2 times.
|
7897 | PetscFunctionReturn(PETSC_SUCCESS); |
| 84 | } | ||
| 85 | |||
| 86 | /* | ||
| 87 | Sort a Schur form represented by the (quasi-)triangular matrix T and | ||
| 88 | the unitary matrix Q, and return the sorted eigenvalues in wr,wi | ||
| 89 | */ | ||
| 90 | 44126 | PetscErrorCode DSSort_NHEP_Total(DS ds,DSMatType mT,DSMatType mQ,PetscScalar *wr,PetscScalar *wi) | |
| 91 | { | ||
| 92 | 44126 | PetscScalar re,*T,*Q; | |
| 93 | 44126 | PetscInt i,j,pos,result; | |
| 94 | 44126 | PetscBLASInt ifst,ilst,n,ld; | |
| 95 | #if !PetscDefined(USE_COMPLEX) | ||
| 96 | 22232 | PetscScalar *work,im; | |
| 97 | #endif | ||
| 98 | |||
| 99 |
1/2✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
|
44126 | PetscFunctionBegin; |
| 100 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
44126 | PetscCall(MatDenseGetArray(ds->omat[mT],&T)); |
| 101 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
44126 | PetscCall(MatDenseGetArray(ds->omat[mQ],&Q)); |
| 102 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
44126 | PetscCall(PetscBLASIntCast(ds->n,&n)); |
| 103 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
44126 | PetscCall(PetscBLASIntCast(ds->ld,&ld)); |
| 104 | #if !PetscDefined(USE_COMPLEX) | ||
| 105 |
4/6✓ Branch 0 taken 1 times.
✓ Branch 1 taken 4 times.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
|
22232 | PetscCall(DSAllocateWork_Private(ds,ld,0,0)); |
| 106 | 22232 | work = ds->work; | |
| 107 | #endif | ||
| 108 | /* selection sort */ | ||
| 109 |
2/2✓ Branch 0 taken 10 times.
✓ Branch 1 taken 10 times.
|
697387 | for (i=ds->l;i<n-1;i++) { |
| 110 | 653261 | re = wr[i]; | |
| 111 | #if !PetscDefined(USE_COMPLEX) | ||
| 112 | 306506 | im = wi[i]; | |
| 113 | #endif | ||
| 114 | 653261 | pos = 0; | |
| 115 | 653261 | j=i+1; /* j points to the next eigenvalue */ | |
| 116 | #if !PetscDefined(USE_COMPLEX) | ||
| 117 |
2/2✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
|
306506 | if (im != 0) j=i+2; |
| 118 | #endif | ||
| 119 | /* find minimum eigenvalue */ | ||
| 120 |
2/2✓ Branch 0 taken 10 times.
✓ Branch 1 taken 10 times.
|
7745957 | for (;j<n;j++) { |
| 121 | #if !PetscDefined(USE_COMPLEX) | ||
| 122 |
4/6✓ Branch 0 taken 1 times.
✓ Branch 1 taken 4 times.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
|
3206844 | PetscCall(SlepcSCCompare(ds->sc,re,im,wr[j],wi[j],&result)); |
| 123 | #else | ||
| 124 |
4/6✓ Branch 0 taken 1 times.
✓ Branch 1 taken 4 times.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
|
3885852 | PetscCall(SlepcSCCompare(ds->sc,re,0.0,wr[j],0.0,&result)); |
| 125 | #endif | ||
| 126 |
2/2✓ Branch 0 taken 10 times.
✓ Branch 1 taken 10 times.
|
7092696 | if (result > 0) { |
| 127 | 2695596 | re = wr[j]; | |
| 128 | #if !PetscDefined(USE_COMPLEX) | ||
| 129 | 1253141 | im = wi[j]; | |
| 130 | #endif | ||
| 131 | 2695596 | pos = j; | |
| 132 | } | ||
| 133 | #if !PetscDefined(USE_COMPLEX) | ||
| 134 |
2/2✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
|
3206844 | if (wi[j] != 0) j++; |
| 135 | #endif | ||
| 136 | } | ||
| 137 |
2/2✓ Branch 0 taken 10 times.
✓ Branch 1 taken 10 times.
|
653261 | if (pos) { |
| 138 | /* interchange blocks */ | ||
| 139 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
445646 | PetscCall(PetscBLASIntCast(pos+1,&ifst)); |
| 140 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
445646 | PetscCall(PetscBLASIntCast(i+1,&ilst)); |
| 141 | #if !PetscDefined(USE_COMPLEX) | ||
| 142 |
13/28✓ Branch 0 taken 1 times.
✓ Branch 1 taken 4 times.
✓ Branch 2 taken 1 times.
✓ Branch 3 taken 4 times.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 5 times.
✓ Branch 8 taken 1 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✓ Branch 11 taken 1 times.
✓ Branch 12 taken 1 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 1 times.
✗ Branch 15 not taken.
✗ Branch 16 not taken.
✓ Branch 17 taken 1 times.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
✗ Branch 20 not taken.
✓ Branch 21 taken 1 times.
✗ Branch 22 not taken.
✗ Branch 23 not taken.
✗ Branch 24 not taken.
✓ Branch 25 taken 1 times.
✗ Branch 26 not taken.
✗ Branch 27 not taken.
|
206099 | PetscCallLAPACKInfo("LAPACKtrexc",LAPACKtrexc_("V",&n,T,&ld,Q,&ld,&ifst,&ilst,work,&info)); |
| 143 | #else | ||
| 144 |
13/28✓ Branch 0 taken 1 times.
✓ Branch 1 taken 4 times.
✓ Branch 2 taken 1 times.
✓ Branch 3 taken 4 times.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 5 times.
✓ Branch 8 taken 1 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✓ Branch 11 taken 1 times.
✓ Branch 12 taken 1 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 1 times.
✗ Branch 15 not taken.
✗ Branch 16 not taken.
✓ Branch 17 taken 1 times.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
✗ Branch 20 not taken.
✓ Branch 21 taken 1 times.
✗ Branch 22 not taken.
✗ Branch 23 not taken.
✗ Branch 24 not taken.
✓ Branch 25 taken 1 times.
✗ Branch 26 not taken.
✗ Branch 27 not taken.
|
239547 | PetscCallLAPACKInfo("LAPACKtrexc",LAPACKtrexc_("V",&n,T,&ld,Q,&ld,&ifst,&ilst,&info)); |
| 145 | #endif | ||
| 146 | /* recover original eigenvalues from T matrix */ | ||
| 147 |
2/2✓ Branch 0 taken 10 times.
✓ Branch 1 taken 10 times.
|
5945495 | for (j=i;j<n;j++) { |
| 148 | 5499849 | wr[j] = T[j+j*ld]; | |
| 149 | #if !PetscDefined(USE_COMPLEX) | ||
| 150 |
4/4✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
✓ Branch 2 taken 5 times.
✓ Branch 3 taken 5 times.
|
2445608 | if (j<n-1 && T[j+1+j*ld] != 0.0) { |
| 151 | /* complex conjugate eigenvalue */ | ||
| 152 | 286480 | wi[j] = PetscSqrtReal(PetscAbsReal(T[j+1+j*ld]))*PetscSqrtReal(PetscAbsReal(T[j+(j+1)*ld])); | |
| 153 | 286480 | wr[j+1] = wr[j]; | |
| 154 | 286480 | wi[j+1] = -wi[j]; | |
| 155 | 286480 | j++; | |
| 156 | 2159128 | } else wi[j] = 0.0; | |
| 157 | #endif | ||
| 158 | } | ||
| 159 | } | ||
| 160 | #if !PetscDefined(USE_COMPLEX) | ||
| 161 |
2/2✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
|
306506 | if (wi[i] != 0) i++; |
| 162 | #endif | ||
| 163 | } | ||
| 164 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
44126 | PetscCall(MatDenseRestoreArray(ds->omat[mT],&T)); |
| 165 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
44126 | PetscCall(MatDenseRestoreArray(ds->omat[mQ],&Q)); |
| 166 |
6/12✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 2 times.
✓ Branch 4 taken 2 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 2 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 2 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✓ Branch 11 taken 2 times.
|
8737 | PetscFunctionReturn(PETSC_SUCCESS); |
| 167 | } | ||
| 168 | |||
| 169 | /* | ||
| 170 | Reorder a Schur form represented by T,Q according to a permutation perm, | ||
| 171 | and return the sorted eigenvalues in wr,wi | ||
| 172 | */ | ||
| 173 | 189 | PetscErrorCode DSSortWithPermutation_NHEP_Private(DS ds,PetscInt *perm,DSMatType mT,DSMatType mQ,PetscScalar *wr,PetscScalar *wi) | |
| 174 | { | ||
| 175 | 189 | PetscInt i,j,pos,inc=1; | |
| 176 | 189 | PetscBLASInt ifst,ilst,n,ld; | |
| 177 | 189 | PetscScalar *T,*Q; | |
| 178 | #if !PetscDefined(USE_COMPLEX) | ||
| 179 | 75 | PetscScalar *work; | |
| 180 | #endif | ||
| 181 | |||
| 182 |
1/2✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
|
189 | PetscFunctionBegin; |
| 183 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
189 | PetscCall(MatDenseGetArray(ds->omat[mT],&T)); |
| 184 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
189 | PetscCall(MatDenseGetArray(ds->omat[mQ],&Q)); |
| 185 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
189 | PetscCall(PetscBLASIntCast(ds->n,&n)); |
| 186 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
189 | PetscCall(PetscBLASIntCast(ds->ld,&ld)); |
| 187 | #if !PetscDefined(USE_COMPLEX) | ||
| 188 |
4/6✓ Branch 0 taken 1 times.
✓ Branch 1 taken 4 times.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
|
75 | PetscCall(DSAllocateWork_Private(ds,ld,0,0)); |
| 189 | 75 | work = ds->work; | |
| 190 | #endif | ||
| 191 |
2/2✓ Branch 0 taken 10 times.
✓ Branch 1 taken 10 times.
|
4255 | for (i=ds->l;i<n-1;i++) { |
| 192 | 4066 | pos = perm[i]; | |
| 193 | #if !PetscDefined(USE_COMPLEX) | ||
| 194 |
3/4✓ Branch 0 taken 5 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 5 times.
✓ Branch 3 taken 5 times.
|
2100 | inc = (pos<n-1 && T[pos+1+pos*ld] != 0.0)? 2: 1; |
| 195 | #endif | ||
| 196 |
2/2✓ Branch 0 taken 10 times.
✓ Branch 1 taken 10 times.
|
4066 | if (pos!=i) { |
| 197 | #if !PetscDefined(USE_COMPLEX) | ||
| 198 |
5/12✗ Branch 0 not taken.
✓ Branch 1 taken 5 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✓ Branch 4 taken 5 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 5 times.
✓ Branch 7 taken 5 times.
✓ Branch 8 taken 5 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✗ Branch 11 not taken.
|
445 | PetscCheck((T[pos+(pos-1)*ld]==0.0 || perm[i+1]==pos-1) && (pos==n-1 || (T[pos+1+pos*ld]==0.0 || perm[i+1]==pos+1)),PETSC_COMM_SELF,PETSC_ERR_FP,"Invalid permutation due to a 2x2 block at position %" PetscInt_FMT,pos); |
| 199 | #endif | ||
| 200 | /* interchange blocks */ | ||
| 201 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
1347 | PetscCall(PetscBLASIntCast(pos+1,&ifst)); |
| 202 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
1347 | PetscCall(PetscBLASIntCast(i+1,&ilst)); |
| 203 | #if !PetscDefined(USE_COMPLEX) | ||
| 204 |
13/28✓ Branch 0 taken 1 times.
✓ Branch 1 taken 4 times.
✓ Branch 2 taken 1 times.
✓ Branch 3 taken 4 times.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 5 times.
✓ Branch 8 taken 1 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✓ Branch 11 taken 1 times.
✓ Branch 12 taken 1 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 1 times.
✗ Branch 15 not taken.
✗ Branch 16 not taken.
✓ Branch 17 taken 1 times.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
✗ Branch 20 not taken.
✓ Branch 21 taken 1 times.
✗ Branch 22 not taken.
✗ Branch 23 not taken.
✗ Branch 24 not taken.
✓ Branch 25 taken 1 times.
✗ Branch 26 not taken.
✗ Branch 27 not taken.
|
445 | PetscCallLAPACKInfo("LAPACKtrexc",LAPACKtrexc_("V",&n,T,&ld,Q,&ld,&ifst,&ilst,work,&info)); |
| 205 | #else | ||
| 206 |
13/28✓ Branch 0 taken 1 times.
✓ Branch 1 taken 4 times.
✓ Branch 2 taken 1 times.
✓ Branch 3 taken 4 times.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 5 times.
✓ Branch 8 taken 1 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✓ Branch 11 taken 1 times.
✓ Branch 12 taken 1 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 1 times.
✗ Branch 15 not taken.
✗ Branch 16 not taken.
✓ Branch 17 taken 1 times.
✗ Branch 18 not taken.
✗ Branch 19 not taken.
✗ Branch 20 not taken.
✓ Branch 21 taken 1 times.
✗ Branch 22 not taken.
✗ Branch 23 not taken.
✗ Branch 24 not taken.
✓ Branch 25 taken 1 times.
✗ Branch 26 not taken.
✗ Branch 27 not taken.
|
902 | PetscCallLAPACKInfo("LAPACKtrexc",LAPACKtrexc_("V",&n,T,&ld,Q,&ld,&ifst,&ilst,&info)); |
| 207 | #endif | ||
| 208 |
2/2✓ Branch 0 taken 10 times.
✓ Branch 1 taken 10 times.
|
13496 | for (j=i+1;j<n;j++) { |
| 209 |
4/4✓ Branch 0 taken 10 times.
✓ Branch 1 taken 5 times.
✓ Branch 2 taken 10 times.
✓ Branch 3 taken 10 times.
|
12149 | if (perm[j]>=i && perm[j]<pos) perm[j]+=inc; |
| 210 | } | ||
| 211 | 1347 | perm[i] = i; | |
| 212 |
2/2✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
|
1347 | if (inc==2) perm[i+1] = i+1; |
| 213 | } | ||
| 214 |
2/2✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
|
3676 | if (inc==2) i++; |
| 215 | } | ||
| 216 | /* recover original eigenvalues from T matrix */ | ||
| 217 |
2/2✓ Branch 0 taken 10 times.
✓ Branch 1 taken 10 times.
|
4399 | for (j=ds->l;j<n;j++) { |
| 218 | 4210 | wr[j] = T[j+j*ld]; | |
| 219 | #if !PetscDefined(USE_COMPLEX) | ||
| 220 |
4/4✓ Branch 0 taken 5 times.
✓ Branch 1 taken 5 times.
✓ Branch 2 taken 5 times.
✓ Branch 3 taken 5 times.
|
2130 | if (j<n-1 && T[j+1+j*ld] != 0.0) { |
| 221 | /* complex conjugate eigenvalue */ | ||
| 222 | 140 | wi[j] = PetscSqrtReal(PetscAbsReal(T[j+1+j*ld]))*PetscSqrtReal(PetscAbsReal(T[j+(j+1)*ld])); | |
| 223 | 140 | wr[j+1] = wr[j]; | |
| 224 | 140 | wi[j+1] = -wi[j]; | |
| 225 | 140 | j++; | |
| 226 | 1990 | } else wi[j] = 0.0; | |
| 227 | #endif | ||
| 228 | } | ||
| 229 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
189 | PetscCall(MatDenseRestoreArray(ds->omat[mT],&T)); |
| 230 |
4/6✓ Branch 0 taken 2 times.
✓ Branch 1 taken 8 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
|
189 | PetscCall(MatDenseRestoreArray(ds->omat[mQ],&Q)); |
| 231 |
6/12✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 2 times.
✓ Branch 4 taken 2 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 2 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 2 times.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✓ Branch 11 taken 2 times.
|
48 | PetscFunctionReturn(PETSC_SUCCESS); |
| 232 | } | ||
| 233 |