Skip to content

Commit 5ceef37

Browse files
jalveszjalvesz
authored
Merge branch 'fortran-lang:master' into sparse
2 parents 680d35d + 427bc68 commit 5ceef37

26 files changed

+94
-93
lines changed

‎config/fypp_deployment.py

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -122,11 +122,11 @@ def fpm_build(args,unknown):
122122
flags= flags + unknown[idx+1]
123123
#==========================================
124124
# build with fpm
125-
subprocess.run(["fpm build"]+
126-
[" --compiler "]+[FPM_FC]+
127-
[" --c-compiler "]+[FPM_CC]+
128-
[" --cxx-compiler "]+[FPM_CXX]+
129-
[" --flag "]+[flags], shell=True, check=True)
125+
subprocess.run("fpm build"+
126+
" --compiler "+FPM_FC+
127+
" --c-compiler "+FPM_CC+
128+
" --cxx-compiler "+FPM_CXX+
129+
" --flag \"{}\"".format(flags), shell=True, check=True)
130130
return
131131

132132
if __name__ == "__main__":
@@ -137,7 +137,7 @@ def fpm_build(args,unknown):
137137
parser.add_argument("--vpatch", type=int, default=0, help="Project Version Patch")
138138

139139
parser.add_argument("--njob", type=int, default=4, help="Number of parallel jobs for preprocessing")
140-
parser.add_argument("--maxrank",type=int, default=7, help="Set the maximum allowed rank for arrays")
140+
parser.add_argument("--maxrank",type=int, default=4, help="Set the maximum allowed rank for arrays")
141141
parser.add_argument("--with_qp",action='store_true', help="Include WITH_QP in the command")
142142
parser.add_argument("--with_xdp",action='store_true', help="Include WITH_XDP in the command")
143143
parser.add_argument("--lnumbering",action='store_true', help="Add line numbering in preprocessed files")

‎example/hashmaps/example_hashmaps_get_other_data.f90

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
program example_get_other_data
22
use stdlib_kinds, only: int8, int64
3-
use stdlib_hashmaps, only: chaining_hashmap_type, int_index
3+
use stdlib_hashmaps, only: chaining_hashmap_type
44
use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type, set, get
55
implicit none
66
logical :: conflict

‎example/hashmaps/example_hashmaps_remove.f90

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
program example_remove
22
use stdlib_kinds, only: int8, int64
3-
use stdlib_hashmaps, only: open_hashmap_type, int_index
3+
use stdlib_hashmaps, only: open_hashmap_type
44
use stdlib_hashmap_wrappers, only: fnv_1_hasher, &
55
fnv_1a_hasher, key_type, other_type, set
66
implicit none

‎example/hashmaps/example_hashmaps_set_other_data.f90

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
11
program example_set_other_data
2-
use stdlib_kinds, only: int8
32
use stdlib_hashmaps, only: open_hashmap_type
43
use stdlib_hashmap_wrappers, only: fnv_1_hasher, &
54
fnv_1a_hasher, key_type, other_type, set

‎example/linalg/example_determinant.f90

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,6 @@ program example_determinant
22
use stdlib_kinds, only: dp
33
use stdlib_linalg, only: det, linalg_state_type
44
implicit none
5-
type(linalg_state_type) :: err
65

76
real(dp) :: d
87

‎example/linalg/example_eigvals.f90

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,6 @@ program example_eigvals
33
use stdlib_linalg, only: eigvals
44
implicit none
55

6-
integer :: i
76
real, allocatable :: A(:,:),lambda(:)
87
complex, allocatable :: cA(:,:),clambda(:)
98

‎example/linalg/example_eigvalsh.f90

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,6 @@ program example_eigvalsh
33
use stdlib_linalg, only: eigvalsh
44
implicit none
55

6-
integer :: i
76
real, allocatable :: A(:,:),lambda(:)
87
complex, allocatable :: cA(:,:)
98

‎example/linalg/example_state2.f90

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,6 @@ program example_state2
77
use stdlib_linalg_state, only: linalg_state_type, LINALG_VALUE_ERROR, LINALG_SUCCESS, &
88
linalg_error_handling
99
implicit none
10-
integer :: info
1110
type(linalg_state_type) :: err
1211
real :: a_div_b
1312

