@@ -119,8 +119,9 @@ submodule(stdlib_linalg) stdlib_linalg_norms
119
119
120
120
end function stride_1d_${ri}$
121
121
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)
124
125
!> Input matrix length
125
126
integer(ilp), intent(in) :: sze
126
127
!> Input contiguous 1-d matrix a(*)
@@ -129,8 +130,6 @@ submodule(stdlib_linalg) stdlib_linalg_norms
129
130
real(${rk}$), intent(out) :: nrm
130
131
!> Internal matrix request
131
132
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
134
133
135
134
integer(ilp) :: i
136
135
real(${rk}$) :: rorder
@@ -233,7 +232,7 @@ submodule(stdlib_linalg) stdlib_linalg_norms
233
232
endif
234
233
235
234
! 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)
237
236
call linalg_error_handling(err_,err)
238
237
239
238
end subroutine norm_${rank}$D_${ii}$_${ri}$
@@ -333,7 +332,7 @@ submodule(stdlib_linalg) stdlib_linalg_norms
333
332
lda = spe(dim)
334
333
335
334
! 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
337
336
338
337
! Get packed data with the norm dimension as the first dimension
339
338
if (.not.contiguous_data) then
@@ -345,40 +344,16 @@ submodule(stdlib_linalg) stdlib_linalg_norms
345
344
apack = reshape(a, shape=spack, order=iperm)
346
345
347
346
${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)
356
349
${loop_variables_end(rank-1," "*12)}$
357
350
358
351
else
359
352
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)}$
382
357
383
358
endif
384
359
0 commit comments