Skip to content

Commit f9d3930

Browse files
committed
refactoring
1 parent a8de1d0 commit f9d3930

File tree

2 files changed

+479
-439
lines changed

2 files changed

+479
-439
lines changed

src/dvode_blas_module.F90

Lines changed: 10 additions & 65 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@
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

Comments
 (0)