Skip to content

Commit b56ec2c

Browse files
perazzperazz
committed
generalize i*max1 
1 parent 16db44a commit b56ec2c

File tree

1 file changed

+19
-125
lines changed

1 file changed

+19
-125
lines changed

‎src/stdlib_linalg_lapack_aux.fypp

Lines changed: 19 additions & 125 deletions
Original file line numberDiff line numberDiff line change
@@ -8,8 +8,7 @@ module stdlib_linalg_lapack_aux
88

99

1010
public :: sp,dp,qp,lk,ilp
11-
public :: stdlib_chla_transtype
12-
public :: stdlib_icmax1
11+
public :: stdlib_chla_transtype
1312
public :: stdlib_ieeeck
1413
public :: stdlib_iladiag
1514
public :: stdlib_ilaenv
@@ -18,8 +17,7 @@ module stdlib_linalg_lapack_aux
1817
public :: stdlib_ilatrans
1918
public :: stdlib_ilauplo
2019
public :: stdlib_iparam2stage
21-
public :: stdlib_iparmq
22-
public :: stdlib_izmax1
20+
public :: stdlib_iparmq
2321
public :: stdlib_lsamen
2422
public :: stdlib_xerbla
2523
public :: stdlib_xerbla_array
@@ -35,10 +33,9 @@ module stdlib_linalg_lapack_aux
3533
public :: stdlib_${ri}$roundup_lwork
3634
#:endfor
3735

38-
#:if WITH_QP
39-
public :: stdlib_iwmax1
40-
#:endif
41-
36+
#:for ck,ct,ci in CMPLX_KINDS_TYPES
37+
public :: stdlib_i${ci}$max1
38+
#:endfor
4239

4340
! SELCTG is a LOGICAL FUNCTION of three DOUBLE PRECISION arguments
4441
! used to select eigenvalues to sort to the top left of the Schur form.
@@ -104,55 +101,7 @@ module stdlib_linalg_lapack_aux
104101
return
105102
end function stdlib_chla_transtype
106103

107-
pure integer(ilp) function stdlib_icmax1( n, cx, incx )
108-
!! ICMAX1 finds the index of the first vector element of maximum absolute value.
109-
!! Based on ICAMAX from Level 1 BLAS.
110-
!! The change is to use the 'genuine' absolute value.
111-
! -- lapack auxiliary routine --
112-
! -- lapack is a software package provided by univ. of tennessee, --
113-
! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
114-
! Scalar Arguments
115-
integer(ilp), intent(in) :: incx, n
116-
! Array Arguments
117-
complex(sp), intent(in) :: cx(*)
118-
! =====================================================================
119-
! Local Scalars
120-
real(sp) :: smax
121-
integer(ilp) :: i, ix
122-
! Intrinsic Functions
123-
intrinsic :: abs
124-
! Executable Statements
125-
stdlib_icmax1 = 0
126-
if (n<1 .or. incx<=0) return
127-
stdlib_icmax1 = 1
128-
if (n==1) return
129-
if (incx==1) then
130-
! code for increment equal to 1
131-
smax = abs(cx(1))
132-
do i = 2,n
133-
if (abs(cx(i))>smax) then
134-
stdlib_icmax1 = i
135-
smax = abs(cx(i))
136-
end if
137-
end do
138-
else
139-
! code for increment not equal to 1
140-
ix = 1
141-
smax = abs(cx(1))
142-
ix = ix + incx
143-
do i = 2,n
144-
if (abs(cx(ix))>smax) then
145-
stdlib_icmax1 = i
146-
smax = abs(cx(ix))
147-
end if
148-
ix = ix + incx
149-
end do
150-
end if
151-
return
152-
end function stdlib_icmax1
153-
154-
155-
pure integer(ilp) function stdlib_ieeeck( ispec, zero, one )
104+
pure integer(ilp) function stdlib_ieeeck( ispec, zero, one )
156105
!! IEEECK is called from the ILAENV to verify that Infinity and
157106
!! possibly NaN arithmetic is safe (i.e. will not trap).
158107
! -- lapack auxiliary routine --
@@ -503,56 +452,7 @@ module stdlib_linalg_lapack_aux
503452
end if
504453
end function stdlib_iparmq
505454

