Merge branch 'fortran-lang:master' into sparse

Author: jalvesz

config/fypp_deployment.py

@@ -122,11 +122,11 @@ def fpm_build(args,unknown):
             flags= flags + unknown[idx+1]
     #==========================================
     # build with fpm
-    subprocess.run(["fpm build"]+
-                   [" --compiler "]+[FPM_FC]+
-                   [" --c-compiler "]+[FPM_CC]+
-                   [" --cxx-compiler "]+[FPM_CXX]+
-                   [" --flag "]+[flags], shell=True, check=True)
+    subprocess.run("fpm build"+
+                   " --compiler "+FPM_FC+
+                   " --c-compiler "+FPM_CC+
+                   " --cxx-compiler "+FPM_CXX+
+                   " --flag \"{}\"".format(flags), shell=True, check=True)
     return
 
 if __name__ == "__main__":
@@ -137,7 +137,7 @@ def fpm_build(args,unknown):
     parser.add_argument("--vpatch", type=int, default=0, help="Project Version Patch")
 
     parser.add_argument("--njob", type=int, default=4, help="Number of parallel jobs for preprocessing")
-    parser.add_argument("--maxrank",type=int, default=7, help="Set the maximum allowed rank for arrays")
+    parser.add_argument("--maxrank",type=int, default=4, help="Set the maximum allowed rank for arrays")
     parser.add_argument("--with_qp",action='store_true', help="Include WITH_QP in the command")
     parser.add_argument("--with_xdp",action='store_true', help="Include WITH_XDP in the command")
     parser.add_argument("--lnumbering",action='store_true', help="Add line numbering in preprocessed files")

example/hashmaps/example_hashmaps_get_other_data.f90

@@ -1,6 +1,6 @@
 program example_get_other_data
   use stdlib_kinds, only: int8, int64
-  use stdlib_hashmaps, only: chaining_hashmap_type, int_index
+  use stdlib_hashmaps, only: chaining_hashmap_type
   use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type, set, get
   implicit none
   logical                     :: conflict

example/hashmaps/example_hashmaps_remove.f90

@@ -1,6 +1,6 @@
 program example_remove
   use stdlib_kinds, only: int8, int64
-  use stdlib_hashmaps, only: open_hashmap_type, int_index
+  use stdlib_hashmaps, only: open_hashmap_type
   use stdlib_hashmap_wrappers, only: fnv_1_hasher, &
                                      fnv_1a_hasher, key_type, other_type, set
   implicit none

example/hashmaps/example_hashmaps_set_other_data.f90

@@ -1,5 +1,4 @@
 program example_set_other_data
-  use stdlib_kinds, only: int8
   use stdlib_hashmaps, only: open_hashmap_type
   use stdlib_hashmap_wrappers, only: fnv_1_hasher, &
                                      fnv_1a_hasher, key_type, other_type, set

example/linalg/example_determinant.f90

@@ -2,7 +2,6 @@ program example_determinant
   use stdlib_kinds, only: dp
   use stdlib_linalg, only: det, linalg_state_type
   implicit none
-  type(linalg_state_type) :: err
 
   real(dp) :: d
 

example/linalg/example_eigvals.f90

@@ -3,7 +3,6 @@ program example_eigvals
   use stdlib_linalg, only: eigvals
   implicit none
 
-  integer :: i
   real, allocatable :: A(:,:),lambda(:)
   complex, allocatable :: cA(:,:),clambda(:)
 

example/linalg/example_eigvalsh.f90

@@ -3,7 +3,6 @@ program example_eigvalsh
   use stdlib_linalg, only: eigvalsh
   implicit none
 
-  integer :: i
   real, allocatable :: A(:,:),lambda(:)
   complex, allocatable :: cA(:,:)
 

example/linalg/example_state2.f90

@@ -7,7 +7,6 @@ program example_state2
   use stdlib_linalg_state, only: linalg_state_type, LINALG_VALUE_ERROR, LINALG_SUCCESS, &
           linalg_error_handling
   implicit none
-  integer :: info
   type(linalg_state_type) :: err
   real :: a_div_b
 

example/selection/selection_vs_sort.f90

@@ -1,5 +1,5 @@
 program selection_vs_sort
-  use stdlib_kinds, only: dp, sp, int64
+  use stdlib_kinds, only: int64
   use stdlib_selection, only: select, arg_select
   use stdlib_sorting, only: sort
   implicit none

src/stdlib_io.fypp

@@ -9,7 +9,6 @@ module stdlib_io
   use, intrinsic :: iso_fortran_env, only : input_unit
   use stdlib_kinds, only: sp, dp, xdp, qp, &
       int8, int16, int32, int64
-  use stdlib_error, only: error_stop
   use stdlib_optval, only: optval
   use stdlib_ascii, only: is_blank
   use stdlib_string_type, only : string_type
@@ -120,7 +119,8 @@ contains
       !!     ...
       !!
       integer :: s
-      integer :: nrow, ncol, i, skiprows_, max_rows_
+      integer :: nrow, ncol, i, ios, skiprows_, max_rows_
+      character(len=128) :: iomsg, msgout
 
       skiprows_ = max(optval(skiprows, 0), 0)
       max_rows_ = optval(max_rows, -1)
