78 character (len=*),
intent(in) :: sFilename
79 character (len=*),
intent(in),
optional :: sDelimiters
80 character (len=*),
intent(in),
optional :: sCommentChars
83 character (len=:),
allocatable :: sDelimiters_
84 character (len=:),
allocatable :: sCommentChars_
86 if (
present(scommentchars) )
then
87 scommentchars_ = scommentchars
92 if (
present(sdelimiters) )
then
93 sdelimiters_ = sdelimiters
98 this%count = this%count + 1
100 call this%filenames%append( sfilename )
101 call this%delimiters%append( sdelimiters_ )
102 call this%comment_chars%append( scommentchars_ )
111 character (len=*),
intent(in),
optional :: comment_chars
112 character (len=*),
intent(in),
optional :: delimiters
115 integer (c_int) :: iFileIndex, iColIndex
116 integer (c_int) :: iStat
117 type (ASCII_FILE_T),
allocatable :: DF
118 type (DICT_ENTRY_T),
pointer :: pDict
119 type (DICT_ENTRY_T),
pointer :: pCurrentDict
120 character (len=256) :: column_name
121 character (len=256) :: filename1
122 character (len=:),
allocatable :: comment_chars_
123 character (len=:),
allocatable :: delimiters_
124 logical (c_bool),
allocatable :: skip_this_column(:)
125 type (FSTRING_LIST_T) :: unique_file_list
126 integer (kind=c_int) :: row_indx
127 integer (c_int) :: number_of_columns
128 character (len=MAX_TABLE_RECORD_LEN) :: sRecord, sItem
131 type (FSTRING_LIST_T),
allocatable :: duplicate_column_data(:)
132 type (FSTRING_LIST_T) :: existing_values
133 character (len=:),
allocatable :: existing_val, duplicate_val
134 integer (c_int) :: iVerify
138 if (
present(comment_chars) )
then
139 comment_chars_ = trim(comment_chars)
144 if (
present(delimiters) )
then
145 delimiters_ = trim(delimiters)
156 if ( this%filenames%get(1) .ne.
'<NA>' )
then
158 do ifileindex = 1, this%filenames%count
160 filename1 = this%filenames%get(ifileindex)
163 if ( unique_file_list%count_matching(filename1) > 0 ) cycle
165 call unique_file_list%append(filename1)
168 call df%open(sfilename = filename1, &
169 scommentchars = comment_chars_, &
170 sdelimiters = delimiters_ )
173 df%slColNames = df%readHeader()
175 number_of_columns = df%slColNames%count
177 call logs%write(
"Number of columns in file: "//
ascharacter( number_of_columns ), itab=35)
181 if (
allocated(skip_this_column))
deallocate(skip_this_column)
182 allocate(skip_this_column(number_of_columns))
183 skip_this_column =
false
185 if (
allocated(duplicate_column_data))
deallocate(duplicate_column_data)
186 allocate(duplicate_column_data(number_of_columns))
189 do icolindex = 1, df%slColNames%count
191 column_name = df%slColNames%get(icolindex)
193 if (
params_dict%key_already_in_use( column_name ) )
then
195 skip_this_column( icolindex ) =
true
197 call logs%write(
"Column name "//
squote(column_name)//
" already in use." &
198 //
" Values will be verified for consistency." &
199 //
" [filename = "//
squote(filename1)//
"]")
215 allocate( pdict, stat=istat )
216 call assert(istat == 0,
"Failed to allocate memory for dictionary object", &
221 call pdict%add_key( column_name )
231 do while ( .not. df%isEOF() )
234 srecord = df%readLine()
237 if ( len_trim(srecord) == 0 ) cycle
239 row_indx = row_indx + 1
242 do icolindex = 1, df%slColNames%count
245 call chomp(srecord, sitem, this%delimiters%get(ifileindex) )
247 if ( skip_this_column(icolindex) )
then
249 call duplicate_column_data(icolindex)%append(trim(adjustl(sitem)))
253 column_name = df%slColNames%get(icolindex)
257 pcurrentdict =>
params_dict%get_entry( column_name )
259 if (
associated( pcurrentdict ))
then
263 call pcurrentdict%add_value( sitem )
267 call warn(
"Internal programming error: null pointer detected" &
268 //
" -- was trying to find pointer associated with column "//
dquote(df%slColNames%get(icolindex)), &
278 do icolindex = 1, number_of_columns
279 if (.not. skip_this_column(icolindex)) cycle
280 if (duplicate_column_data(icolindex)%count == 0) cycle
282 column_name = df%slColNames%get(icolindex)
285 call params_dict%get_values(skey=column_name, slstring=existing_values)
288 if (existing_values%count /= duplicate_column_data(icolindex)%count)
then
289 call warn(
"Duplicate column "//
squote(column_name)//
" in file " &
290 //
squote(filename1)//
" has " &
291 //
ascharacter(duplicate_column_data(icolindex)%count) &
292 //
" entries, but the previously loaded column has " &
293 //
ascharacter(existing_values%count)//
" entries." &
294 //
" All lookup tables must have the same number of rows.", &
299 do iverify = 1, existing_values%count
300 existing_val = trim(existing_values%get(iverify))
301 duplicate_val = trim(duplicate_column_data(icolindex)%get(iverify))
302 if (.not. (existing_val .strapprox. duplicate_val))
then
303 if (column_name .strapprox.
"LU_CODE")
then
304 call warn(
"LU_CODE mismatch at row " &
305 //
ascharacter(iverify)//
": previously loaded value = " &
306 //
squote(existing_val)//
", value in " &
308 //
". LU_CODE must appear in the same order across all" &
309 //
" lookup tables. All other columns from this file" &
310 //
" may be misaligned.", &
313 call warn(
"Duplicate column "//
squote(column_name) &
315 //
": previously loaded = "//
squote(existing_val) &
316 //
", value in "//
squote(filename1)//
" = " &
317 //
squote(duplicate_val)//
". Values must be identical.", &
325 deallocate(skip_this_column)
326 deallocate(duplicate_column_data)
341 character (len=*),
intent(in) :: sKey
342 character (len=*),
intent(in),
optional :: sValues(:)
343 integer (c_int),
intent(in),
optional :: iValues(:)
344 real (c_float),
intent(in),
optional :: fValues(:)
345 real (c_double),
intent(in),
optional :: dValues(:)
346 logical (c_bool),
intent(in),
optional :: lValues(:)
349 integer (c_int) :: iStat
350 integer (c_int) :: iIndex
351 type (DICT_ENTRY_T),
pointer :: pCurrentDict
354 pcurrentdict => null()
357 if ( .not.
associated( pcurrentdict ))
then
360 allocate( pcurrentdict, stat=istat )
362 call assert(istat == 0,
"Failed to allocate memory for dictionary object", &
366 call pcurrentdict%add_key( skey )
371 if (
present( svalues ) )
then
373 do iindex = lbound(svalues,1), ubound(svalues,1)
375 call pcurrentdict%add_value( svalues( iindex ) )
379 else if (
present ( ivalues ) )
then
381 do iindex = lbound(ivalues,1), ubound(ivalues,1)
383 call pcurrentdict%add_value( ivalues( iindex ) )
387 else if (
present ( fvalues ) )
then
389 do iindex = lbound(fvalues,1), ubound(fvalues,1)
391 call pcurrentdict%add_value( fvalues( iindex ) )
395 else if (
present ( dvalues ) )
then
397 do iindex = lbound(dvalues,1), ubound(dvalues,1)
399 call pcurrentdict%add_value( dvalues( iindex ) )
403 else if (
present ( lvalues ) )
then
405 do iindex = lbound(lvalues,1), ubound(lvalues,1)
407 call pcurrentdict%add_value( lvalues( iindex ) )
490 type (DATETIME_T),
intent(in out),
allocatable :: dtValues(:)
491 type (FSTRING_LIST_T),
intent(in out),
optional :: slKeys
492 character (len=*),
intent(in ),
optional :: sKey
493 logical (c_bool),
intent(in),
optional :: lFatal
496 logical (c_bool) :: lFatal_l
497 type (FSTRING_LIST_T) :: slValues
499 integer (c_int) :: istat
501 if (
present (lfatal) )
then
507 if (
present( slkeys) )
then
509 call params_dict%get_values( slkeys=slkeys, slstring=slvalues, is_fatal=lfatal_l )
511 else if (
present( skey) )
then
513 call params_dict%get_values( skey=skey, slstring=slvalues )
517 allocate(dtvalues(slvalues%count), stat=istat)
519 do n=1, slvalues%count
520 call dtvalues(n)%parseDate(slvalues%get(n))
530 type (FSTRING_LIST_T),
intent(out) :: slValues
531 type (FSTRING_LIST_T),
intent(inout),
optional :: slKeys
532 character (len=*),
intent(in ),
optional :: sKey
533 logical (c_bool),
intent(in),
optional :: lFatal
536 logical (c_bool) :: lFatal_l
538 if (
present (lfatal) )
then
544 if (
present( slkeys) )
then
546 call params_dict%get_values( slkeys=slkeys, slstring=slvalues, &
549 if ( slvalues%get(1) .strequal.
"<NA>" )
then
550 call warn(
"Failed to find a lookup table column named " &
551 //
dquote( slkeys%list_all() )//
".", lfatal = lfatal_l )
554 else if (
present( skey) )
then
556 call params_dict%get_values( skey=skey, slstring=slvalues )
558 if ( slvalues%get(1) .strequal.
"<NA>" )
then
559 call warn(
"Failed to find a lookup table column named " &
560 //
dquote( skey )//
".", lfatal = lfatal_l )
655 real (c_float),
intent(in out),
allocatable :: fValues(:,:)
656 character (len=*),
intent(in) :: sPrefix
657 integer (c_int),
intent(in) :: iNumRows
658 logical (c_bool),
intent(in),
optional :: lFatal
661 integer (c_int) :: iIndex
662 integer (c_int) :: iStat
663 character (len=256) :: sText
664 integer (c_int) :: iNumCols
665 type (FSTRING_LIST_T) :: slList
666 real (c_float),
allocatable :: fTempVal(:)
667 logical (c_bool) :: lFatal_l
669 if (
present (lfatal) )
then
675 sllist =
params%grep_name( sprefix )
677 inumcols = sllist%count
679 if ( inumcols == 0 )
then
681 call warn(
"Failed to find a lookup table column named " &
682 //
dquote( sprefix )//
".", lfatal = lfatal_l )
686 allocate( ftempval( inumrows ), stat=istat )
687 call assert( istat == 0,
"Problem allocating memory.", __file__, __line__ )
689 allocate( fvalues( inumrows, inumcols ), stat=istat )
690 call assert( istat == 0,
"Problem allocating memory." &
692 //
" sPrefix: "//
dquote(sprefix), __file__, __line__ )
694 do iindex = 1, inumcols
696 stext = trim( sllist%get( iindex ) )
697 call params_dict%get_values( skey=stext, fvalues=ftempval, &
700 call assert(
size( ftempval, 1) ==
size( fvalues, 1), &
701 "Mismatch in array size. Dictionary key: "//
squote( stext ) &
702 //
" expected size: "//
ascharacter(
size( fvalues, 1) ) &
703 //
" size of items in dictionary: " &
706 fvalues(:,iindex) = ftempval