506-
507-
pure integer(ilp) function stdlib_izmax1( n, zx, incx )
508-
!! IZMAX1 finds the index of the first vector element of maximum absolute value.
509-
!! Based on IZAMAX from Level 1 BLAS.
510-
!! The change is to use the 'genuine' absolute value.
511-
! -- lapack auxiliary routine --
512-
! -- lapack is a software package provided by univ. of tennessee, --
513-
! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
514-
! Scalar Arguments
515-
integer(ilp), intent(in) :: incx, n
516-
! Array Arguments
517-
complex(dp), intent(in) :: zx(*)
518-
! =====================================================================
519-
! Local Scalars
520-
real(dp) :: dmax
521-
integer(ilp) :: i, ix
522-
! Intrinsic Functions
523-
intrinsic :: abs
524-
! Executable Statements
525-
stdlib_izmax1 = 0
526-
if (n<1 .or. incx<=0) return
527-
stdlib_izmax1 = 1
528-
if (n==1) return
529-
if (incx==1) then
530-
! code for increment equal to 1
531-
dmax = abs(zx(1))
532-
do i = 2,n
533-
if (abs(zx(i))>dmax) then
534-
stdlib_izmax1 = i
535-
dmax = abs(zx(i))
536-
end if
537-
end do
538-
else
539-
! code for increment not equal to 1
540-
ix = 1
541-
dmax = abs(zx(1))
542-
ix = ix + incx
543-
do i = 2,n
544-
if (abs(zx(ix))>dmax) then
545-
stdlib_izmax1 = i
546-
dmax = abs(zx(ix))
547-
end if
548-
ix = ix + incx
549-
end do
550-
end if
551-
return
552-
end function stdlib_izmax1
553-
554-
555-
pure logical(lk) function stdlib_lsamen( n, ca, cb )
455+
pure logical(lk) function stdlib_lsamen( n, ca, cb )
556456
!! LSAMEN tests if the first N letters of CA are the same as the
557457
!! first N letters of CB, regardless of case.
558458
!! LSAMEN returns .TRUE. if CA and CB are equivalent except for case
@@ -675,41 +575,35 @@ module stdlib_linalg_lapack_aux
675575

676576
#:endfor
677577

678-
679-
680-
681-
682-
#:if WITH_QP
683-
684-
685-
pure integer(ilp) function stdlib_iwmax1( n, zx, incx )
686-
!! IZMAX1: finds the index of the first vector element of maximum absolute value.
687-
!! Based on IZAMAX from Level 1 BLAS.
578+
#:for ck,ct,ci in CMPLX_KINDS_TYPES
579+
pure integer(ilp) function stdlib_i${ci}$max1( n, zx, incx )
580+
!! I*MAX1: finds the index of the first vector element of maximum absolute value.
581+
!! Based on I*AMAX from Level 1 BLAS.
688582
!! The change is to use the 'genuine' absolute value.
689583
! -- lapack auxiliary routine --
690584
! -- lapack is a software package provided by univ. of tennessee, --
691585
! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
692586
! Scalar Arguments
693587
integer(ilp), intent(in) :: incx, n
694588
! Array Arguments
695-
complex(qp), intent(in) :: zx(*)
589+
complex(${ck}$), intent(in) :: zx(*)
696590
! =====================================================================
697591
! Local Scalars
698-
real(qp) :: dmax
592+
real(${ck}$) :: dmax
699593
integer(ilp) :: i, ix
700594
! Intrinsic Functions
701595
intrinsic :: abs
702596
! Executable Statements
703-
stdlib_iwmax1 = 0
597+
stdlib_i${ci}$max1 = 0
704598
if (n<1 .or. incx<=0) return
705-
stdlib_iwmax1 = 1
599+
stdlib_i${ci}$max1 = 1
706600
if (n==1) return
707601
if (incx==1) then
708602
! code for increment equal to 1
709603
dmax = abs(zx(1))
710604
do i = 2,n
711605
if (abs(zx(i))>dmax) then
712-
stdlib_iwmax1 = i
606+
stdlib_i${ci}$max1 = i
713607
dmax = abs(zx(i))
714608
end if
715609
end do
@@ -720,15 +614,15 @@ module stdlib_linalg_lapack_aux
720614
ix = ix + incx
721615
do i = 2,n
722616
if (abs(zx(ix))>dmax) then
723-
stdlib_iwmax1 = i
617+
stdlib_i${ci}$max1 = i
724618
dmax = abs(zx(ix))
725619
end if
726620
ix = ix + incx
727621
end do
728622
end if
729623
return
730-
end function stdlib_iwmax1
731-
#:endif
624+
end function stdlib_i${ci}$max1
625+
#:endfor
732626

733627

734628
pure integer(ilp) function stdlib_ilaenv( ispec, name, opts, n1, n2, n3, n4 )

0 commit comments

Comments
 (0)