Skip to content

Commit 58c4eaf

Browse files
loiseaujcloiseaujc
committed
Added tests for Hermitian Tridiagonal matrices.
1 parent fbb3474 commit 58c4eaf

File tree

3 files changed

+351
-88
lines changed

3 files changed

+351
-88
lines changed

‎src/stdlib_specialmatrices.fypp‎

Lines changed: 57 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ module stdlib_specialmatrices
1414
LINALG_INTERNAL_ERROR, LINALG_VALUE_ERROR
1515
implicit none
1616
private
17-
public :: tridiagonal, symtridiagonal
17+
public :: tridiagonal, symtridiagonal, hermtridiagonal
1818
public :: spmv
1919
public :: dense, transpose, hermitian
2020
public :: operator(*), operator(+), operator(-)
@@ -370,10 +370,22 @@ module stdlib_specialmatrices
370370
!! [Specifications](../page/specs/stdlib_specialmatrices.html#transpose)
371371
#:for k1, t1, s1 in (KINDS_TYPES)
372372
pure module function transpose_tridiagonal_${s1}$(A) result(B)
373-
class(tridiagonal_${s1}$_type), intent(in) :: A
373+
type(tridiagonal_${s1}$_type), intent(in) :: A
374+
!! Input matrix.
375+
type(tridiagonal_${s1}$_type) :: B
376+
end function
377+
pure module function transpose_symtridiagonal_${s1}$(A) result(B)
378+
type(symtridiagonal_${s1}$_type), intent(in) :: A
374379
!! Input matrix.
375-
class(tridiagonal_${s1}$_type), allocatable :: B
380+
type(symtridiagonal_${s1}$_type) :: B
376381
end function
382+
#:if t1.startswith('complex')
383+
pure module function transpose_hermtridiagonal_${s1}$(A) result(B)
384+
type(hermtridiagonal_${s1}$_type), intent(in) :: A
385+
!! Input matrix.
386+
type(hermtridiagonal_${s1}$_type) :: B
387+
end function
388+
#:endif
377389
#:endfor
378390
end interface
379391

@@ -384,10 +396,22 @@ module stdlib_specialmatrices
384396
!! [Specifications](../page/specs/stdlib_specialmatrices.html#hermitian)
385397
#:for k1, t1, s1 in (KINDS_TYPES)
386398
pure module function hermitian_tridiagonal_${s1}$(A) result(B)
387-
class(tridiagonal_${s1}$_type), intent(in) :: A
399+
type(tridiagonal_${s1}$_type), intent(in) :: A
400+
!! Input matrix.
401+
type(tridiagonal_${s1}$_type) :: B
402+
end function
403+
pure module function hermitian_symtridiagonal_${s1}$(A) result(B)
404+
type(symtridiagonal_${s1}$_type), intent(in) :: A
388405
!! Input matrix.
389-
class(tridiagonal_${s1}$_type), allocatable :: B
406+
type(symtridiagonal_${s1}$_type) :: B
390407
end function
408+
#:if t1.startswith('complex')
409+
pure module function hermitian_hermtridiagonal_${s1}$(A) result(B)
410+
type(hermtridiagonal_${s1}$_type), intent(in) :: A
411+
!! Input matrix.
412+
type(hermtridiagonal_${s1}$_type) :: B
413+
end function
414+
#:endif
391415
#:endfor
392416
end interface
393417

@@ -404,14 +428,38 @@ module stdlib_specialmatrices
404428
#:for k1, t1, s1 in (KINDS_TYPES)
405429
pure module function scalar_multiplication_tridiagonal_${s1}$(alpha, A) result(B)
406430
${t1}$, intent(in) :: alpha
407-
class(tridiagonal_${s1}$_type), intent(in) :: A
408-
class(tridiagonal_${s1}$_type), allocatable :: B
431+
type(tridiagonal_${s1}$_type), intent(in) :: A
432+
type(tridiagonal_${s1}$_type) :: B
409433
end function
410434
pure module function scalar_multiplication_bis_tridiagonal_${s1}$(A, alpha) result(B)
411-
class(tridiagonal_${s1}$_type), intent(in) :: A
435+
type(tridiagonal_${s1}$_type), intent(in) :: A
436+
${t1}$, intent(in) :: alpha
437+
type(tridiagonal_${s1}$_type) :: B
438+
end function
439+
440+
pure module function scalar_multiplication_symtridiagonal_${s1}$(alpha, A) result(B)
441+
${t1}$, intent(in) :: alpha
442+
type(symtridiagonal_${s1}$_type), intent(in) :: A
443+
type(symtridiagonal_${s1}$_type) :: B
444+
end function
445+
pure module function scalar_multiplication_bis_symtridiagonal_${s1}$(A, alpha) result(B)
446+
type(symtridiagonal_${s1}$_type), intent(in) :: A
447+
${t1}$, intent(in) :: alpha
448+
type(symtridiagonal_${s1}$_type) :: B
449+
end function
450+
451+
#:if t1.startswith("complex")
452+
pure module function scalar_multiplication_hermtridiagonal_${s1}$(alpha, A) result(B)
412453
${t1}$, intent(in) :: alpha
413-
class(tridiagonal_${s1}$_type), allocatable :: B
454+
type(hermtridiagonal_${s1}$_type), intent(in) :: A
455+
type(hermtridiagonal_${s1}$_type) :: B
414456
end function
457+
pure module function scalar_multiplication_bis_hermtridiagonal_${s1}$(A, alpha) result(B)
458+
type(hermtridiagonal_${s1}$_type), intent(in) :: A
459+
${t1}$, intent(in) :: alpha
460+
type(hermtridiagonal_${s1}$_type) :: B
461+
end function
462+
#:endif
415463
#:endfor
416464
end interface
417465

‎src/stdlib_specialmatrices_tridiagonal.fypp‎

Lines changed: 78 additions & 57 deletions
Original file line numberDiff line numberDiff line change
@@ -453,86 +453,107 @@ submodule (stdlib_specialmatrices) tridiagonal_matrices
453453

454454
#:for k1, t1, s1 in (KINDS_TYPES)
455455
pure module function transpose_tridiagonal_${s1}$(A) result(B)
456-
class(tridiagonal_${s1}$_type), intent(in) :: A
456+
type(tridiagonal_${s1}$_type), intent(in) :: A
457457
!! Input matrix.
458-
class(tridiagonal_${s1}$_type), allocatable :: B
458+
type(tridiagonal_${s1}$_type) :: B
459+
B = tridiagonal(A%du, A%dv, A%dl)
460+
end function
459461

460-
select type(A)
461-
type is(tridiagonal_${s1}$_type)
462-
B = tridiagonal(A%du, A%dv, A%dl)
463-
464-
type is(symtridiagonal_${s1}$_type)
465-
B = symtridiagonal(A%dv, A%du)
462+
pure module function transpose_symtridiagonal_${s1}$(A) result(B)
463+
type(symtridiagonal_${s1}$_type), intent(in) :: A
464+
type(symtridiagonal_${s1}$_type) :: B
465+
B = symtridiagonal(A%dv, A%du)
466+
end function
466467

467-
#:if t1.startswith('complex')
468-
type is(hermtridiagonal_${s1}$_type)
469-
B = hermtridiagonal(A%dv, A%dl)
470-
#:endif
471-
end select
472-
468+
#:if t1.startswith('complex')
469+
pure module function transpose_hermtridiagonal_${s1}$(A) result(B)
470+
type(hermtridiagonal_${s1}$_type), intent(in) :: A
471+
type(hermtridiagonal_${s1}$_type) :: B
472+
B = hermtridiagonal(A%dv, A%dl)
473473
end function
474+
#:endif
474475
#:endfor
475476

476477
#:for k1, t1, s1 in (KINDS_TYPES)
477478
pure module function hermitian_tridiagonal_${s1}$(A) result(B)
478-
class(tridiagonal_${s1}$_type), intent(in) :: A
479+
type(tridiagonal_${s1}$_type), intent(in) :: A
479480
!! Input matrix.
480-
class(tridiagonal_${s1}$_type), allocatable :: B
481-
482-
select type(A)
483-
type is(tridiagonal_${s1}$_type)
484-
#:if t1.startswith("complex")
485-
B = tridiagonal(conjg(A%du), conjg(A%dv), conjg(A%dl))
486-
#:else
487-
B = tridiagonal(A%du, A%dv, A%dl)
488-
#:endif
489-
490-
type is(symtridiagonal_${s1}$_type)
491-
#:if t1.startswith("complex")
492-
B = symtridiagonal(conjg(A%dv), conjg(A%du))
493-
#:else
494-
B = symtridiagonal(A%dv, A%du)
495-
#:endif
496-
481+
type(tridiagonal_${s1}$_type) :: B
497482
#:if t1.startswith("complex")
498-
type is(hermtridiagonal_${s1}$_type)
499-
B = hermtridiagonal(A%dv, A%du)
483+
B = tridiagonal(conjg(A%du), conjg(A%dv), conjg(A%dl))
484+
#:else
485+
B = tridiagonal(A%du, A%dv, A%dl)
500486
#:endif
501-
end select
502-
503487
end function
488+
489+
pure module function hermitian_symtridiagonal_${s1}$(A) result(B)
490+
type(symtridiagonal_${s1}$_type), intent(in) :: A
491+
type(symtridiagonal_${s1}$_type) :: B
492+
#:if t1.startswith("complex")
493+
B = symtridiagonal(conjg(A%dv), conjg(A%du))
494+
#:else
495+
B = A
496+
#:endif
497+
end function
498+
499+
#:if t1.startswith("complex")
500+
pure module function hermitian_hermtridiagonal_${s1}$(A) result(B)
501+
type(hermtridiagonal_${s1}$_type), intent(in) :: A
502+
type(hermtridiagonal_${s1}$_type) :: B
503+
B = A
504+
end function
505+
#:endif
504506
#:endfor
505507

506508
#:for k1, t1, s1 in (KINDS_TYPES)
507509
pure module function scalar_multiplication_tridiagonal_${s1}$(alpha, A) result(B)
508510
${t1}$, intent(in) :: alpha
509-
class(tridiagonal_${s1}$_type), intent(in) :: A
510-
class(tridiagonal_${s1}$_type), allocatable :: B
511-
512-
select type(A)
513-
type is(tridiagonal_${s1}$_type)
514-
B = tridiagonal(A%dl, A%dv, A%du)
515-
B%dl = alpha*B%dl; B%dv = alpha*B%dv; B%du = alpha*B%du
516-
517-
type is(symtridiagonal_${s1}$_type)
518-
B = symtridiagonal(A%dv, A%du)
519-
B%dl = alpha*B%dl; B%dv = alpha*B%dv; B%du = B%dl
520-
521-
#:if t1.startswith("complex")
522-
type is (hermtridiagonal_${s1}$_type)
523-
B = hermtridiagonal(A%dv, A%du)
524-
B%dl = alpha*B%dl; B%dv = alpha*B%dv; B%du = conjg(B%dl)
525-
#:endif
526-
end select
527-
511+
type(tridiagonal_${s1}$_type), intent(in) :: A
512+
type(tridiagonal_${s1}$_type) :: B
513+
B = tridiagonal(A%dl, A%dv, A%du)
514+
B%dl = alpha*B%dl; B%dv = alpha*B%dv; B%du = alpha*B%du
528515
end function
529516

530517
pure module function scalar_multiplication_bis_tridiagonal_${s1}$(A, alpha) result(B)
531-
class(tridiagonal_${s1}$_type), intent(in) :: A
518+
type(tridiagonal_${s1}$_type), intent(in) :: A
532519
${t1}$, intent(in) :: alpha
533-
class(tridiagonal_${s1}$_type), allocatable :: B
520+
type(tridiagonal_${s1}$_type) :: B
534521
B = scalar_multiplication_tridiagonal_${s1}$(alpha, A)
535522
end function
523+
524+
pure module function scalar_multiplication_symtridiagonal_${s1}$(alpha, A) result(B)
525+
${t1}$, intent(in) :: alpha
526+
type(symtridiagonal_${s1}$_type), intent(in) :: A
527+
type(symtridiagonal_${s1}$_type) :: B
528+
B = symtridiagonal(A%dv, A%du)
529+
B%dl = alpha*B%dl; B%dv = alpha*B%dv; B%du = B%dl
530+
end function
531+
532+
pure module function scalar_multiplication_bis_symtridiagonal_${s1}$(A, alpha) result(B)
533+
type(symtridiagonal_${s1}$_type), intent(in) :: A
534+
${t1}$, intent(in) :: alpha
535+
type(symtridiagonal_${s1}$_type) :: B
536+
B = symtridiagonal(A%dv, A%du)
537+
B%dl = alpha*B%dl; B%dv = alpha*B%dv; B%du = B%dl
538+
end function
539+
540+
#:if t1.startswith("complex")
541+
pure module function scalar_multiplication_hermtridiagonal_${s1}$(alpha, A) result(B)
542+
${t1}$, intent(in) :: alpha
543+
type(hermtridiagonal_${s1}$_type), intent(in) :: A
544+
type(hermtridiagonal_${s1}$_type) :: B
545+
B = hermtridiagonal(A%dv, A%du)
546+
B%dl = alpha*B%dl; B%dv = alpha*B%dv; B%du = conjg(B%dl)
547+
end function
548+
549+
pure module function scalar_multiplication_bis_hermtridiagonal_${s1}$(A, alpha) result(B)
550+
type(hermtridiagonal_${s1}$_type), intent(in) :: A
551+
${t1}$, intent(in) :: alpha
552+
type(hermtridiagonal_${s1}$_type) :: B
553+
B = hermtridiagonal(A%dv, A%du)
554+
B%dl = alpha*B%dl; B%dv = alpha*B%dv; B%du = conjg(B%dl)
555+
end function
556+
#:endif
536557
#:endfor
537558

538559
#:for k1, t1, s1 in (KINDS_TYPES)

0 commit comments

Comments
 (0)