@@ -142,56 +142,51 @@ contains
       allocate(d(max_rows_, ncol))
 
       do i = 1, skiprows_
-        read(s, *)
+        read(s, *, iostat=ios, iomsg=iomsg)
+        
+        if (ios/=0) then 
+           write(msgout,1) trim(iomsg),i,trim(filename) 
+           error stop trim(msgout)
+        end if
+        
       end do
-
-      #:if 'real' in t1
+      
       ! Default to format used for savetxt if fmt not specified.
-      fmt_ = optval(fmt, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",1x))")
-
-      if ( fmt_ == '*' ) then
-        ! Use list directed read if user has specified fmt='*'
-        do i = 1, max_rows_
-          read (s,*) d(i, :)
-        enddo
-      else
-        ! Otherwise pass default or user specified fmt string.  
-        do i = 1, max_rows_
-          read (s,fmt_) d(i, :)
-        enddo
-      endif
+      #:if 'real' in t1
+      fmt_ = optval(fmt, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",:,1x))")
       #:elif 'complex' in t1
-      ! Default to format used for savetxt if fmt not specified.
-      fmt_ = optval(fmt, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",1x))")
-      if ( fmt_ == '*' ) then
-        ! Use list directed read if user has specified fmt='*'
-        do i = 1, max_rows_
-          read (s,*) d(i, :)
-        enddo
-      else
-        ! Otherwise pass default or user specified fmt string.
-        do i = 1, max_rows_
-          read (s,fmt_) d(i, :)
-        enddo
-      endif
+      fmt_ = optval(fmt, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",:,1x))")
       #:else
-      ! Default to list directed for integer
       fmt_ = optval(fmt, "*")
-      ! Use list directed read if user has specified fmt='*'
+      #:endif      
+
       if ( fmt_ == '*' ) then
+        ! Use list directed read if user has specified fmt='*'
         do i = 1, max_rows_
-          read (s,*) d(i, :)
+          read (s,*,iostat=ios,iomsg=iomsg) d(i, :)
+          
+          if (ios/=0) then 
+             write(msgout,1) trim(iomsg),i,trim(filename) 
+             error stop trim(msgout)
+          end if          
+          
         enddo
       else
-        ! Otherwise pass default user specified fmt string.
+        ! Otherwise pass default or user specified fmt string.
         do i = 1, max_rows_
-          read (s,fmt_) d(i, :)
+          read (s,fmt_,iostat=ios,iomsg=iomsg) d(i, :)
+          
+          if (ios/=0) then 
+             write(msgout,1) trim(iomsg),i,trim(filename) 
+             error stop trim(msgout)
+          end if             
+          
         enddo
       endif
 
-      #:endif
-
       close(s)
+      
+      1 format('loadtxt: error <',a,'> reading line ',i0,' of ',a,'.')
 
     end subroutine loadtxt_${t1[0]}$${k1}$
   #:endfor
@@ -218,20 +213,31 @@ contains
       !!```
       !!
 
-      integer :: s, i
+      integer :: s, i, ios
+      character(len=128) :: iomsg, msgout
       s = open(filename, "w")
       do i = 1, size(d, 1)
         #:if 'real' in t1
-          write(s, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",1x))") d(i, :)
+          write(s, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",:,1x))", &
         #:elif 'complex' in t1
-          write(s, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",1x))") d(i, :)
+          write(s, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",:,1x))", &
         #:elif 'integer' in t1
-          write(s, "(*"//FMT_INT(1:len(FMT_INT)-1)//",1x))") d(i, :)
+          write(s, "(*"//FMT_INT(1:len(FMT_INT)-1)//",:,1x))", &
         #:else
-          write(s, *) d(i, :)
+          write(s, *, &
         #:endif
+                iostat=ios,iomsg=iomsg) d(i, :)
+        
+        if (ios/=0) then 
+           write(msgout,1) trim(iomsg),i,trim(filename) 
+           error stop trim(msgout)
+        end if           
+        
       end do
       close(s)
+      
+      1 format('savetxt: error <',a,'> writing line ',i0,' of ',a,'.')
+      
     end subroutine savetxt_${t1[0]}$${k1}$
   #:endfor
 
@@ -360,7 +366,7 @@ contains
       position_='asis'
       status_='new'
     case default
-      call error_stop("Unsupported mode: "//mode_(1:2))
+      error stop "Unsupported mode: "//mode_(1:2)
     end select
 
     select case (mode_(3:3))
@@ -369,7 +375,7 @@ contains
     case('b')
       form_='unformatted'
     case default
-      call error_stop("Unsupported mode: "//mode_(3:3))
+      error stop "Unsupported mode: "//mode_(3:3)   
     end select
 
     access_ = 'stream'
@@ -415,9 +421,9 @@ contains
       else if (a(i:i) == ' ') then
         cycle
       else if(any(.not.lfirst)) then
-        call error_stop("Wrong mode: "//trim(a))
+        error stop "Wrong mode: "//trim(a)
       else
-        call error_stop("Wrong character: "//a(i:i))
+        error stop "Wrong character: "//a(i:i)
       endif
     end do
 
@@ -466,7 +472,7 @@ contains
     if (present(iostat)) then
       iostat = stat
     else if (stat /= 0) then
-      call error_stop(trim(msg))
+      error stop trim(msg)  
     end if
   end subroutine getline_char