‎example/selection/selection_vs_sort.f90

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
program selection_vs_sort
2-
use stdlib_kinds, only: dp, sp, int64
2+
use stdlib_kinds, only: int64
33
use stdlib_selection, only: select, arg_select
44
use stdlib_sorting, only: sort
55
implicit none

‎src/stdlib_io.fypp

Lines changed: 54 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,6 @@ module stdlib_io
99
use, intrinsic :: iso_fortran_env, only : input_unit
1010
use stdlib_kinds, only: sp, dp, xdp, qp, &
1111
int8, int16, int32, int64
12-
use stdlib_error, only: error_stop
1312
use stdlib_optval, only: optval
1413
use stdlib_ascii, only: is_blank
1514
use stdlib_string_type, only : string_type
@@ -120,7 +119,8 @@ contains
120119
!! ...
121120
!!
122121
integer :: s
123-
integer :: nrow, ncol, i, skiprows_, max_rows_
122+
integer :: nrow, ncol, i, ios, skiprows_, max_rows_
123+
character(len=128) :: iomsg, msgout
124124

125125
skiprows_ = max(optval(skiprows, 0), 0)
126126
max_rows_ = optval(max_rows, -1)
@@ -142,56 +142,51 @@ contains
142142
allocate(d(max_rows_, ncol))
143143

144144
do i = 1, skiprows_
145-
read(s, *)
145+
read(s, *, iostat=ios, iomsg=iomsg)
146+
147+
if (ios/=0) then
148+
write(msgout,1) trim(iomsg),i,trim(filename)
149+
error stop trim(msgout)
150+
end if
151+
146152
end do
147-
148-
#:if 'real' in t1
153+
149154
! Default to format used for savetxt if fmt not specified.
150-
fmt_ = optval(fmt, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",1x))")
151-
152-
if ( fmt_ == '*' ) then
153-
! Use list directed read if user has specified fmt='*'
154-
do i = 1, max_rows_
155-
read (s,*) d(i, :)
156-
enddo
157-
else
158-
! Otherwise pass default or user specified fmt string.
159-
do i = 1, max_rows_
160-
read (s,fmt_) d(i, :)
161-
enddo
162-
endif
155+
#:if 'real' in t1
156+
fmt_ = optval(fmt, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",:,1x))")
163157
#:elif 'complex' in t1
164-
! Default to format used for savetxt if fmt not specified.
165-
fmt_ = optval(fmt, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",1x))")
166-
if ( fmt_ == '*' ) then
167-
! Use list directed read if user has specified fmt='*'
168-
do i = 1, max_rows_
169-
read (s,*) d(i, :)
170-
enddo
171-
else
172-
! Otherwise pass default or user specified fmt string.
173-
do i = 1, max_rows_
174-
read (s,fmt_) d(i, :)
175-
enddo
176-
endif
158+
fmt_ = optval(fmt, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",:,1x))")
177159
#:else
178-
! Default to list directed for integer
179160
fmt_ = optval(fmt, "*")
180-
! Use list directed read if user has specified fmt='*'
161+
#:endif
162+
181163
if ( fmt_ == '*' ) then
164+
! Use list directed read if user has specified fmt='*'
182165
do i = 1, max_rows_
183-
read (s,*) d(i, :)
166+
read (s,*,iostat=ios,iomsg=iomsg) d(i, :)
167+
168+
if (ios/=0) then
169+
write(msgout,1) trim(iomsg),i,trim(filename)
170+
error stop trim(msgout)
171+
end if
172+
184173
enddo
185174
else
186-
! Otherwise pass default user specified fmt string.
175+
! Otherwise pass default or user specified fmt string.
187176
do i = 1, max_rows_
188-
read (s,fmt_) d(i, :)
177+
read (s,fmt_,iostat=ios,iomsg=iomsg) d(i, :)
178+
179+
if (ios/=0) then
180+
write(msgout,1) trim(iomsg),i,trim(filename)
181+
error stop trim(msgout)
182+
end if
183+
189184
enddo
190185
endif
191186

192-
#:endif
193-
194187
close(s)
188+
189+
1 format('loadtxt: error <',a,'> reading line ',i0,' of ',a,'.')
195190

