Skip to content

Commit a65e771

Browse files
committed
streamline dim-med norm functions
1 parent f6d07f8 commit a65e771

File tree

1 file changed

+11
-36
lines changed

1 file changed

+11
-36
lines changed

src/stdlib_linalg_norms.fypp

Lines changed: 11 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -119,8 +119,9 @@ submodule(stdlib_linalg) stdlib_linalg_norms
119119

120120
end function stride_1d_${ri}$
121121

122-
! Private internal implementation: 1D
123-
pure subroutine internal_norm_1D_${ri}$(sze, a, nrm, norm_request, err)
122+
! Private internal 1D implementation. This has to be used only internally,
123+
! when all inputs are already checked for correctness.
124+
pure subroutine internal_norm_1D_${ri}$(sze, a, nrm, norm_request)
124125
!> Input matrix length
125126
integer(ilp), intent(in) :: sze
126127
!> Input contiguous 1-d matrix a(*)
@@ -129,8 +130,6 @@ submodule(stdlib_linalg) stdlib_linalg_norms
129130
real(${rk}$), intent(out) :: nrm
130131
!> Internal matrix request
131132
integer(ilp), intent(in) :: norm_request
132-
!> State return flag. On error if not requested, the code will stop
133-
type(linalg_state_type), intent(inout) :: err
134133

135134
integer(ilp) :: i
136135
real(${rk}$) :: rorder
@@ -233,7 +232,7 @@ submodule(stdlib_linalg) stdlib_linalg_norms
233232
endif
234233

235234
! Get norm
236-
call internal_norm_1D_${ri}$(sze, a, nrm, norm_request, err_)
235+
call internal_norm_1D_${ri}$(sze, a, nrm, norm_request)
237236
call linalg_error_handling(err_,err)
238237

239238
end subroutine norm_${rank}$D_${ii}$_${ri}$
@@ -333,7 +332,7 @@ submodule(stdlib_linalg) stdlib_linalg_norms
333332
lda = spe(dim)
334333

335334
! Check if input column data is contiguous
336-
contiguous_data = dim==1 .or. all(norm_request/=[NORM_ONE,NORM_TWO])
335+
contiguous_data = dim==1
337336

338337
! Get packed data with the norm dimension as the first dimension
339338
if (.not.contiguous_data) then
@@ -345,40 +344,16 @@ submodule(stdlib_linalg) stdlib_linalg_norms
345344
apack = reshape(a, shape=spack, order=iperm)
346345

347346
${loop_variables_start('j', 'apack', rank-1, 1," "*12)}$
348-
select case(norm_request)
349-
case(NORM_ONE)
350-
nrm(${loop_variables('j',rank-1,1)}$) = &
351-
asum(lda,apack(:, ${loop_variables('j',rank-1,1)}$),incx=1_ilp)
352-
case(NORM_TWO)
353-
nrm(${loop_variables('j',rank-1,1)}$) = &
354-
nrm2(lda,apack(:, ${loop_variables('j',rank-1,1)}$),incx=1_ilp)
355-
end select
347+
call internal_norm_1D_${ri}$(lda, apack(:, ${loop_variables('j',rank-1,1)}$), &
348+
nrm(${loop_variables('j',rank-1,1)}$), norm_request)
356349
${loop_variables_end(rank-1," "*12)}$
357350

358351
else
359352

360-
select case(norm_request)
361-
case(NORM_ONE)
362-
${loop_variables_start('j', 'a', rank-1, 1," "*20)}$
363-
nrm(${loop_variables('j',rank-1,1)}$) = &
364-
asum(lda,a(:, ${loop_variables('j',rank-1,1)}$),incx=1_ilp)
365-
${loop_variables_end(rank-1," "*20)}$
366-
case(NORM_TWO)
367-
${loop_variables_start('j', 'a', rank-1, 1," "*20)}$
368-
nrm(${loop_variables('j',rank-1,1)}$) = &
369-
nrm2(lda,a(:, ${loop_variables('j',rank-1,1)}$),incx=1_ilp)
370-
${loop_variables_end(rank-1," "*20)}$
371-
case(NORM_INF)
372-
nrm = maxval( abs(a) , dim = dim )
373-
case(NORM_MINUSINF)
374-
nrm = minval( abs(a) , dim = dim )
375-
case (NORM_POW_FIRST:NORM_POW_LAST)
376-
rorder = 1.0_${rk}$ / norm_request
377-
nrm = sum( abs(a) ** norm_request , dim = dim ) ** rorder
378-
case default
379-
err_ = linalg_state_type(this,LINALG_INTERNAL_ERROR,'invalid norm type after checking')
380-
call linalg_error_handling(err_,err)
381-
end select
353+
${loop_variables_start('j', 'a', rank-1, 1," "*12)}$
354+
call internal_norm_1D_${ri}$(lda, a(:, ${loop_variables('j',rank-1,1)}$), &
355+
nrm(${loop_variables('j',rank-1,1)}$), norm_request)
356+
${loop_variables_end(rank-1," "*12)}$
382357

383358
endif
384359

0 commit comments

Comments
 (0)