@@ -144,7 +144,7 @@ submodule(stdlib_linalg) stdlib_linalg_svd
144
144
type(linalg_state_type) :: err0
145
145
integer(ilp) :: m,n,lda,ldu,ldvt,info,k,lwork,liwork,lrwork
146
146
integer(ilp), allocatable :: iwork(:)
147
- logical(lk) :: copy_a ,full_storage,compute_uv,alloc_u,alloc_vt,can_overwrite_a
147
+ logical(lk) :: overwrite_a_ ,full_storage,compute_uv,temp_u,temp_vt,can_overwrite_amat
148
148
character :: task
149
149
${rt}$, target :: work_dummy(1),u_dummy(1,1),vt_dummy(1,1)
150
150
${rt}$, allocatable :: work(:)
@@ -173,21 +173,18 @@ submodule(stdlib_linalg) stdlib_linalg_svd
173
173
allocate(iwork(liwork))
174
174
175
175
! Can A be overwritten? By default, do not overwrite
176
- if (present(overwrite_a)) then
177
- copy_a = .not.overwrite_a
178
- else
179
- copy_a = .true._lk
180
- endif
176
+ overwrite_a_ = .false.
177
+ if (present(overwrite_a)) overwrite_a_ = overwrite_a
181
178
182
- ! Initialize a matrix temporary
183
- if (copy_a) then
184
- allocate(amat(m,n),source=a)
185
- else
179
+ ! Initialize a matrix temporary?
180
+ if (overwrite_a_) then
186
181
amat => a
182
+ else
183
+ allocate(amat(m,n),source=a)
187
184
endif
188
185
189
- ! Check if we can overwrite A with data that will be lost
190
- can_overwrite_a = copy_a .and. merge(.not.present(u),.not.present(vt),m>=n)
186
+ ! Check if we can overwrite amat with data that will be lost
187
+ can_overwrite_amat = (.not.overwrite_a_) .and. merge(.not.present(u),.not.present(vt),m>=n)
191
188
192
189
! Full-size matrices
193
190
if (present(full_matrices)) then
@@ -202,38 +199,38 @@ submodule(stdlib_linalg) stdlib_linalg_svd
202
199
! U, VT storage
203
200
if (present(u)) then
204
201
! User input
205
- umat => u
206
- alloc_u = .false.
207
- elseif ((copy_a .and. m>=n ) .or. .not.compute_uv) then
202
+ umat => u
203
+ temp_u = .false.
204
+ elseif ((m>=n .and. .not.overwrite_a_ ) .or. .not.compute_uv) then
208
205
! U not wanted, and A can be overwritten: do not allocate
209
- umat => u_dummy
210
- alloc_u = .false.
206
+ umat => u_dummy
207
+ temp_u = .false.
211
208
elseif (.not.full_storage) then
212
209
! Allocate with minimum size
213
210
allocate(umat(m,k))
214
- alloc_u = .true.
211
+ temp_u = .true.
215
212
else
216
213
! Allocate with regular size
217
214
allocate(umat(m,m))
218
- alloc_u = .true.
215
+ temp_u = .true.
219
216
end if
220
217
221
218
if (present(vt)) then
222
219
! User input
223
- vtmat => vt
224
- alloc_vt = .false.
225
- elseif ((copy_a .and. m<n ) .or. .not.compute_uv) then
220
+ vtmat => vt
221
+ temp_vt = .false.
222
+ elseif ((m<n .and. .not.overwrite_a_ ) .or. .not.compute_uv) then
226
223
! amat can be overwritten, VT not wanted: VT is returned upon A
227
- vtmat => vt_dummy
228
- alloc_vt = .false.
224
+ vtmat => vt_dummy
225
+ temp_vt = .false.
229
226
elseif (.not.full_storage) then
230
227
! Allocate with minimum size
231
228
allocate(vtmat(k,n))
232
- alloc_vt = .true.
229
+ temp_vt = .true.
233
230
else
234
231
! Allocate with regular size
235
232
allocate(vtmat(n,n))
236
- alloc_vt = .true.
233
+ temp_vt = .true.
237
234
end if
238
235
239
236
ldu = size(umat ,1,kind=ilp)
@@ -242,7 +239,7 @@ submodule(stdlib_linalg) stdlib_linalg_svd
242
239
! Decide SVD task
243
240
if (.not.compute_uv) then
244
241
task = GESDD_SINGVAL_ONLY
245
- elseif (can_overwrite_a ) then
242
+ elseif (can_overwrite_amat ) then
246
243
! A is a copy: we can overwrite its storage
247
244
task = GESDD_OVERWRITE_A
248
245
elseif (.not.full_storage) then
@@ -284,9 +281,9 @@ submodule(stdlib_linalg) stdlib_linalg_svd
284
281
endif
285
282
286
283
! Finalize storage and process output flag
287
- if (copy_a) deallocate(amat)
288
- if (alloc_u) deallocate(umat)
289
- if (alloc_vt) deallocate(vtmat)
284
+ if (.not.overwrite_a_) deallocate(amat)
285
+ if (temp_u) deallocate(umat)
286
+ if (temp_vt) deallocate(vtmat)
290
287
call linalg_error_handling(err0,err)
291
288
292
289
end subroutine stdlib_linalg_svd_${ri}$
0 commit comments