blas_aux template

Author: perazz

include/common.fypp

@@ -77,7 +77,8 @@ $:"s" if cmplx=="c" else "d" if cmplx=="z" else "x" if cmplx=="y" else "q" if cm
 #! BLAS/LAPACK/Linear Algebra Integer Kinds
 #:set LINALG_INT_KINDS       = ["ilp","ilp64"]
 #:set LINALG_INT_TYPES       = ["integer({})".format(k) for k in LINALG_INT_KINDS]
-#:set LINALG_INT_KINDS_TYPES = list(zip(LINALG_INT_KINDS, LINALG_INT_TYPES))
+#:set LINALG_INT_SUFFIX      = ["_{}".format(k) for k in LINALG_INT_KINDS]
+#:set LINALG_INT_KINDS_TYPES = list(zip(LINALG_INT_KINDS, LINALG_INT_TYPES, LINALG_INT_SUFFIX))
 
 #! Complex types to be considered during templating
 #:set CMPLX_TYPES = ["complex({})".format(k) for k in CMPLX_KINDS]

src/stdlib_linalg_blas_aux.fypp

@@ -21,6 +21,27 @@ module stdlib_linalg_blas_aux
         #:endfor
      end interface stdlib_cabs1
 
+     #:for rk,rt,ri in RC_KINDS_TYPES
+     interface stdlib_i${ri}$amax
+         #:for ik,it,ii in LINALG_INT_KINDS_TYPES
+         module procedure stdlib${ii}$_i${ri}$amax
+         #:endfor        
+     end interface stdlib_i${ri}$amax
+     #:endfor
+
+     interface stdlib_xerbla
+         #:for ik,it,ii in LINALG_INT_KINDS_TYPES
+         module procedure stdlib${ii}$_xerbla
+         #:endfor        
+     end interface stdlib_xerbla
+
+     interface stdlib_xerbla_array
+         #:for ik,it,ii in LINALG_INT_KINDS_TYPES
+         module procedure stdlib${ii}$_xerbla_array
+         #:endfor        
+     end interface stdlib_xerbla_array
+
+
      contains
 
 
@@ -57,13 +78,13 @@ module stdlib_linalg_blas_aux
            stdlib_lsame = ca == cb
            if (stdlib_lsame) return
            ! now test for equivalence if both characters are alphabetic.
-           zcode = ichar('Z')
+           zcode = ichar('Z',kind=ilp)
            ! use 'z' rather than 'a' so that ascii can be detected on prime
            ! machines, on which ichar returns a value with bit 8 set.
            ! ichar('a') on prime machines returns 193 which is the same as
            ! ichar('a') on an ebcdic machine.
-           inta = ichar(ca)
-           intb = ichar(cb)
+           inta = ichar(ca,kind=ilp)
+           intb = ichar(cb,kind=ilp)
            if (zcode==90 .or. zcode==122) then
               ! ascii is assumed - zcode is the ascii code of either lower or
               ! upper case 'z'.
@@ -86,7 +107,8 @@ module stdlib_linalg_blas_aux
            ! return
      end function stdlib_lsame
 
-     pure subroutine stdlib_xerbla( srname, info )
+     #:for ik,it,ii in LINALG_INT_KINDS_TYPES
+     pure subroutine stdlib${ii}$_xerbla( srname, info )
      !! XERBLA is an error handler for the LAPACK routines.
      !! It is called by an LAPACK routine if an input parameter has an
      !! invalid value.  A message is printed and execution stops.
@@ -97,17 +119,17 @@ module stdlib_linalg_blas_aux
         ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
            ! Scalar Arguments 
            character(len=*), intent(in) :: srname
-           integer(ilp), intent(in) :: info
+           integer(${ik}$), intent(in) :: info
        ! =====================================================================
            ! Intrinsic Functions 
            intrinsic :: len_trim
            ! Executable Statements 
       9999 format( ' ** ON ENTRY TO ', a, ' PARAMETER NUMBER ', i2, ' HAD ','AN ILLEGAL VALUE' )
 
-     end subroutine stdlib_xerbla
+     end subroutine stdlib${ii}$_xerbla
 
 
-     pure subroutine stdlib_xerbla_array(srname_array, srname_len, info)
+     pure subroutine stdlib${ii}$_xerbla_array(srname_array, srname_len, info)
      !! XERBLA_ARRAY assists other languages in calling XERBLA, the LAPACK
      !! and BLAS error handler.  Rather than taking a Fortran string argument
      !! as the function's name, XERBLA_ARRAY takes an array of single
@@ -128,12 +150,12 @@ module stdlib_linalg_blas_aux
         ! -- reference blas is a software package provided by univ. of tennessee,    --
         ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
            ! Scalar Arguments 
