1module m_converters 2 3use m_debug 4 5private 6! 7! Takes a string and turns it into useful data structures, 8! such as numerical arrays. 9! 10! NOTE: The string must contain *homogeneous* data, i.e.: all real numbers, 11! all integers, etc. 12! 13public :: build_data_array 14 15interface build_data_array 16 module procedure build_data_array_real_sp, & 17 build_data_array_real_dp, & 18 build_data_array_integer 19end interface 20private :: build_data_array_real_sp 21private :: build_data_array_real_dp 22private :: build_data_array_integer 23 24private :: token_analysis, is_separator, is_CR_or_LF 25 26CONTAINS 27 28!--------------------------------------------------------------- 29subroutine build_data_array_real_dp(str,x,n) 30integer, parameter :: dp = selected_real_kind(14) 31! 32character(len=*), intent(in) :: str 33real(kind=dp), dimension(:), intent(inout) :: x 34integer, intent(inout) :: n 35 36integer :: ntokens, status, last_pos 37character(len=len(str)) :: s 38 39s = str 40call token_analysis(s,ntokens,last_pos) 41if (debug) print *, "ntokens, last_pos ", ntokens, last_pos 42if (debug) print *, s 43if ((n + ntokens) > size(x)) STOP "data array full" 44read(unit=s(1:last_pos),fmt=*,iostat=status) x(n+1:n+ntokens) 45if (status /= 0) STOP "real conversion error" 46n = n + ntokens 47 48end subroutine build_data_array_real_dp 49!--------------------------------------------------------------- 50 51subroutine build_data_array_real_sp(str,x,n) 52integer, parameter :: sp = selected_real_kind(6) 53! 54character(len=*), intent(in) :: str 55real(kind=sp), dimension(:), intent(inout) :: x 56integer, intent(inout) :: n 57 58integer :: ntokens, status, last_pos 59character(len=len(str)) :: s 60 61s = str 62call token_analysis(s,ntokens,last_pos) 63if (debug) print *, "ntokens, last_pos ", ntokens, last_pos 64if (debug) print *, s 65if ((n + ntokens) > size(x)) STOP "data array full" 66read(unit=s(1:last_pos),fmt=*,iostat=status) x(n+1:n+ntokens) 67if (status /= 0) STOP "real conversion error" 68n = n + ntokens 69 70end subroutine build_data_array_real_sp 71 72!--------------------------------------------------------------- 73subroutine build_data_array_integer(str,x,n) 74integer, parameter :: sp = selected_real_kind(14) 75! 76character(len=*), intent(in) :: str 77integer, dimension(:), intent(inout) :: x 78integer, intent(inout) :: n 79 80integer :: ntokens, status, last_pos 81character(len=len(str)) :: s 82 83s = str 84call token_analysis(s,ntokens,last_pos) 85if (debug) print *, "ntokens, last_pos ", ntokens, last_pos 86if (debug) print *, s 87if ((n + ntokens) > size(x)) STOP "data array full" 88read(unit=s(1:last_pos),fmt=*,iostat=status) x(n+1:n+ntokens) 89if (status /= 0) STOP "integer conversion error" 90n = n + ntokens 91 92end subroutine build_data_array_integer 93 94 95!================================================================== 96 97function is_separator(c) result(sep) 98character(len=1), intent(in) :: c 99logical :: sep 100 101 sep = ((c == char(32)) .or. (c == char(10)) & 102 .or. (c == char(9)) .or. (c == char(13))) 103 104end function is_separator 105!---------------------------------------------------------------- 106function is_CR_or_LF(c) result(res) 107character(len=1), intent(in) :: c 108logical :: res 109 110 res = ((c == char(10)) .or. (c == char(13))) 111 112end function is_CR_or_LF 113 114!================================================================== 115 116subroutine token_analysis(str,ntokens,last_pos) 117! 118character(len=*), intent(inout) :: str 119integer, intent(out) :: ntokens, last_pos 120! 121! 122! Checks the contents of a string and finds the number of tokens it contains 123! The standard separator is generalized whitespace (space, tab, CR, or LF) 124! It also returns the last useful position in the string (excluding 125! separator characters which are not blanks, and thus not caught by the 126! (len_)trim fortran intrinsic). This is necessary to perform list-directed 127! I/O in the string as an internal file. 128! 129! Also, replace on the fly CR and LF by blanks. This is necessary if 130! str spans more than one record. In that case, internal reads only 131! look at the first record. 132! -- ** Compiler limits on size of internal record?? 133! 134integer :: i, str_length 135logical :: in_token 136character(len=1) :: c 137 138in_token = .false. 139ntokens = 0 140last_pos = 0 141 142str_length = len_trim(str) 143!print *, "string length: ", str_length 144 145do i = 1, str_length 146 c = str(i:i) 147 148 if (in_token) then 149 if (is_separator(c)) then 150 in_token = .false. 151 if (is_CR_or_LF(c)) str(i:i) = " " 152 else 153 last_pos = i 154 endif 155 156 else ! not in token 157 158 if (is_separator(c)) then 159 if (is_CR_or_LF(c)) str(i:i) = " " 160 ! do nothing 161 else 162 in_token = .true. 163 last_pos = i 164 ntokens = ntokens + 1 165 endif 166 endif 167enddo 168!print *, "ntokens, last_pos: ", ntokens, last_pos 169 170end subroutine token_analysis 171 172 173end module m_converters 174 175 176 177 178 179 180 181