@@ -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