1module sqliteUtilities_mod
2 ! MODULE sqliteUtilities_mod (prefix='sqlu' category='3. Observation input/output')
3 !
4 !:Purpose: A place to collect utilities for SQLite files.
5 !
6 use fSQLite
7 use clibInterfaces_mod
8 use obsSpaceData_mod
9 use midasMpi_mod
10 use utilities_mod
11 use mathPhysConstants_mod
12
13 implicit none
14 save
15 private
16 public :: sqlu_sqlColumnExists, sqlu_sqlTableExists, sqlu_getSqlColumnNames
17 public :: sqlu_query, sqlu_handleError
18 public :: sqlu_getColumnValuesNum, sqlu_getColumnValuesDateStr, sqlu_getColumnValuesChar
19 public :: sqlu_getInitialIdObsData
20
21 ! Arrays used to match SQLite column names with obsSpaceData column names
22 integer, parameter :: lenSqlName = 60
23
24contains
25
26 !--------------------------------------------------------------------------
27 ! sqlu_sqlColumnExists
28 !--------------------------------------------------------------------------
29 function sqlu_sqlColumnExists(fileName, tableName, columnName) result(columnExists)
30 !
31 !:Purpose: Check if a column exists in the sqlite file/table
32 !
33 implicit none
34
35 ! Arguments:
36 character(len=*), intent(in) :: fileName
37 character(len=*), intent(in) :: tableName
38 character(len=*), intent(in) :: columnName
39 ! Result:
40 logical :: columnExists
41
42 ! Locals:
43 integer :: ierr
44 character(len=3000) :: query, sqliteOutput
45 character(len=lenSqlName) :: upperColumnName
46 type(fSQL_STATUS) :: stat ! sqlite error status
47 type(fSQL_DATABASE) :: db ! sqlite file handle
48 logical, parameter :: debug = .false.
49 character(len=*), parameter :: myName = 'sqlu_sqlColumnExists'
50
51 ! open the SQLite file
52 call fSQL_open( db, trim(fileName), status=stat )
53 if ( fSQL_error(stat) /= FSQL_OK ) then
54 call utl_abort( myName//fSQL_errmsg(stat) )
55 end if
56
57 upperColumnName = trim(columnName)
58 ierr = clib_toUpper(upperColumnName)
59
60 query = "select count(*) from pragma_table_info('" // &
61 trim(tableName) // "') where upper(name)='" // trim(upperColumnName) // "';"
62 if (debug) write(*,*) myName//': query = ', trim(query)
63
64 sqliteOutput = sqlu_query(db,trim(query))
65 if (debug) write(*,*) myName//': output = XXX' // trim(sqliteOutput) // 'XXX'
66 columnExists = (trim(sqliteOutput) /= '0')
67
68 ! close the sqlite file
69 call fSQL_close( db, stat )
70
71 end function sqlu_sqlColumnExists
72
73 !--------------------------------------------------------------------------
74 ! sqlu_sqlTableExists
75 !--------------------------------------------------------------------------
76 function sqlu_sqlTableExists(fileName, tableName) result(tableExists)
77 !
78 !:Purpose: Check if a table exists in the sqlite file
79 !
80 implicit none
81
82 ! Arguments:
83 character(len=*), intent(in) :: fileName
84 character(len=*), intent(in) :: tableName
85 ! Result:
86 logical :: tableExists
87
88 ! Locals:
89 integer :: ierr
90 logical :: finished
91 character(len=3000) :: query, sqliteOutput
92 character(len=lenSqlName) :: upperTableName
93 type(fSQL_STATUS) :: stat ! sqlite error status
94 type(fSQL_DATABASE) :: db ! sqlite file handle
95 type(fSQL_STATEMENT) :: stmt ! precompiled sqlite statements
96 logical, parameter :: debug = .false.
97 character(len=*), parameter :: myName = 'sqlu_sqlTableExists'
98
99 ! open the sqlite file
100 call fSQL_open( db, trim(fileName), status=stat )
101 if ( fSQL_error(stat) /= FSQL_OK ) then
102 call utl_abort( myName//': fSQL_open '//fSQL_errmsg(stat) )
103 end if
104
105 upperTableName = trim(tableName)
106 ierr = clib_toUpper(upperTableName)
107
108 query = "select upper(name) as uppername from sqlite_master where " // &
109 "type='table' and uppername='" // trim(upperTableName) // "';"
110 if (debug) write(*,*) myName//': query = ', trim(query)
111
112 call fSQL_prepare( db, trim(query), stmt, stat)
113 finished = .false.
114 call fSQL_get_row( stmt, finished )
115 call fSQL_get_column( stmt, COL_INDEX = 1, CHAR_VAR = sqliteOutput )
116 call fSQL_get_row( stmt, finished )
117 call fSQL_finalize( stmt )
118 if (debug) write(*,*) myName//': output = XXX' // trim(sqliteOutput) // 'XXX'
119 tableExists = (trim(sqliteOutput) == trim(upperTableName))
120
121 ! close the sqlite file
122 call fSQL_close( db, stat )
123
124 end function sqlu_sqlTableExists
125
126 !--------------------------------------------------------------------------
127 ! sqlu_getSqlColumnNames
128 !--------------------------------------------------------------------------
129 subroutine sqlu_getSqlColumnNames(sqlColumnNames, fileName, tableName, dataType)
130 !
131 !:Purpose: Read the column names in the sqlite file for the specified table.
132 !
133 implicit none
134
135 ! Arguments:
136 character(len=*), allocatable, intent(out) :: sqlColumnNames(:)
137 character(len=*), intent(in) :: fileName
138 character(len=*), intent(in) :: tableName
139 character(len=*), intent(in) :: dataType
140
141 ! Locals:
142 integer :: numRows, numColumns, rowIndex, ierr
143 character(len=100), allocatable :: charValues(:,:)
144 character(len=200) :: dataTypeCriteria
145 character(len=3000) :: query
146 type(fSQL_STATUS) :: stat ! sqlite error status
147 type(fSQL_DATABASE) :: db ! sqlite file handle
148 type(fSQL_STATEMENT) :: stmt ! precompiled sqlite statements
149 character(len=*), parameter :: myName = 'sqlu_getSqlColumnNames'
150
151 ! open the sqlite file
152 call fSQL_open( db, trim(fileName), status=stat )
153 if ( fSQL_error(stat) /= FSQL_OK ) then
154 call utl_abort( myName//': fSQL_open '//fSQL_errmsg(stat) )
155 end if
156
157 ! read the column names
158 if (trim(dataType) == 'varchar') then
159 dataTypeCriteria = 'substr(type,1,7)="varchar"'
160 else if (trim(dataType) == 'numeric') then
161 dataTypeCriteria = 'type="real" or type="REAL" or type="double" or ' // &
162 'type="DOUBLE" or type="integer" or type="INTEGER" or ' // &
163 'type="INT" or type=""'
164 else if (trim(dataType) /= 'all') then
165 call utl_abort( myName//': invalid dataType = ' // trim(dataType) )
166 end if
167 if (trim(dataType) == 'all') then
168 query = 'select name from pragma_table_info("' // trim(tableName) // '");'
169 else
170 query = 'select name from pragma_table_info("' // trim(tableName) // &
171 '") where ' // trim(dataTypeCriteria) // ' ;'
172 end if
173 call fSQL_prepare( db, trim(query) , stmt, stat )
174 call fSQL_get_many( stmt, nrows=numRows, ncols=numColumns, &
175 mode=FSQL_CHAR, status=stat )
176 if ( fSQL_error(stat) /= FSQL_OK ) then
177 call utl_abort( myName//': problem with fSQL_get_many '//fSQL_errmsg(stat))
178 end if
179 allocate( charValues(numRows, numColumns) )
180 call fSQL_fill_matrix( stmt, charValues )
181
182 ! copy to output array and ensure they are upper case
183 allocate( sqlColumnNames(numRows) )
184 do rowIndex = 1, numRows
185 sqlColumnNames(rowIndex) = charValues(rowIndex,1)
186 ierr = clib_toUpper(sqlColumnNames(rowIndex))
187 end do
188 deallocate( charValues )
189
190 ! clean up and close the sqlite file
191 call fSQL_free_mem( stmt )
192 call fSQL_finalize( stmt )
193 call fSQL_close( db, stat )
194
195 end subroutine sqlu_getSqlColumnNames
196
197 !--------------------------------------------------------------------------
198 ! sqlu_getColumnValuesNum
199 !--------------------------------------------------------------------------
200 subroutine sqlu_getColumnValuesNum(columnValues, fileName, tableName, &
201 sqlColumnNames, extraQuery_opt)
202 !
203 !:Purpose: Read the column values from sqlite file for the specified table
204 ! and column names.
205 !
206 implicit none
207
208 ! Arguments:
209 real(8), allocatable, intent(out) :: columnValues(:,:)
210 character(len=*), intent(in) :: sqlColumnNames(:)
211 character(len=*), intent(in) :: fileName
212 character(len=*), intent(in) :: tableName
213 character(len=*), optional, intent(in) :: extraQuery_opt
214
215 ! Locals:
216 integer :: numRows, numColumns, columnIndex
217 character(len=3000) :: query, extraQuery
218 type(fSQL_STATUS) :: stat ! sqlite error status
219 type(fSQL_DATABASE) :: db ! sqlite file handle
220 type(fSQL_STATEMENT) :: stmt ! precompiled sqlite statements
221
222 if (present(extraQuery_opt)) then
223 extraQuery = trim(extraQuery_opt)
224 else
225 extraQuery = ''
226 end if
227
228 ! open the sqlite file
229 call fSQL_open( db, trim(fileName), status=stat )
230 if ( fSQL_error(stat) /= FSQL_OK ) then
231 write(*,*) 'sqlu_getColumnValuesNum: fSQL_open: ', fSQL_errmsg(stat)
232 call utl_abort( 'sqlu_getColumnValuesNum: fSQL_open' )
233 end if
234
235 ! build the sqlite query
236 query = 'select'
237 numColumns = size(sqlColumnNames)
238 do columnIndex = 1, numColumns
239 query = trim(query) // ' ' // trim(sqlColumnNames(columnIndex))
240 if (columnIndex < numColumns) query = trim(query) // ','
241 end do
242 query = trim(query) // ' from ' // trim(tableName)
243 query = trim(query) // ' ' // trim(extraQuery) // ';'
244 write(*,*) 'sqlu_getColumnValuesNum: query ---> ', trim(query)
245
246 ! read the values from the file
247 call fSQL_prepare( db, trim(query) , stmt, status=stat )
248 call fSQL_get_many( stmt, nrows=numRows, ncols=numColumns, mode=FSQL_REAL8, &
249 real8_missing=MPC_missingValue_R8, status=stat )
250 if ( fSQL_error(stat) /= FSQL_OK ) then
251 write(*,*) 'sqlu_getColumnValuesNum: fSQL_get_many: ', fSQL_errmsg(stat)
252 call utl_abort('sqlu_getColumnValuesNum: problem with fSQL_get_many')
253 end if
254 write(*,*) 'sqlu_getColumnValuesNum: numRows = ', numRows, ', numColumns = ', numColumns
255 allocate( columnValues(numRows, numColumns) )
256 columnValues(:,:) = 0.0d0
257 call fSQL_fill_matrix( stmt, columnValues )
258
259 ! close the sqlite file
260 call fSQL_free_mem( stmt )
261 call fSQL_finalize( stmt )
262 call fSQL_close( db, stat )
263
264 end subroutine sqlu_getColumnValuesNum
265
266 !--------------------------------------------------------------------------
267 ! sqlu_getColumnValuesChar
268 !--------------------------------------------------------------------------
269 subroutine sqlu_getColumnValuesChar(columnValues, fileName, tableName, &
270 sqlColumnNames)
271 !
272 !:Purpose: Read the column values from sqlite file for the specified table
273 ! and column names.
274 !
275 implicit none
276
277 ! Arguments:
278 character(len=50), allocatable, intent(out) :: columnValues(:,:)
279 character(len=*), intent(in) :: sqlColumnNames(:)
280 character(len=*), intent(in) :: fileName
281 character(len=*), intent(in) :: tableName
282
283 ! Locals:
284 integer :: numRows, numColumns, columnIndex
285 character(len=3000) :: query
286 type(fSQL_STATUS) :: stat ! sqlite error status
287 type(fSQL_DATABASE) :: db ! sqlite file handle
288 type(fSQL_STATEMENT) :: stmt ! precompiled sqlite statements
289
290 ! open the sqlite file
291 call fSQL_open( db, trim(fileName), status=stat )
292 if ( fSQL_error(stat) /= FSQL_OK ) then
293 write(*,*) 'sqlu_getColumnValuesChar: fSQL_open: ', fSQL_errmsg(stat)
294 call utl_abort( 'sqlu_getColumnValuesChar: fSQL_open' )
295 end if
296
297 ! build the sqlite query
298 query = 'select'
299 numColumns = size(sqlColumnNames)
300 do columnIndex = 1, numColumns
301 query = trim(query) // ' ' // trim(sqlColumnNames(columnIndex))
302 if (columnIndex < numColumns) query = trim(query) // ','
303 end do
304 query = trim(query) // ' from ' // trim(tableName) // ';'
305 write(*,*) 'sqlu_getColumnValuesChar: query ---> ', trim(query)
306
307 ! read the values from the file
308 call fSQL_prepare( db, trim(query), stmt, status=stat )
309 call fSQL_get_many( stmt, nrows=numRows, ncols=numColumns, &
310 mode=FSQL_CHAR, status=stat )
311 if ( fSQL_error(stat) /= FSQL_OK ) then
312 write(*,*) 'sqlu_getColumnValuesChar: fSQL_get_many: ', fSQL_errmsg(stat)
313 call utl_abort('sqlu_getColumnValuesChar: problem with fSQL_get_many')
314 end if
315 write(*,*) 'sqlu_getColumnValuesChar: numRows = ', numRows, ', numColumns = ', numColumns
316 allocate( columnValues(numRows, numColumns) )
317 call fSQL_fill_matrix( stmt, columnValues )
318
319 ! close the sqlite file
320 call fSQL_free_mem( stmt )
321 call fSQL_finalize( stmt )
322 call fSQL_close( db, stat )
323
324 end subroutine sqlu_getColumnValuesChar
325
326 !--------------------------------------------------------------------------
327 ! sqlu_getColumnValuesDateStr
328 !--------------------------------------------------------------------------
329 subroutine sqlu_getColumnValuesDateStr(columnDateValues, columnTimeValues, fileName, &
330 tableName, sqlColumnName)
331 !
332 !:Purpose: Read the column values from sqlite file for the specified table
333 ! and column names.
334 !
335 implicit none
336
337 ! Arguments:
338 integer, allocatable, intent(out) :: columnDateValues(:)
339 integer, allocatable, intent(out) :: columnTimeValues(:)
340 character(len=*), intent(in) :: sqlColumnName
341 character(len=*), intent(in) :: fileName
342 character(len=*), intent(in) :: tableName
343
344 ! Locals:
345 integer :: numRows, numColumns, rowIndex
346 character(len=20), allocatable :: columnValuesStr(:,:)
347 character(len=3000) :: query
348 type(fSQL_STATUS) :: stat ! sqlite error status
349 type(fSQL_DATABASE) :: db ! sqlite file handle
350 type(fSQL_STATEMENT) :: stmt ! precompiled sqlite statements
351
352 ! open the sqlite file
353 call fSQL_open( db, trim(fileName), status=stat )
354 if ( fSQL_error(stat) /= FSQL_OK ) then
355 write(*,*) 'sqlu_getColumnValuesDateStr: fSQL_open: ', fSQL_errmsg(stat)
356 call utl_abort( 'sqlu_getColumnValuesDateStr: fSQL_open' )
357 end if
358
359 ! Get the date and time
360
361 ! build the sqlite query
362 query = "select strftime('%Y%m%d'," // trim(sqlColumnName) // &
363 "), strftime('%H%M'," // trim(sqlColumnName) // ") " // &
364 "from " // trim(tableName) // ";"
365 write(*,*) 'sqlu_getColumnValuesDateStr: query ---> ', trim(query)
366
367 ! read the values from the file
368 call fSQL_prepare( db, trim(query), stmt, status=stat )
369 call fSQL_get_many( stmt, nrows=numRows, ncols=numColumns, &
370 mode=FSQL_CHAR, status=stat )
371 if ( fSQL_error(stat) /= FSQL_OK ) then
372 write(*,*) 'sqlu_getColumnValuesDateStr: fSQL_get_many: ', fSQL_errmsg(stat)
373 call utl_abort('sqlu_getColumnValuesDateStr: problem with fSQL_get_many')
374 end if
375 write(*,*) 'sqlu_getColumnValuesDateStr: numRows = ', numRows, ', numColumns = ', numColumns
376 allocate( columnValuesStr(numRows,2) )
377 call fSQL_fill_matrix( stmt, columnValuesStr )
378 allocate( columnDateValues(numRows) )
379 allocate( columnTimeValues(numRows) )
380 do rowIndex = 1, numRows
381 read(columnValuesStr(rowIndex,1),*) columnDateValues(rowIndex)
382 read(columnValuesStr(rowIndex,2),*) columnTimeValues(rowIndex)
383 end do
384
385 deallocate(columnValuesStr)
386
387 ! close the sqlite file
388 call fSQL_free_mem( stmt )
389 call fSQL_finalize( stmt )
390 call fSQL_close( db, stat )
391
392 end subroutine sqlu_getColumnValuesDateStr
393
394 !--------------------------------------------------------------------------
395 ! sqlu_getInitialIdObsData
396 !--------------------------------------------------------------------------
397 subroutine sqlu_getInitialIdObsData(obsDat, obsFamily, idObs, idData, codeTypeList_opt)
398 !
399 !:Purpose: Compute initial value for idObs and idData that will ensure
400 ! unique values over all mpi tasks
401 !
402 implicit none
403
404 ! Arguments:
405 type(struct_obs), intent(inout) :: obsdat
406 character(len=*), intent(in) :: obsFamily
407 integer , intent(out) :: idObs
408 integer , intent(out) :: idData
409 integer, optional, intent(in) :: codeTypeList_opt(:)
410
411 ! Locals:
412 integer :: headerIndex, numHeader, numBody, codeType, ierr
413 integer, allocatable :: allNumHeader(:), allNumBody(:)
414
415 numHeader = 0
416 numBody = 0
417 call obs_set_current_header_list(obsdat, obsFamily)
418 HEADERCOUNT: do
419 headerIndex = obs_getHeaderIndex(obsdat)
420 if (headerIndex < 0) exit HEADERCOUNT
421 if (present(codeTypeList_opt)) then
422 codeType = obs_headElem_i(obsdat, OBS_ITY, headerIndex)
423 if (all(codeTypeList_opt(:) /= codeType)) cycle HEADERCOUNT
424 end if
425 numHeader = numHeader + 1
426 numBody = numBody + obs_headElem_i(obsdat, OBS_NLV, headerIndex)
427 end do HEADERCOUNT
428 allocate(allNumHeader(mmpi_nprocs))
429 allocate(allNumBody(mmpi_nprocs))
430 call rpn_comm_allgather(numHeader,1,'mpi_integer', &
431 allNumHeader,1,'mpi_integer','GRID',ierr)
432 call rpn_comm_allgather(numBody,1,'mpi_integer', &
433 allNumBody,1,'mpi_integer','GRID',ierr)
434 if (mmpi_myid > 0) then
435 idObs = sum(allNumHeader(1:mmpi_myid))
436 idData = sum(allNumBody(1:mmpi_myid))
437 else
438 idObs = 0
439 idData = 0
440 end if
441 deallocate(allNumHeader)
442 deallocate(allNumBody)
443
444 end subroutine sqlu_getInitialIdObsData
445
446 !--------------------------------------------------------------------------
447 ! sqlu_query
448 !--------------------------------------------------------------------------
449 function sqlu_query(db,query)
450 !
451 !:Purpose: To create a query to read an SQLite file
452 !
453 implicit none
454
455 ! Arguments:
456 type(fSQL_DATABASE), intent(inout) :: db ! type handle for SQLIte file
457 character(len=*), intent(in) :: query
458 ! Result:
459 character(len=256) :: sqlu_query
460
461 ! Locals:
462 character(len=256) :: result
463 logical :: finished
464 type(fSQL_STATEMENT) :: stmt ! prepared statement for SQLite
465 type(fSQL_STATUS) :: stat !type error status
466
467 result=''
468 call fSQL_prepare(db, trim(query), stmt, stat)
469 if (fSQL_error(stat) /= FSQL_OK) call sqlu_handleError(stat,'fSQL_prepare: ')
470 finished=.false.
471 call fSQL_get_row(stmt, finished)
472
473 ! Put result of query into variable
474 call fSQL_get_column(stmt, COL_INDEX = 1, char_var = result)
475 call fSQL_get_row(stmt, finished)
476 if (.not. finished) write(*,*) ' SQL QUERY ---> QUERY RETURNS MORE THAN ONE ROW... '
477 call fSQL_finalize(stmt)
478 sqlu_query = trim(result)
479
480 end function sqlu_query
481
482 !--------------------------------------------------------------------------
483 ! sqlu_handleError
484 !--------------------------------------------------------------------------
485 subroutine sqlu_handleError(stat, message)
486 implicit none
487
488 ! Arguments:
489 type(FSQL_STATUS), intent(in) :: stat
490 character(len=*), intent(in) :: message
491
492 write(*,*) message, fSQL_errmsg(stat)
493 call utl_abort(trim(message))
494
495 end subroutine sqlu_handleError
496
497end module sqliteUtilities_mod
