Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief provides a uniform framework to add references to CP2K
10 : !> cite and output these
11 : !> \note
12 : !> references need to be input using the ISI citation format, because it is
13 : !> uniform, easy to parse, and can be exported for example from web of science
14 : !> furthermore, it can be easily converted to and from using the bibutils tools
15 : !> a collection of easy to use conversion programs that can be found at
16 : !> http://www.scripps.edu/~cdputnam/software/bibutils/
17 : !> by Chris Putnam
18 : !>
19 : !> see thebibliography.F on how to add references easily
20 : !> \par History
21 : !> 08.2007 [Joost VandeVondele]
22 : !> \author Joost VandeVondele
23 : ! **************************************************************************************************
24 : MODULE reference_manager
25 : USE kinds, ONLY: default_string_length
26 : USE message_passing, ONLY: mp_para_env_type
27 : USE string_utilities, ONLY: uppercase
28 : USE util, ONLY: sort
29 : #include "../base/base_uses.f90"
30 :
31 : IMPLICIT NONE
32 :
33 : PUBLIC :: print_reference, print_all_references, cite_reference
34 : PUBLIC :: collect_citations_from_ranks
35 :
36 : INTEGER, PUBLIC, PARAMETER :: print_format_isi = 101, &
37 : print_format_journal = 102, &
38 : print_format_html = 103
39 :
40 : PRIVATE
41 :
42 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'reference_manager'
43 :
44 : ! maximum number of reference that can be added
45 : INTEGER, PARAMETER :: max_reference = 1024
46 :
47 : ! storage of a reference
48 : INTEGER, PARAMETER :: doi_length = 128
49 : INTEGER, PARAMETER :: ISI_length = 128
50 :
51 : ! the way we store a reference, should remain fully private
52 : ! **************************************************************************************************
53 : TYPE reference_type
54 : PRIVATE
55 : ! the reference in a format as returned by the web of science
56 : CHARACTER(LEN=ISI_length), DIMENSION(:), POINTER :: ISI_record => NULL()
57 : ! the doi only, i.e. without "https://doi.org/"
58 : CHARACTER(LEN=doi_length) :: DOI = ""
59 : ! has this reference been cited in the program run
60 : LOGICAL :: is_cited = .FALSE.
61 : ! this is a citation key for output in the reference lists
62 : CHARACTER(LEN=ISI_length) :: citation_key = ""
63 : END TYPE reference_type
64 :
65 : ! useful to build arrays
66 : ! **************************************************************************************************
67 : TYPE reference_p_type
68 : TYPE(reference_type), POINTER :: ref => NULL()
69 : END TYPE
70 :
71 : ! thebibliography
72 : INTEGER, SAVE :: nbib = 0
73 : TYPE(reference_p_type), DIMENSION(max_reference) :: thebib
74 :
75 : PUBLIC :: add_reference, & ! use this one only in bibliography.F
76 : remove_all_references, & ! use only in f77_interface.F
77 : get_citation_key ! a string key describing the reference (e.g. Kohn1965b)
78 :
79 : CONTAINS
80 :
81 : ! **************************************************************************************************
82 : !> \brief marks a given reference as cited.
83 : !> \param key citation key as returned from add_reference
84 : !> \par History
85 : !> XX.2007 created [ ]
86 : ! **************************************************************************************************
87 532456 : SUBROUTINE cite_reference(key)
88 : INTEGER, INTENT(IN) :: key
89 :
90 532456 : IF (key < 1 .OR. key > max_reference) CPABORT("citation key out of range")
91 :
92 : ! set as cited
93 532456 : thebib(key)%ref%is_cited = .TRUE.
94 :
95 532456 : END SUBROUTINE
96 :
97 : ! **************************************************************************************************
98 : !> \brief Checks for each reference if any mpi-rank has marked it for citation.
99 : !> \param para_env ...
100 : !> \par History
101 : !> 12.2013 created [Ole Schuett]
102 : ! **************************************************************************************************
103 8989 : SUBROUTINE collect_citations_from_ranks(para_env)
104 : TYPE(mp_para_env_type), INTENT(IN) :: para_env
105 :
106 : INTEGER :: i, t
107 :
108 2265228 : DO i = 1, nbib
109 2256239 : t = 0
110 2256239 : IF (thebib(i)%ref%is_cited) t = 1
111 2256239 : CALL para_env%max(t)
112 2265228 : thebib(i)%ref%is_cited = (t == 1)
113 : END DO
114 :
115 8989 : END SUBROUTINE collect_citations_from_ranks
116 :
117 : ! **************************************************************************************************
118 : !> \brief add a reference to the bibliography
119 : !> \param key output, this handle is needed to cite this reference later
120 : !> \param ISI_record ...
121 : !> \param DOI ...
122 : !> \par History
123 : !> 08.2007 created [Joost VandeVondele]
124 : !> \note
125 : !> - see bibliography.F for it use.
126 : !> - the ISI record is space sensitive, in particular the first three characters need to be blank
127 : !> or contain a key indicating the record type. See the header of this file for tools
128 : !> that can convert e.g. bibtex or endnote files to the ISI format
129 : !> - DOI: provide the DOI without a link. The link will be automatically created as needed.
130 : ! **************************************************************************************************
131 4212784 : SUBROUTINE add_reference(key, ISI_record, DOI)
132 : INTEGER, INTENT(OUT) :: key
133 : CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: ISI_record
134 : CHARACTER(LEN=*), INTENT(IN) :: DOI
135 :
136 : CHARACTER :: tmp
137 : CHARACTER(LEN=ISI_length) :: author, citation_key, key_a, key_b, year
138 : INTEGER :: commaloc, i, ires, line, match, mylen, &
139 : nlines
140 :
141 2106392 : IF (nbib + 1 > max_reference) CPABORT("increase max_reference")
142 2106392 : nbib = nbib + 1
143 2106392 : key = nbib
144 :
145 : ! initialize reference to zero
146 2106392 : ALLOCATE (thebib(key)%ref)
147 : NULLIFY (thebib(key)%ref%ISI_record)
148 2106392 : thebib(key)%ref%DOI = ""
149 : thebib(key)%ref%is_cited = .FALSE.
150 :
151 : ! Assign DOI
152 2106392 : thebib(key)%ref%DOI = DOI
153 :
154 : ! Assign ISI_record
155 2106392 : nlines = SIZE(ISI_record, 1)
156 6319176 : ALLOCATE (thebib(key)%ref%ISI_record(nlines))
157 36681432 : thebib(key)%ref%ISI_record = ISI_record
158 :
159 : ! construct a citation_key
160 2106392 : line = 1
161 2106392 : author = get_next_author(thebib(key)%ref%ISI_record, line)
162 2106392 : commaloc = INDEX(author, ',')
163 2106392 : IF (commaloc .GT. 0) author = author(1:commaloc - 1)
164 2106392 : CPASSERT(LEN_TRIM(author) > 0)
165 2106392 : year = get_year(thebib(key)%ref%ISI_record)
166 2106392 : CPASSERT(LEN_TRIM(year) == 4)
167 2106392 : citation_key = TRIM(author)//TRIM(year)
168 :
169 : ! avoid special characters in names, just remove them
170 2106392 : mylen = LEN_TRIM(citation_key)
171 2106392 : ires = 0
172 24605344 : DO I = 1, mylen
173 24605344 : IF (INDEX("0123456789thequickbrownfoxjumpsoverthelazydogTHEQUICKBROWNFOXJUMPSOVERTHELAZYDOG", citation_key(i:i)) .NE. 0) THEN
174 22398248 : ires = ires + 1
175 22398248 : tmp = citation_key(i:i)
176 22398248 : citation_key(ires:ires) = tmp
177 : END IF
178 : END DO
179 2106392 : citation_key(ires + 1:) = ""
180 2106392 : CPASSERT(LEN_TRIM(citation_key) > 4) ! At least one character of the author should be left.
181 :
182 : ! avoid duplicates, search through the list for matches (case-insensitive)
183 2106392 : mylen = LEN_TRIM(citation_key)
184 2106392 : key_a = citation_key(1:mylen)
185 2106392 : CALL uppercase(key_a)
186 2106392 : match = 0
187 265405392 : DO I = 1, nbib - 1
188 263299000 : key_b = thebib(I)%ref%citation_key(1:mylen)
189 263299000 : CALL uppercase(key_b)
190 265405392 : IF (key_a == key_b) match = match + 1
191 : END DO
192 2106392 : IF (match > 0) citation_key = citation_key(1:mylen)//CHAR(ICHAR('a') + match)
193 :
194 : ! finally store it
195 2106392 : thebib(key)%ref%citation_key = citation_key
196 :
197 2106392 : END SUBROUTINE add_reference
198 :
199 : ! **************************************************************************************************
200 : !> \brief deallocate the bibliography
201 : !> \par History
202 : !> 08.2007 Joost VandeVondele [ ]
203 : ! **************************************************************************************************
204 8392 : SUBROUTINE remove_all_references()
205 : INTEGER :: i
206 :
207 2114784 : DO i = 1, nbib
208 2106392 : IF (ASSOCIATED(thebib(i)%ref%ISI_record)) DEALLOCATE (thebib(i)%ref%ISI_record)
209 2106392 : thebib(i)%ref%DOI = ""
210 :
211 2114784 : DEALLOCATE (thebib(i)%ref)
212 : END DO
213 8392 : END SUBROUTINE remove_all_references
214 : !****f* reference_manager/print_all_references *
215 :
216 : ! **************************************************************************************************
217 : !> \brief printout of all references in a specific format
218 : !> optionally printing only those that are actually cited
219 : !> during program execution
220 : !> \param cited_only print only those marked as cited
221 : !> \param sorted sort entries most recent first according to the date,
222 : !> otherways sort with respect to key
223 : !> \param FORMAT see module parameters print_format_XXXXXXXXX
224 : !> \param unit ...
225 : !> \param list optionally, output a sub-list only
226 : !> \par History
227 : !> 08.2007 Joost VandeVondele [ ]
228 : ! **************************************************************************************************
229 4590 : SUBROUTINE print_all_references(cited_only, sorted, FORMAT, unit, list)
230 : LOGICAL, INTENT(IN) :: cited_only, sorted
231 : INTEGER, INTENT(IN) :: FORMAT, unit
232 : INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: list
233 :
234 : INTEGER :: I, irecord, nref
235 4590 : INTEGER, ALLOCATABLE, DIMENSION(:) :: indx, irank, ival
236 :
237 : ! we'll sort the references wrt to the publication year
238 : ! the most recent first, publications without a year get last
239 :
240 4590 : IF (PRESENT(list)) THEN
241 0 : nref = SIZE(list)
242 : ELSE
243 4590 : nref = nbib
244 : END IF
245 :
246 13770 : ALLOCATE (ival(nref))
247 13770 : ALLOCATE (irank(nref))
248 13770 : ALLOCATE (indx(nref))
249 :
250 4590 : IF (PRESENT(list)) THEN
251 0 : indx(:) = list
252 : ELSE
253 1156680 : DO I = 1, nref
254 1156680 : indx(I) = I
255 : END DO
256 : END IF
257 :
258 1156680 : DO I = 1, nref
259 1156680 : irank(I) = I
260 : END DO
261 :
262 4590 : IF (sorted) THEN
263 1156680 : DO I = 1, nref
264 1156680 : ival(I) = -get_epoch(thebib(indx(I))%ref%ISI_record)
265 : END DO
266 : ELSE
267 0 : DO I = 1, nref
268 0 : ival(I) = indx(I)
269 : END DO
270 : END IF
271 4590 : CALL sort(ival, nref, irank)
272 :
273 9180 : SELECT CASE (FORMAT)
274 : CASE (print_format_isi)
275 : CASE (print_format_journal)
276 4590 : WRITE (unit, '(A)') ""
277 : CASE (print_format_html)
278 0 : WRITE (unit, '(A)') '<TABLE border="1">'
279 : CASE DEFAULT
280 4590 : CPABORT("print_reference: wrong format")
281 : END SELECT
282 :
283 1156680 : DO I = 1, nref
284 1152090 : irecord = indx(irank(I))
285 1156680 : IF (.NOT. cited_only .OR. thebib(irecord)%ref%is_cited) THEN
286 0 : SELECT CASE (FORMAT)
287 : CASE (print_format_isi)
288 : CASE (print_format_journal)
289 : CASE (print_format_html)
290 0 : WRITE (unit, '(A)') "<TR><TD>"//'['//TRIM(thebib(irecord)%ref%citation_key)//']'//"</TD><TD>"
291 : CASE DEFAULT
292 56844 : CPABORT("print_reference: wrong format")
293 : END SELECT
294 :
295 56844 : CALL print_reference(irecord, FORMAT, unit)
296 :
297 56844 : SELECT CASE (FORMAT)
298 : CASE (print_format_isi)
299 : CASE (print_format_journal)
300 56844 : WRITE (unit, '(A)') ""
301 : CASE (print_format_html)
302 0 : WRITE (unit, '(A)') '</TD></TR>'
303 : CASE DEFAULT
304 1152090 : CPABORT("print_reference: wrong format")
305 : END SELECT
306 : END IF
307 : END DO
308 4590 : IF (FORMAT .EQ. print_format_html) THEN
309 0 : WRITE (unit, '(A)') "</TABLE>"
310 : END IF
311 :
312 4590 : END SUBROUTINE print_all_references
313 : !****f* reference_manager/print_reference *
314 :
315 : ! **************************************************************************************************
316 : !> \brief printout of a specified reference to a given unit in a selectable format
317 : !> \param key as returned from add_reference
318 : !> \param FORMAT see module parameters print_format_XXXXXXXXX
319 : !> \param unit ...
320 : !> \par History
321 : !> 08.2007 Joost VandeVondele [ ]
322 : ! **************************************************************************************************
323 56844 : SUBROUTINE print_reference(key, FORMAT, unit)
324 : INTEGER, INTENT(IN) :: key, FORMAT, unit
325 :
326 : INTEGER :: I
327 :
328 56844 : IF (key < 1 .OR. key > max_reference) CPABORT("citation key out of range")
329 :
330 56844 : SELECT CASE (FORMAT)
331 : CASE (print_format_isi)
332 0 : DO I = 1, SIZE(thebib(key)%ref%ISI_record)
333 0 : WRITE (unit, '(T2,A)') TRIM(thebib(key)%ref%ISI_record(I))
334 : END DO
335 : CASE (print_format_journal)
336 56844 : CALL print_reference_journal(key, unit)
337 : CASE (print_format_html)
338 0 : CALL print_reference_html(key, unit)
339 : CASE DEFAULT
340 56844 : CPABORT("print_reference: wrong format")
341 : END SELECT
342 56844 : END SUBROUTINE print_reference
343 :
344 : ! **************************************************************************************************
345 : !> \brief prints a reference in a journal style citation format,
346 : !> adding also a DOI link, which is convenient
347 : !> \param key ...
348 : !> \param unit ...
349 : !> \par History
350 : !> 08.2007 created [Joost VandeVondele]
351 : ! **************************************************************************************************
352 56844 : SUBROUTINE print_reference_journal(key, unit)
353 : INTEGER, INTENT(IN) :: key, unit
354 :
355 : CHARACTER(LEN=4*ISI_length) :: journal
356 : CHARACTER(LEN=ISI_length) :: author, title
357 : INTEGER :: iauthor, ipos_line, ititle, line
358 :
359 : ! write the author list
360 :
361 56844 : WRITE (unit, '(T2,A)', ADVANCE="NO") ""
362 56844 : line = 1; iauthor = 0; ipos_line = 2
363 56844 : author = get_next_author(thebib(key)%ref%ISI_record, line)
364 379713 : DO WHILE (author .NE. "")
365 322869 : iauthor = iauthor + 1
366 322869 : IF (ipos_line + LEN_TRIM(author) > 71) THEN
367 37973 : WRITE (unit, '(A)') ";"
368 37973 : WRITE (unit, '(T2,A)', ADVANCE="NO") ""
369 37973 : ipos_line = 2
370 : ELSE
371 284896 : IF (iauthor .NE. 1) WRITE (unit, '(A)', ADVANCE="NO") "; "
372 284896 : ipos_line = ipos_line + 2
373 : END IF
374 322869 : WRITE (unit, '(A)', ADVANCE="NO") TRIM(author)
375 322869 : ipos_line = ipos_line + LEN_TRIM(author)
376 379713 : author = get_next_author(thebib(key)%ref%ISI_record, line)
377 : END DO
378 56844 : IF (iauthor > 0) THEN
379 56844 : WRITE (unit, '(A)', ADVANCE="NO") ". "
380 56844 : ipos_line = ipos_line + 2
381 : END IF
382 :
383 : ! Journal, volume (issue), pages (year).
384 56844 : journal = TRIM(get_source(thebib(key)%ref%ISI_record))
385 56844 : IF (get_volume(thebib(key)%ref%ISI_record) .NE. "") THEN
386 51878 : journal = TRIM(journal)//", "//get_volume(thebib(key)%ref%ISI_record)
387 108722 : IF (get_issue(thebib(key)%ref%ISI_record) .NE. "") THEN
388 98099 : journal = TRIM(journal)//" ("//TRIM(get_issue(thebib(key)%ref%ISI_record))//")"
389 : END IF
390 : END IF
391 56844 : journal = TRIM(journal)//", "//get_pages(thebib(key)%ref%ISI_record)
392 56844 : IF (get_year(thebib(key)%ref%ISI_record) .NE. "") THEN
393 113688 : journal = TRIM(journal)//" ("//TRIM(get_year(thebib(key)%ref%ISI_record))//")."
394 : END IF
395 56844 : IF (ipos_line + LEN_TRIM(journal) > 71) THEN
396 52570 : WRITE (unit, '(A)') ""
397 52570 : WRITE (unit, '(T2,A)', ADVANCE="NO") ""
398 52570 : ipos_line = 2
399 : END IF
400 56844 : IF (ipos_line + LEN_TRIM(journal) > 71) THEN
401 4608 : WRITE (unit, '(A)') TRIM(journal(1:69))
402 4608 : WRITE (unit, '(A)', ADVANCE="NO") TRIM(journal(69:))
403 : ELSE
404 52236 : WRITE (unit, '(A)', ADVANCE="NO") TRIM(journal)
405 : END IF
406 :
407 56844 : WRITE (unit, '(T2,A)') ""
408 : ! Title
409 56844 : line = 1; ititle = 0
410 56844 : title = get_next_title(thebib(key)%ref%ISI_record, line)
411 154621 : DO WHILE (title .NE. "")
412 97777 : ititle = ititle + 1
413 97777 : IF (ititle .NE. 1) WRITE (unit, '(A)') ""
414 97777 : WRITE (unit, '(T2,A)', ADVANCE="NO") TRIM(title)
415 154621 : title = get_next_title(thebib(key)%ref%ISI_record, line)
416 : END DO
417 56844 : IF (ititle > 0) WRITE (unit, '(A)') "."
418 :
419 : ! DOI
420 56844 : IF (thebib(key)%ref%DOI .NE. "") THEN
421 56840 : WRITE (unit, '(T2,A)') "https://doi.org/"//TRIM(thebib(key)%ref%DOI)
422 : END IF
423 :
424 56844 : END SUBROUTINE print_reference_journal
425 :
426 : ! **************************************************************************************************
427 : !> \brief prints a reference in a journal style citation format,
428 : !> adding 'beautifying' html tags, and a link to the journal
429 : !> using the DOI
430 : !> \param key ...
431 : !> \param unit ...
432 : !> \par History
433 : !> 08.2007 created [Joost VandeVondele]
434 : ! **************************************************************************************************
435 0 : SUBROUTINE print_reference_html(key, unit)
436 : INTEGER, INTENT(IN) :: key, unit
437 :
438 : CHARACTER(LEN=ISI_length) :: author, title
439 : CHARACTER(LEN=ISI_length*4) :: journal
440 : INTEGER :: iauthor, ititle, line
441 :
442 : ! write the author list
443 :
444 0 : WRITE (unit, '(T2,A,I0,A)', ADVANCE="NO") '<A NAME="reference_', key, '">'
445 0 : line = 1; iauthor = 0
446 0 : author = get_next_author(thebib(key)%ref%ISI_record, line)
447 0 : DO WHILE (author .NE. "")
448 0 : iauthor = iauthor + 1
449 0 : IF (iauthor .NE. 1) WRITE (unit, '(A)', ADVANCE="NO") "; "
450 0 : WRITE (unit, '(A)', ADVANCE="NO") TRIM(author)
451 0 : author = get_next_author(thebib(key)%ref%ISI_record, line)
452 : END DO
453 0 : IF (iauthor > 0) WRITE (unit, '(A)') ".<br>"
454 :
455 : ! DOI
456 0 : IF (thebib(key)%ref%DOI .NE. "") THEN
457 0 : WRITE (unit, '(T2,A)', ADVANCE="NO") '<A HREF="https://doi.org/'//TRIM(thebib(key)%ref%DOI)//'">'
458 : END IF
459 : ! Journal, volume (issue), pages (year).
460 0 : journal = TRIM(get_source(thebib(key)%ref%ISI_record))
461 0 : IF (get_volume(thebib(key)%ref%ISI_record) .NE. "") THEN
462 0 : journal = TRIM(journal)//", "//get_volume(thebib(key)%ref%ISI_record)
463 0 : IF (get_issue(thebib(key)%ref%ISI_record) .NE. "") THEN
464 0 : journal = TRIM(journal)//" ("//TRIM(get_issue(thebib(key)%ref%ISI_record))//")"
465 : END IF
466 : END IF
467 0 : journal = TRIM(journal)//", "//get_pages(thebib(key)%ref%ISI_record)
468 0 : IF (get_year(thebib(key)%ref%ISI_record) .NE. "") THEN
469 0 : journal = TRIM(journal)//" ("//TRIM(get_year(thebib(key)%ref%ISI_record))//")."
470 : END IF
471 0 : WRITE (unit, '(A)', ADVANCE="NO") TRIM(journal)
472 0 : IF (thebib(key)%ref%DOI .NE. "") THEN
473 0 : WRITE (unit, '(A)', ADVANCE="NO") '</A>'
474 : END IF
475 0 : WRITE (unit, '(A)') "</A><br>"
476 :
477 : ! Title
478 0 : line = 1; ititle = 0
479 0 : title = get_next_title(thebib(key)%ref%ISI_record, line)
480 0 : DO WHILE (title .NE. "")
481 0 : ititle = ititle + 1
482 0 : IF (ititle .NE. 1) WRITE (unit, '(A)') ""
483 0 : WRITE (unit, '(T2,A)', ADVANCE="NO") TRIM(title)
484 0 : title = get_next_title(thebib(key)%ref%ISI_record, line)
485 : END DO
486 0 : IF (ititle > 0) WRITE (unit, '(A)') "."
487 :
488 0 : END SUBROUTINE print_reference_html
489 :
490 : ! **************************************************************************************************
491 : !> \brief returns the corresponding fields from an ISI record.
492 : !> returns an empty string if the field can not be found
493 : !> iline_start should be initialized to 1 to obtain the first matching entry
494 : !> on return it is updated, so that successive calls give successive fields
495 : !> \param ISI_record ...
496 : !> \param iline_start ...
497 : !> \return ...
498 : !> \par History
499 : !> 08.2007 created [Joost VandeVondele]
500 : ! **************************************************************************************************
501 2486105 : FUNCTION get_next_author(ISI_record, iline_start) RESULT(res)
502 : CHARACTER(LEN=ISI_length), DIMENSION(:), &
503 : INTENT(IN) :: ISI_record
504 : INTEGER, INTENT(INOUT) :: iline_start
505 : CHARACTER(LEN=ISI_length) :: res
506 :
507 : INTEGER :: I, N
508 : LOGICAL :: in_au_section
509 :
510 2486105 : res = ""
511 2486105 : in_au_section = .FALSE.
512 2486105 : N = SIZE(ISI_record, 1)
513 2486105 : IF (iline_start > N) RETURN
514 8318834 : line_loop: DO I = 1, N
515 8261990 : IF (ISI_record(I) (1:3) == "AU ") in_au_section = .TRUE.
516 8261990 : IF (in_au_section .AND. (ISI_record(I) (1:3) /= "AU " .AND. ISI_record(I) (1:3) /= " ")) in_au_section = .FALSE.
517 8261990 : IF (in_au_section) THEN
518 5444356 : IF (I >= iline_start) THEN
519 2429261 : iline_start = I + 1
520 2429261 : res = ISI_record(I) (4:)
521 2429261 : EXIT line_loop
522 : END IF
523 : END IF
524 : END DO line_loop
525 :
526 : ! We might want to fixup the initials, adding a dot after each of them
527 :
528 : END FUNCTION get_next_author
529 :
530 : ! **************************************************************************************************
531 : !> \brief ...
532 : !> \param ISI_record ...
533 : !> \param iline_start ...
534 : !> \return ...
535 : ! **************************************************************************************************
536 154621 : FUNCTION get_next_title(ISI_record, iline_start) RESULT(res)
537 : CHARACTER(LEN=ISI_length), DIMENSION(:), &
538 : INTENT(IN) :: ISI_record
539 : INTEGER, INTENT(INOUT) :: iline_start
540 : CHARACTER(LEN=ISI_length) :: res
541 :
542 : INTEGER :: I, N
543 : LOGICAL :: in_ti_section
544 :
545 154621 : res = ""
546 :
547 154621 : in_ti_section = .FALSE.
548 154621 : N = SIZE(ISI_record, 1)
549 154621 : IF (iline_start > N) RETURN
550 2050774 : line_loop: DO I = 1, N
551 1993930 : IF (ISI_record(I) (1:3) == "TI ") in_ti_section = .TRUE.
552 1993930 : IF (in_ti_section .AND. (ISI_record(I) (1:3) /= "TI " .AND. ISI_record(I) (1:3) /= " ")) in_ti_section = .FALSE.
553 1993930 : IF (in_ti_section) THEN
554 241560 : IF (I >= iline_start) THEN
555 97777 : iline_start = I + 1
556 97777 : res = ISI_record(I) (4:)
557 97777 : EXIT line_loop
558 : END IF
559 : END IF
560 : END DO line_loop
561 :
562 : END FUNCTION get_next_title
563 :
564 : ! **************************************************************************************************
565 : !> \brief ...
566 : !> \param ISI_record ...
567 : !> \return ...
568 : ! **************************************************************************************************
569 56844 : PURE FUNCTION get_source(ISI_record) RESULT(res)
570 : CHARACTER(LEN=ISI_length), DIMENSION(:), &
571 : INTENT(IN) :: ISI_record
572 : CHARACTER(LEN=4*ISI_length) :: res
573 :
574 : INTEGER :: I, J, N
575 :
576 56844 : N = SIZE(ISI_record, 1)
577 56844 : res = ""
578 622661 : DO I = 1, N
579 622661 : IF (ISI_record(I) (1:3) == "SO ") THEN
580 56676 : res = ISI_record(I) (4:)
581 56681 : DO J = I + 1, N
582 56681 : IF (ISI_record(J) (1:3) == " ") THEN
583 5 : res = TRIM(res)//" "//ISI_record(J) (4:)
584 : ELSE
585 : EXIT
586 : END IF
587 : END DO
588 : EXIT
589 : END IF
590 : END DO
591 56844 : END FUNCTION get_source
592 :
593 : ! **************************************************************************************************
594 : !> \brief ...
595 : !> \param ISI_record ...
596 : !> \return ...
597 : ! **************************************************************************************************
598 3372170 : PURE FUNCTION get_year(ISI_record) RESULT(res)
599 : CHARACTER(LEN=ISI_length), DIMENSION(:), &
600 : INTENT(IN) :: ISI_record
601 : CHARACTER(LEN=ISI_length) :: res
602 :
603 : INTEGER :: I, N
604 :
605 3372170 : N = SIZE(ISI_record, 1)
606 3372170 : res = ""
607 59052544 : DO I = 1, N
608 59052544 : IF (ISI_record(I) (1:3) == "PY ") res = ISI_record(I) (4:)
609 : END DO
610 3372170 : END FUNCTION get_year
611 :
612 : ! **************************************************************************************************
613 : !> \brief ...
614 : !> \param ISI_record ...
615 : !> \return ...
616 : ! **************************************************************************************************
617 1152090 : PURE FUNCTION get_month(ISI_record) RESULT(res)
618 : CHARACTER(LEN=ISI_length), DIMENSION(:), &
619 : INTENT(IN) :: ISI_record
620 : CHARACTER(LEN=ISI_length) :: res
621 :
622 : INTEGER :: I, N
623 :
624 1152090 : N = SIZE(ISI_record, 1)
625 1152090 : res = ""
626 20062890 : DO I = 1, N
627 20062890 : IF (ISI_record(I) (1:3) == "PD ") res = ISI_record(I) (4:6)
628 : END DO
629 1152090 : END FUNCTION get_month
630 :
631 : ! **************************************************************************************************
632 : !> \brief ...
633 : !> \param ISI_record ...
634 : !> \return ...
635 : ! **************************************************************************************************
636 1152090 : PURE FUNCTION get_day(ISI_record) RESULT(res)
637 : CHARACTER(LEN=ISI_length), DIMENSION(:), &
638 : INTENT(IN) :: ISI_record
639 : CHARACTER(LEN=ISI_length) :: res
640 :
641 : INTEGER :: D, I, N
642 :
643 1152090 : N = SIZE(ISI_record, 1)
644 1152090 : res = ""
645 20062890 : DO I = 1, N
646 20062890 : IF (ISI_record(I) (1:3) == "PD ") res = ISI_record(I) (7:)
647 : END DO
648 : ! PD can be e.g. OCT-NOV or OCT or OCT 27
649 : ! if res can't be read as an integer, it is not a day, and we bail out
650 1152090 : READ (res, *, ERR=998, END=998) D
651 : ! if the day is not in the expected range, we assume it is a parse error
652 459000 : IF (D < 0 .OR. D > 31) res = ""
653 459000 : RETURN
654 : 998 CONTINUE
655 693090 : res = ""
656 : END FUNCTION get_day
657 :
658 : ! **************************************************************************************************
659 : !> \brief ...
660 : !> \param ISI_record ...
661 : !> \return ...
662 : ! **************************************************************************************************
663 108722 : PURE FUNCTION get_volume(ISI_record) RESULT(res)
664 : CHARACTER(LEN=ISI_length), DIMENSION(:), &
665 : INTENT(IN) :: ISI_record
666 : CHARACTER(LEN=ISI_length) :: res
667 :
668 : INTEGER :: I, N
669 :
670 108722 : N = SIZE(ISI_record, 1)
671 108722 : res = ""
672 2212648 : DO I = 1, N
673 2212648 : IF (ISI_record(I) (1:3) == "VL ") res = ISI_record(I) (4:)
674 : END DO
675 108722 : END FUNCTION get_volume
676 :
677 : ! **************************************************************************************************
678 : !> \brief ...
679 : !> \param ISI_record ...
680 : !> \return ...
681 : ! **************************************************************************************************
682 98099 : PURE FUNCTION get_issue(ISI_record) RESULT(res)
683 : CHARACTER(LEN=ISI_length), DIMENSION(:), &
684 : INTENT(IN) :: ISI_record
685 : CHARACTER(LEN=ISI_length) :: res
686 :
687 : INTEGER :: I, N
688 :
689 98099 : N = SIZE(ISI_record, 1)
690 98099 : res = ""
691 2020964 : DO I = 1, N
692 2020964 : IF (ISI_record(I) (1:3) == "IS ") res = ISI_record(I) (4:)
693 : END DO
694 98099 : END FUNCTION get_issue
695 :
696 : ! **************************************************************************************************
697 : !> \brief ...
698 : !> \param ISI_record ...
699 : !> \return ...
700 : ! **************************************************************************************************
701 56844 : PURE FUNCTION get_pages(ISI_record) RESULT(res)
702 : CHARACTER(LEN=ISI_length), DIMENSION(:), &
703 : INTENT(IN) :: ISI_record
704 : CHARACTER(LEN=ISI_length) :: res
705 :
706 : CHARACTER(LEN=ISI_length) :: ar, bp, ep
707 : INTEGER :: I, N
708 :
709 56844 : N = SIZE(ISI_record, 1)
710 56844 : res = ""
711 56844 : bp = ""
712 56844 : ep = ""
713 56844 : ar = ""
714 :
715 1154111 : DO I = 1, N
716 1097267 : IF (ISI_record(I) (1:3) == "BP ") bp = ISI_record(I) (4:)
717 1097267 : IF (ISI_record(I) (1:3) == "EP ") ep = ISI_record(I) (4:)
718 1154111 : IF (ISI_record(I) (1:3) == "AR ") ar = ISI_record(I) (4:)
719 : END DO
720 56844 : IF (bp .NE. "") THEN
721 44172 : res = bp
722 44172 : IF (ep .NE. "") res = TRIM(res)//"-"//ep
723 : END IF
724 56844 : IF (res .EQ. "" .AND. ar .NE. "") res = ar
725 56844 : END FUNCTION get_pages
726 :
727 : ! **************************************************************************************************
728 : !> \brief ...
729 : !> \param key ...
730 : !> \return ...
731 : ! **************************************************************************************************
732 0 : PURE FUNCTION get_citation_key(key) RESULT(res)
733 : INTEGER, INTENT(IN) :: key
734 : CHARACTER(LEN=default_string_length) :: res
735 :
736 0 : res = thebib(key)%ref%citation_key
737 0 : END FUNCTION get_citation_key
738 :
739 : !
740 : ! This returns something epoch like, but can only be used to order the records
741 : ! missing years, months, days are implied zero(1900)
742 : !
743 : ! **************************************************************************************************
744 : !> \brief ...
745 : !> \param ISI_record ...
746 : !> \return ...
747 : ! **************************************************************************************************
748 1152090 : PURE FUNCTION get_epoch(ISI_record) RESULT(res)
749 : CHARACTER(LEN=ISI_length), DIMENSION(:), &
750 : INTENT(IN) :: ISI_record
751 : INTEGER :: res
752 :
753 : CHARACTER(LEN=ISI_length) :: tmp
754 : INTEGER :: day, istat, month, year
755 :
756 : ! read year
757 :
758 1152090 : tmp = get_year(ISI_record)
759 1152090 : READ (tmp, *, IOSTAT=istat) year
760 1152090 : IF (istat .NE. 0) year = 1900
761 :
762 : ! read day
763 1152090 : tmp = get_day(ISI_record)
764 1152090 : READ (tmp, *, IOSTAT=istat) day
765 1152090 : IF (istat .NE. 0) day = 0
766 :
767 : ! read month
768 1152090 : tmp = get_month(ISI_record)
769 : SELECT CASE (tmp)
770 : CASE ("JAN")
771 100980 : month = 1
772 : CASE ("FEB")
773 100980 : month = 2
774 : CASE ("MAR")
775 36720 : month = 3
776 : CASE ("APR")
777 55080 : month = 4
778 : CASE ("MAY")
779 45900 : month = 5
780 : CASE ("JUN")
781 50490 : month = 6
782 : CASE ("JUL")
783 50490 : month = 7
784 : CASE ("AUG")
785 50490 : month = 8
786 : CASE ("SEP")
787 78030 : month = 9
788 : CASE ("OCT")
789 59670 : month = 10
790 : CASE ("NOV")
791 59670 : month = 11
792 : CASE ("DEC")
793 27540 : month = 12
794 : CASE DEFAULT
795 1152090 : month = 0
796 : END SELECT
797 :
798 1152090 : res = day + 31*month + 12*31*(year - 1900)
799 :
800 1152090 : END FUNCTION get_epoch
801 :
802 0 : END MODULE reference_manager
|