196191
end subroutine loadtxt_${t1[0]}$${k1}$
197192
#:endfor
@@ -218,20 +213,31 @@ contains
218213
!!```
219214
!!
220215

221-
integer :: s, i
216+
integer :: s, i, ios
217+
character(len=128) :: iomsg, msgout
222218
s = open(filename, "w")
223219
do i = 1, size(d, 1)
224220
#:if 'real' in t1
225-
write(s, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",1x))") d(i, :)
221+
write(s, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",:,1x))", &
226222
#:elif 'complex' in t1
227-
write(s, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",1x))") d(i, :)
223+
write(s, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",:,1x))", &
228224
#:elif 'integer' in t1
229-
write(s, "(*"//FMT_INT(1:len(FMT_INT)-1)//",1x))") d(i, :)
225+
write(s, "(*"//FMT_INT(1:len(FMT_INT)-1)//",:,1x))", &
230226
#:else
231-
write(s, *) d(i, :)
227+
write(s, *, &
232228
#:endif
229+
iostat=ios,iomsg=iomsg) d(i, :)
230+
231+
if (ios/=0) then
232+
write(msgout,1) trim(iomsg),i,trim(filename)
233+
error stop trim(msgout)
234+
end if
235+
233236
end do
234237
close(s)
238+
239+
1 format('savetxt: error <',a,'> writing line ',i0,' of ',a,'.')
240+
235241
end subroutine savetxt_${t1[0]}$${k1}$
236242
#:endfor
237243

@@ -360,7 +366,7 @@ contains
360366
position_='asis'
361367
status_='new'
362368
case default
363-
call error_stop("Unsupported mode: "//mode_(1:2))
369+
error stop "Unsupported mode: "//mode_(1:2)
364370
end select
365371

366372
select case (mode_(3:3))
@@ -369,7 +375,7 @@ contains
369375
case('b')
370376
form_='unformatted'
371377
case default
372-
call error_stop("Unsupported mode: "//mode_(3:3))
378+
error stop "Unsupported mode: "//mode_(3:3)
373379
end select
374380

375381
access_ = 'stream'
@@ -415,9 +421,9 @@ contains
415421
else if (a(i:i) == ' ') then
416422
cycle
417423
else if(any(.not.lfirst)) then
418-
call error_stop("Wrong mode: "//trim(a))
424+
error stop "Wrong mode: "//trim(a)
419425
else
420-
call error_stop("Wrong character: "//a(i:i))
426+
error stop "Wrong character: "//a(i:i)
421427
endif
422428
end do
423429

@@ -466,7 +472,7 @@ contains
466472
if (present(iostat)) then
467473
iostat = stat
468474
else if (stat /= 0) then
469-
call error_stop(trim(msg))
475+
error stop trim(msg)
470476
end if
471477
end subroutine getline_char
472478

‎src/stdlib_linalg_blas_c.fypp

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2549,8 +2549,6 @@ module stdlib_linalg_blas_c
25492549
! -- reference blas level1 routine --
25502550
! -- reference blas is a software package provided by univ. of tennessee, --
25512551
! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
2552-
! Constants
2553-
integer, parameter :: wp = kind(1._sp)
25542552
! Scaling Constants
25552553
! Scalar Arguments
25562554
real(sp), intent(out) :: c

‎src/stdlib_linalg_blas_d.fypp

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -848,7 +848,6 @@ module stdlib_linalg_blas_d
848848
! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
849849
! march 2021
850850
! Constants
851-
integer, parameter :: wp = kind(1._dp)
852851
real(dp), parameter :: maxn = huge(0.0_dp)
853852
! .. blue's scaling constants ..
854853
! Scalar Arguments
@@ -985,8 +984,6 @@ module stdlib_linalg_blas_d
985984
! -- reference blas level1 routine --
986985
! -- reference blas is a software package provided by univ. of tennessee, --
987986
! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
988-
! Constants
989-
integer, parameter :: wp = kind(1._dp)
990987
! Scaling Constants
991988
! Scalar Arguments
992989
real(dp), intent(inout) :: a, b
@@ -4422,7 +4419,6 @@ module stdlib_linalg_blas_d
44224419
! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
44234420
! march 2021
44244421
! Constants
4425-
integer, parameter :: wp = kind(1._dp)
44264422
real(dp), parameter :: maxn = huge(0.0_dp)
44274423
! .. blue's scaling constants ..
44284424
! Scalar Arguments

‎src/stdlib_linalg_blas_q.fypp

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -852,7 +852,6 @@ module stdlib_linalg_blas_${ri}$
852852
! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
853853
! march 2021
854854
! Constants
855-
integer, parameter :: wp = kind(1._${rk}$)
856855
real(${rk}$), parameter :: maxn = huge(0.0_${rk}$)
857856
! .. blue's scaling constants ..
858857
! Scalar Arguments
@@ -989,8 +988,6 @@ module stdlib_linalg_blas_${ri}$
989988
! -- reference blas level1 routine --
990989
! -- reference blas is a software package provided by univ. of tennessee, --
991990
! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
992-
! Constants
993-
integer, parameter :: wp = kind(1._${rk}$)
994991
! Scaling Constants
995992
! Scalar Arguments
996993
real(${rk}$), intent(inout) :: a, b
@@ -4426,7 +4423,6 @@ module stdlib_linalg_blas_${ri}$
44264423
! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
44274424
! march 2021
44284425
! Constants
4429-
integer, parameter :: wp = kind(1._${rk}$)
44304426
real(${rk}$), parameter :: maxn = huge(0.0_${rk}$)
44314427
! .. blue's scaling constants ..
44324428
! Scalar Arguments

‎src/stdlib_linalg_blas_s.fypp

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -233,7 +233,6 @@ module stdlib_linalg_blas_s
233233
! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
234234
! march 2021
235235
! Constants
236-
integer, parameter :: wp = kind(1._sp)
237236
real(sp), parameter :: maxn = huge(0.0_sp)
238237
! .. blue's scaling constants ..
239238
! Scalar Arguments
@@ -1028,7 +1027,6 @@ module stdlib_linalg_blas_s
10281027
! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
10291028
! march 2021
10301029
! Constants
1031-
integer, parameter :: wp = kind(1._sp)
10321030
real(sp), parameter :: maxn = huge(0.0_sp)
10331031
! .. blue's scaling constants ..
10341032
! Scalar Arguments
@@ -1166,7 +1164,6 @@ module stdlib_linalg_blas_s
11661164
! -- reference blas is a software package provided by univ. of tennessee, --
11671165
! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
11681166
! Constants
1169-
integer, parameter :: wp = kind(1._sp)
11701167
! Scaling Constants
11711168
! Scalar Arguments
11721169
real(sp), intent(inout) :: a, b

‎src/stdlib_linalg_blas_w.fypp

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2635,8 +2635,6 @@ module stdlib_linalg_blas_${ci}$
26352635
! -- reference blas level1 routine --
26362636
! -- reference blas is a software package provided by univ. of tennessee, --
26372637
! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
2638-
! Constants
2639-
integer, parameter :: wp = kind(1._${ck}$)
26402638
! Scaling Constants
26412639
! Scalar Arguments
26422640
real(${ck}$), intent(out) :: c

‎src/stdlib_linalg_blas_z.fypp

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2627,8 +2627,6 @@ module stdlib_linalg_blas_z
26272627
! -- reference blas level1 routine --
26282628
! -- reference blas is a software package provided by univ. of tennessee, --
26292629
! -- univ. of california berkeley, univ. of colorado denver and nag ltd..--
2630-
! Constants
2631-
integer, parameter :: wp = kind(1._dp)
26322630
! Scaling Constants
26332631
! Scalar Arguments
26342632
real(dp), intent(out) :: c

‎src/stdlib_linalg_cholesky.fypp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -54,7 +54,7 @@ submodule (stdlib_linalg) stdlib_linalg_cholesky
5454

5555
!> Local variables
5656
type(linalg_state_type) :: err0
57-
integer(ilp) :: lda,n,info,i,j
57+
integer(ilp) :: lda,n,info,j
5858
logical(lk) :: lower_,other_zeroed_
5959
character :: triangle
6060
${rt}$, parameter :: zero = 0.0_${rk}$

0 commit comments

Comments
 (0)