Skip to content

Commit cf15eb1

Browse files
committed
clearer logical flags
1 parent 88a49bb commit cf15eb1

File tree

1 file changed

+27
-30
lines changed

1 file changed

+27
-30
lines changed

src/stdlib_linalg_svd.fypp

Lines changed: 27 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -144,7 +144,7 @@ submodule(stdlib_linalg) stdlib_linalg_svd
144144
type(linalg_state_type) :: err0
145145
integer(ilp) :: m,n,lda,ldu,ldvt,info,k,lwork,liwork,lrwork
146146
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
148148
character :: task
149149
${rt}$, target :: work_dummy(1),u_dummy(1,1),vt_dummy(1,1)
150150
${rt}$, allocatable :: work(:)
@@ -173,21 +173,18 @@ submodule(stdlib_linalg) stdlib_linalg_svd
173173
allocate(iwork(liwork))
174174

175175
! 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
181178

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
186181
amat => a
182+
else
183+
allocate(amat(m,n),source=a)
187184
endif
188185

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)
191188

192189
! Full-size matrices
193190
if (present(full_matrices)) then
@@ -202,38 +199,38 @@ submodule(stdlib_linalg) stdlib_linalg_svd
202199
! U, VT storage
203200
if (present(u)) then
204201
! 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
208205
! 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.
211208
elseif (.not.full_storage) then
212209
! Allocate with minimum size
213210
allocate(umat(m,k))
214-
alloc_u = .true.
211+
temp_u = .true.
215212
else
216213
! Allocate with regular size
217214
allocate(umat(m,m))
218-
alloc_u = .true.
215+
temp_u = .true.
219216
end if
220217

221218
if (present(vt)) then
222219
! 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
226223
! 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.
229226
elseif (.not.full_storage) then
230227
! Allocate with minimum size
231228
allocate(vtmat(k,n))
232-
alloc_vt = .true.
229+
temp_vt = .true.
233230
else
234231
! Allocate with regular size
235232
allocate(vtmat(n,n))
236-
alloc_vt = .true.
233+
temp_vt = .true.
237234
end if
238235

239236
ldu = size(umat ,1,kind=ilp)
@@ -242,7 +239,7 @@ submodule(stdlib_linalg) stdlib_linalg_svd
242239
! Decide SVD task
243240
if (.not.compute_uv) then
244241
task = GESDD_SINGVAL_ONLY
245-
elseif (can_overwrite_a) then
242+
elseif (can_overwrite_amat) then
246243
! A is a copy: we can overwrite its storage
247244
task = GESDD_OVERWRITE_A
248245
elseif (.not.full_storage) then
@@ -284,9 +281,9 @@ submodule(stdlib_linalg) stdlib_linalg_svd
284281
endif
285282

286283
! 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)
290287
call linalg_error_handling(err0,err)
291288

292289
end subroutine stdlib_linalg_svd_${ri}$

0 commit comments

Comments
 (0)