Skip to content

Commit e942cfc

Browse files
committed
generalize select, selctg
1 parent 3004036 commit e942cfc

File tree

1 file changed

+27
-78
lines changed

1 file changed

+27
-78
lines changed

src/stdlib_linalg_lapack_aux.fypp

Lines changed: 27 additions & 78 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
#:include "common.fypp"
2+
#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES
23
module stdlib_linalg_lapack_aux
34
use stdlib_linalg_constants
45
use stdlib_linalg_blas
@@ -53,94 +54,42 @@ module stdlib_linalg_lapack_aux
5354
#:if WITH_QP
5455
public :: stdlib_iwmax1
5556
#:endif
56-
public :: stdlib_selctg_s
57-
public :: stdlib_select_s
58-
public :: stdlib_selctg_d
59-
public :: stdlib_select_d
60-
#:if WITH_QP
61-
public :: stdlib_selctg_q
62-
public :: stdlib_select_q
63-
#:endif
64-
public :: stdlib_selctg_c
65-
public :: stdlib_select_c
66-
public :: stdlib_selctg_z
67-
public :: stdlib_select_z
68-
#:if WITH_QP
69-
public :: stdlib_selctg_w
70-
public :: stdlib_select_w
71-
#:endif
57+
58+
#:for rk,rt,ri in RC_KINDS_TYPES
59+
public :: stdlib_select_${ri}$
60+
public :: stdlib_selctg_${ri}$
61+
#:endfor
62+
7263
! SELCTG is a LOGICAL FUNCTION of three DOUBLE PRECISION arguments
7364
! used to select eigenvalues to sort to the top left of the Schur form.
7465
! An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if SELCTG is true, i.e.,
7566
abstract interface
76-
pure logical(lk) function stdlib_selctg_s(alphar,alphai,beta)
77-
import sp,dp,qp,lk
78-
implicit none
79-
real(sp), intent(in) :: alphar,alphai,beta
80-
end function stdlib_selctg_s
81-
pure logical(lk) function stdlib_select_s(alphar,alphai)
82-
import sp,dp,qp,lk
83-
implicit none
84-
real(sp), intent(in) :: alphar,alphai
85-
end function stdlib_select_s
86-
pure logical(lk) function stdlib_selctg_d(alphar,alphai,beta)
87-
import sp,dp,qp,lk
88-
implicit none
89-
real(dp), intent(in) :: alphar,alphai,beta
90-
end function stdlib_selctg_d
91-
pure logical(lk) function stdlib_select_d(alphar,alphai)
92-
import sp,dp,qp,lk
93-
implicit none
94-
real(dp), intent(in) :: alphar,alphai
95-
end function stdlib_select_d
96-
#:if WITH_QP
97-
pure logical(lk) function stdlib_selctg_q(alphar,alphai,beta)
98-
import sp,dp,qp,lk
67+
#:for rk,rt,ri in REAL_KINDS_TYPES
68+
pure logical(lk) function stdlib_selctg_${ri}$(alphar,alphai,beta)
69+
import ${rk}$,lk
9970
implicit none
100-
real(qp), intent(in) :: alphar,alphai,beta
101-
end function stdlib_selctg_q
102-
pure logical(lk) function stdlib_select_q(alphar,alphai)
103-
import sp,dp,qp,lk
71+
real(${rk}$), intent(in) :: alphar,alphai,beta
72+
end function stdlib_selctg_${ri}$
73+
pure logical(lk) function stdlib_select_${ri}$(alphar,alphai)
74+
import ${rk}$,lk
10475
implicit none
105-
real(qp), intent(in) :: alphar,alphai
106-
end function stdlib_select_q
107-
#:endif
108-
pure logical(lk) function stdlib_selctg_c(alpha,beta)
109-
import sp,dp,qp,lk
76+
real(${rk}$), intent(in) :: alphar,alphai
77+
end function stdlib_select_${ri}$
78+
#:endfor
79+
#:for ck,ct,ci in CMPLX_KINDS_TYPES
80+
pure logical(lk) function stdlib_selctg_${ci}$(alpha,beta)
81+
import ${ck}$,lk
11082
implicit none
111-
complex(sp), intent(in) :: alpha,beta
112-
end function stdlib_selctg_c
113-
pure logical(lk) function stdlib_select_c(alpha)
114-
import sp,dp,qp,lk
83+
complex(${ck}$), intent(in) :: alpha,beta
84+
end function stdlib_selctg_${ci}$
85+
pure logical(lk) function stdlib_select_${ci}$(alpha)
86+
import ${ck}$,lk
11587
implicit none
116-
complex(sp), intent(in) :: alpha
117-
end function stdlib_select_c
118-
pure logical(lk) function stdlib_selctg_z(alpha,beta)
119-
import sp,dp,qp,lk
120-
implicit none
121-
complex(dp), intent(in) :: alpha,beta
122-
end function stdlib_selctg_z
123-
pure logical(lk) function stdlib_select_z(alpha)
124-
import sp,dp,qp,lk
125-
implicit none
126-
complex(dp), intent(in) :: alpha
127-
end function stdlib_select_z
128-
#:if WITH_QP
129-
pure logical(lk) function stdlib_selctg_w(alpha,beta)
130-
import sp,dp,qp,lk
131-
implicit none
132-
complex(qp), intent(in) :: alpha,beta
133-
end function stdlib_selctg_w
134-
pure logical(lk) function stdlib_select_w(alpha)
135-
import sp,dp,qp,lk
136-
implicit none
137-
complex(qp), intent(in) :: alpha
138-
end function stdlib_select_w
139-
#:endif
88+
complex(${ck}$), intent(in) :: alpha
89+
end function stdlib_select_${ci}$
90+
#:endfor
14091
end interface
14192

142-
143-
14493
contains
14594

14695

0 commit comments

Comments
 (0)