-           integer(ilp), intent(in) :: srname_len, info
+           integer(${ik}$), intent(in) :: srname_len, info
            ! Array Arguments 
            character(1), intent(in) :: srname_array(srname_len)
        ! =====================================================================
            ! Local Scalars 
-           integer(ilp) :: i
+           integer(${ik}$) :: i
            ! Local Arrays 
            character*32 srname
            ! Intrinsic Functions 
@@ -145,34 +167,34 @@ module stdlib_linalg_blas_aux
            end do
            call stdlib_xerbla( srname, info )
            return
-     end subroutine stdlib_xerbla_array
+     end subroutine stdlib${ii}$_xerbla_array
 
 #:for rk,rt,ri in REAL_KINDS_TYPES
-     pure integer(ilp) function stdlib_i${ri}$amax(n,dx,incx)
+     pure integer(${ik}$) function stdlib${ii}$_i${ri}$amax(n,dx,incx) result(iamax)
      !! IDAMAX: finds the index of the first element having maximum absolute value.
         ! -- reference blas level1 routine --
         ! -- reference blas is a software package provided by univ. of tennessee,    --
         ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
            ! Scalar Arguments 
-           integer(ilp), intent(in) :: incx, n
+           integer(${ik}$), intent(in) :: incx, n
            ! Array Arguments 
            real(${rk}$), intent(in) :: dx(*)
         ! =====================================================================
            ! Local Scalars 
            real(${rk}$) :: dmax
-           integer(ilp) :: i, ix
+           integer(${ik}$) :: i, ix
            ! Intrinsic Functions 
            intrinsic :: abs
-           stdlib_i${ri}$amax = 0
+           iamax = 0
            if (n<1 .or. incx<=0) return
-           stdlib_i${ri}$amax = 1
+           iamax = 1
            if (n==1) return
            if (incx==1) then
               ! code for increment equal to 1
               dmax = abs(dx(1))
               do i = 2,n
                  if (abs(dx(i))>dmax) then
-                    stdlib_i${ri}$amax = i
+                    iamax = i
                     dmax = abs(dx(i))
                  end if
               end do
@@ -183,41 +205,40 @@ module stdlib_linalg_blas_aux
               ix = ix + incx
               do i = 2,n
                  if (abs(dx(ix))>dmax) then
-                    stdlib_i${ri}$amax = i
+                    iamax = i
                     dmax = abs(dx(ix))
                  end if
                  ix = ix + incx
               end do
            end if
            return
-     end function stdlib_i${ri}$amax
+     end function stdlib${ii}$_i${ri}$amax
 
 #:endfor
-
 #:for ck,ct,ci in CMPLX_KINDS_TYPES
-     pure integer(ilp) function stdlib_i${ci}$amax(n,zx,incx)
+     pure integer(${ik}$) function stdlib${ii}$_i${ci}$amax(n,zx,incx) result(iamax)
      !! IZAMAX: finds the index of the first element having maximum |Re(.)| + |Im(.)|
         ! -- reference blas level1 routine --
         ! -- reference blas is a software package provided by univ. of tennessee,    --
         ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
            ! Scalar Arguments 
-           integer(ilp), intent(in) :: incx, n
+           integer(${ik}$), intent(in) :: incx, n
            ! Array Arguments 
            complex(${ck}$), intent(in) :: zx(*)
         ! =====================================================================
            ! Local Scalars 
            real(${ck}$) :: dmax
-           integer(ilp) :: i, ix
-           stdlib_i${ci}$amax = 0
+           integer(${ik}$) :: i, ix
+           iamax = 0
            if (n<1 .or. incx<=0) return
-           stdlib_i${ci}$amax = 1
+           iamax = 1
            if (n==1) return
            if (incx==1) then
               ! code for increment equal to 1
               dmax = stdlib_cabs1(zx(1))
               do i = 2,n
                  if (stdlib_cabs1(zx(i))>dmax) then
-                    stdlib_i${ci}$amax = i
+                    iamax = i
                     dmax = stdlib_cabs1(zx(i))
                  end if
               end do
@@ -228,15 +249,16 @@ module stdlib_linalg_blas_aux
               ix = ix + incx
               do i = 2,n
                  if (stdlib_cabs1(zx(ix))>dmax) then
-                    stdlib_i${ci}$amax = i
+                    iamax = i
                     dmax = stdlib_cabs1(zx(ix))
                  end if
                  ix = ix + incx
               end do
            end if
            return
-     end function stdlib_i${ci}$amax
+     end function stdlib${ii}$_i${ci}$amax
 
 #:endfor
+#:endfor
 
 end module stdlib_linalg_blas_aux