55! These have been refactored into modern Fortran.
66
77 module dvode_blas_module
8-
8+
99#ifndef HAS_BLAS
1010
1111 use dvode_kinds_module, only: wp = > dvode_wp
@@ -21,7 +21,7 @@ module dvode_blas_module
2121 real (wp),parameter :: ten = 10.0_wp
2222 real (wp),parameter :: hun = 100.0_wp
2323
24- public :: daxpy,dcopy,ddot,dnrm2, dscal,idamax
24+ public :: daxpy,dcopy,ddot,dscal,idamax
2525
2626 contains
2727! *******************************************************************************
@@ -39,8 +39,8 @@ subroutine daxpy(n,da,dx,incx,dy,incy)
3939
4040 integer ,intent (in ) :: n
4141 real (wp),intent (in ) :: da
42- real (wp),intent (in ) :: dx(* )
43- integer ,intent (in ) :: incx
42+ real (wp),intent (in ) :: dx(* )
43+ integer ,intent (in ) :: incx
4444 real (wp),intent (inout ) :: dy(* )
4545 integer ,intent (in ) :: incy
4646
@@ -101,13 +101,13 @@ subroutine dcopy(n,dx,incx,dy,incy)
101101
102102 implicit none
103103
104- integer ,intent (in ) :: n
105- real (wp),intent (in ) :: dx(* )
106- integer ,intent (in ) :: incx
104+ integer ,intent (in ) :: n
105+ real (wp),intent (in ) :: dx(* )
106+ integer ,intent (in ) :: incx
107107 real (wp),intent (inout ) :: dy(* )
108- integer ,intent (in ) :: incy
108+ integer ,intent (in ) :: incy
109109
110- integer :: i , ix , iy , m , mp1
110+ integer :: i , ix , iy , m , mp1
111111
112112 if ( n<= 0 ) return
113113 if ( incx== 1 .and. incy== 1 ) then
@@ -222,61 +222,6 @@ real(wp) function ddot(n,dx,incx,dy,incy)
222222 end function ddot
223223! *******************************************************************************
224224
225- ! *******************************************************************************
226- ! >
227- ! Function that returns the Euclidean norm
228- ! \( \sqrt{ \mathbf{x}^T \mathbf{x} } \) of a vector \( \mathbf{x} \).
229- !
230- ! ### Further details
231- !
232- ! * this version written on 25-october-1982.
233- ! * modified on 14-october-1993 to inline the call to dlassq.
234- ! sven hammarling, nag ltd.
235- ! * Converted to modern Fortran, Jacob Williams, Jan. 2016.
236- !
237- ! @note Replaced original SLSQP routine with this one from
238- ! [BLAS](http://netlib.sandia.gov/blas/dnrm2.f).
239-
240- real(wp) function dnrm2 (n ,x ,incx )
241-
242- implicit none
243-
244- integer ,intent (in ) :: incx
245- integer ,intent (in ) :: n
246- real (wp),dimension (* ),intent (in ) :: x
247-
248- real (wp) :: absxi , norm , scale , ssq
249- integer :: ix
250-
251- if ( n< 1 .or. incx< 1 ) then
252- norm = zero
253- else if ( n== 1 ) then
254- norm = abs (x(1 ))
255- else
256- scale = zero
257- ssq = one
258- ! the following loop is equivalent to this call to the lapack
259- ! auxiliary routine:
260- ! call dlassq( n, x, incx, scale, ssq )
261- do ix = 1 , 1 + (n-1 )* incx , incx
262- if ( x(ix)/= zero ) then
263- absxi = abs (x(ix))
264- if ( scale< absxi ) then
265- ssq = one + ssq* (scale/ absxi)** 2
266- scale = absxi
267- else
268- ssq = ssq + (absxi/ scale)** 2
269- end if
270- end if
271- end do
272- norm = scale* sqrt (ssq)
273- end if
274-
275- dnrm2 = norm
276-
277- end function dnrm2
278- ! *******************************************************************************
279-
280225! *******************************************************************************
281226! >
282227! scales a vector by a constant.
@@ -290,7 +235,7 @@ subroutine dscal(n,da,dx,incx)
290235 implicit none
291236
292237 integer ,intent (in ) :: n
293- real (wp),intent (in ) :: da
238+ real (wp),intent (in ) :: da
294239 real (wp),intent (inout ) :: dx(* )
295240 integer ,intent (in ) :: incx
296241
0 commit comments