Merge pull request #80 from scivision/io_select

use "select case" for clarity/brevity

Author: certik

src/stdlib_experimental_io.f90

@@ -265,7 +265,7 @@ integer function number_of_rows_numeric(s)
 
 end function
 
-logical function whitechar(char) ! white character
+pure logical function whitechar(char) ! white character
 ! returns .true. if char is space (32) or tab (9), .false. otherwise
 character, intent(in) :: char
 if (iachar(char) == 32 .or. iachar(char) == 9) then
@@ -300,51 +300,53 @@ integer function open(filename, mode) result(u)
 
 mode_ = parse_mode(optval(mode, ""))
 
-if (mode_(1:2) == 'r ') then
+select case (mode_(1:2))
+case('r')
  action_='read'
  position_='asis'
  status_='old'
-else if (mode_(1:2) == 'w ') then
+case('w')
  action_='write'
  position_='asis'
  status_='replace'
-else if (mode_(1:2) == 'a ') then
+case('a')
  action_='write'
  position_='append'
  status_='old'
-else if (mode_(1:2) == 'x ') then
+case('x')
  action_='write'
  position_='asis'
  status_='new'
-else if (mode_(1:2) == 'r+') then
+case('r+')
  action_='readwrite'
  position_='asis'
  status_='old'
-else if (mode_(1:2) == 'w+') then
+case('w+')
  action_='readwrite'
  position_='asis'
  status_='replace'
-else if (mode_(1:2) == 'a+') then
+case('a+')
  action_='readwrite'
  position_='append'
  status_='old'
-else if (mode_(1:2) == 'x+') then
+case('x+')
  action_='readwrite'
  position_='asis'
  status_='new'
-else
+case default
  call error_stop("Unsupported mode: "//mode_(1:2))
-end if
+end select
 
-if (mode_(3:3) == 't') then
+select case (mode_(3:3))
+case('t')
  access_='sequential'
  form_='formatted'
-else if (mode_(3:3) == 'b' .or. mode_(3:3) == 's') then
+case('b', 's')
  access_='stream'
  form_='unformatted'
-else
+case default
  call error_stop("Unsupported mode: "//mode_(3:3))
-endif
+end select
 
 open(newunit=u, file=filename, &
  action = action_, position = position_, status = status_, &
@@ -365,21 +367,18 @@ integer function open(filename, mode) result(u)
 a=trim(adjustl(mode))
 
 do i=1,len(a)
- if (a(i:i) == 'r' &
- .or. a(i:i) == 'w' &
- .or. a(i:i) == 'a' &
- .or. a(i:i) == 'x' &
- ) then
+ select case (a(i:i))
+ case('r', 'w', 'a', 'x')
  mode_(1:1) = a(i:i)
- else if (a(i:i) == '+') then
+ case('+')
  mode_(2:2) = a(i:i)
- else if (a(i:i) == 't' .or. a(i:i) == 'b') then
+ case('t', 'b')
  mode_(3:3) = a(i:i)
- else if (a(i:i) == ' ') then
- cycle
- else
+ case(' ')
+  cycle
+ case default
  call error_stop("Wrong character: "//a(i:i))
- endif
+ end select
 end do
 
 end function

src/stdlib_experimental_optval.f90

@@ -34,7 +34,7 @@ module stdlib_experimental_optval
 contains
 
 
- function optval_sp(x, default) result(y)
+ pure function optval_sp(x, default) result(y)
  real(sp), intent(in), optional :: x
  real(sp), intent(in) :: default
  real(sp) :: y
@@ -47,7 +47,7 @@ function optval_sp(x, default) result(y)
  end function optval_sp
 
 
- function optval_dp(x, default) result(y)
+ pure function optval_dp(x, default) result(y)
  real(dp), intent(in), optional :: x
  real(dp), intent(in) :: default
  real(dp) :: y
@@ -60,7 +60,7 @@ function optval_dp(x, default) result(y)
  end function optval_dp
 
 
- function optval_qp(x, default) result(y)
+ pure function optval_qp(x, default) result(y)
  real(qp), intent(in), optional :: x
  real(qp), intent(in) :: default
  real(qp) :: y
@@ -73,7 +73,7 @@ function optval_qp(x, default) result(y)
  end function optval_qp
 
 
- function optval_int8(x, default) result(y)
+ pure function optval_int8(x, default) result(y)
  integer(int8), intent(in), optional :: x
  integer(int8), intent(in) :: default
  integer(int8) :: y
@@ -86,7 +86,7 @@ function optval_int8(x, default) result(y)
  end function optval_int8
 
 
- function optval_int16(x, default) result(y)
+ pure function optval_int16(x, default) result(y)
  integer(int16), intent(in), optional :: x
  integer(int16), intent(in) :: default
  integer(int16) :: y
@@ -99,7 +99,7 @@ function optval_int16(x, default) result(y)
  end function optval_int16
 
 
- function optval_int32(x, default) result(y)
+ pure function optval_int32(x, default) result(y)
  integer(int32), intent(in), optional :: x
  integer(int32), intent(in) :: default
  integer(int32) :: y
@@ -112,7 +112,7 @@ function optval_int32(x, default) result(y)
  end function optval_int32
 
 
- function optval_int64(x, default) result(y)
+ pure function optval_int64(x, default) result(y)
  integer(int64), intent(in), optional :: x
  integer(int64), intent(in) :: default
  integer(int64) :: y
@@ -125,7 +125,7 @@ function optval_int64(x, default) result(y)
  end function optval_int64
 
 
- function optval_logical(x, default) result(y)
+ pure function optval_logical(x, default) result(y)
  logical, intent(in), optional :: x
  logical, intent(in) :: default
  logical :: y
@@ -138,7 +138,7 @@ function optval_logical(x, default) result(y)
  end function optval_logical
 
 
- function optval_character(x, default) result(y)
+ pure function optval_character(x, default) result(y)
  character(len=*), intent(in), optional :: x
  character(len=*), intent(in) :: default
  character(len=:), allocatable :: y