1!--------------------------------------------------------------------------------------------------!
2! Copyright (C) by the DBCSR developers group - All rights reserved                                !
3! This file is part of the DBCSR library.                                                          !
4!                                                                                                  !
5! For information on the license, see the LICENSE file.                                            !
6! For further information please visit https://dbcsr.cp2k.org                                      !
7! SPDX-License-Identifier: GPL-2.0+                                                                !
8!--------------------------------------------------------------------------------------------------!
9
10MODULE dbcsr_string_utilities
11   !! Utilities for string manipulations
12
13   USE dbcsr_kinds, ONLY: default_blank_character
14
15   IMPLICIT NONE
16
17   PRIVATE
18
19   PUBLIC :: ascii_to_string, &
20             compress, &
21             integer_to_string, &
22             is_whitespace, &
23             remove_word, &
24             str_comp, &
25             string_to_ascii, &
26             uppercase, &
27             xstring
28
29CONTAINS
30
31   SUBROUTINE ascii_to_string(nascii, string)
32      !! Convert a sequence of integer numbers (ASCII code) to a string.
33      !! Blanks are inserted for invalid ASCII code numbers.
34
35      INTEGER, DIMENSION(:), INTENT(IN)                  :: nascii
36      CHARACTER(LEN=*), INTENT(OUT)                      :: string
37
38      INTEGER                                            :: i
39
40      string = ""
41
42      DO i = 1, MIN(LEN(string), SIZE(nascii))
43         IF ((nascii(i) >= 0) .AND. (nascii(i) <= 127)) THEN
44            string(i:i) = CHAR(nascii(i))
45         ELSE
46            string(i:i) = " "
47         END IF
48      END DO
49
50   END SUBROUTINE ascii_to_string
51
52   SUBROUTINE compress(string, full)
53      !! Eliminate multiple space characters in a string.
54      !! If full is .TRUE., then all spaces are eliminated.
55
56      CHARACTER(LEN=*), INTENT(INOUT)                    :: string
57      LOGICAL, INTENT(IN), OPTIONAL                      :: full
58
59      CHARACTER                                          :: tmp
60      INTEGER                                            :: i, z
61      LOGICAL                                            :: remove_all
62
63      IF (PRESENT(full)) THEN
64         remove_all = full
65      ELSE
66         remove_all = .FALSE.
67      END IF
68
69      z = 1
70
71      DO i = 1, LEN_TRIM(string)
72         IF ((z == 1) .OR. remove_all) THEN
73            IF (string(i:i) /= " ") THEN
74               tmp = string(i:i)
75               string(z:z) = tmp
76               z = z + 1
77            END IF
78         ELSE
79            IF ((string(i:i) /= " ") .OR. (string(z - 1:z - 1) /= " ")) THEN
80               tmp = string(i:i)
81               string(z:z) = tmp
82               z = z + 1
83            END IF
84         END IF
85      END DO
86
87      string(z:) = ""
88
89   END SUBROUTINE compress
90
91   SUBROUTINE integer_to_string(inumber, string)
92      !! Converts an integer number to a string.
93      !! The WRITE statement will return an error message, if the number of
94      !! digits of the integer number is larger the than the length of the
95      !! supplied string.
96
97      INTEGER, INTENT(IN)                                :: inumber
98      CHARACTER(LEN=*), INTENT(OUT)                      :: string
99
100      WRITE (UNIT=string, FMT='(I0)') inumber
101   END SUBROUTINE integer_to_string
102
103   SUBROUTINE string_to_ascii(string, nascii)
104      !! Convert a string to sequence of integer numbers.
105
106      CHARACTER(LEN=*), INTENT(IN)                       :: string
107      INTEGER, DIMENSION(:), INTENT(OUT)                 :: nascii
108
109      INTEGER                                            :: i
110
111      nascii(:) = 0
112
113      DO i = 1, MIN(LEN(string), SIZE(nascii))
114         nascii(i) = ICHAR(string(i:i))
115      END DO
116
117   END SUBROUTINE string_to_ascii
118
119   SUBROUTINE remove_word(string)
120      !! remove a word from a string (words are separated by white spaces)
121      CHARACTER(LEN=*), INTENT(INOUT)                    :: string
122
123      INTEGER                                            :: i
124
125      i = 1
126      ! possibly clean white spaces
127      DO WHILE (string(i:i) == " ")
128         i = i + 1
129      END DO
130      ! now remove the word
131      DO WHILE (string(i:i) /= " ")
132         i = i + 1
133      END DO
134      string = string(i:)
135
136   END SUBROUTINE remove_word
137
138   SUBROUTINE uppercase(string)
139      !! Convert all lower case characters in a string to upper case.
140      CHARACTER(LEN=*), INTENT(INOUT)                    :: string
141
142      INTEGER                                            :: i, iascii
143
144      DO i = 1, LEN_TRIM(string)
145         iascii = ICHAR(string(i:i))
146         IF ((iascii >= 97) .AND. (iascii <= 122)) THEN
147            string(i:i) = CHAR(iascii - 32)
148         END IF
149      END DO
150
151   END SUBROUTINE uppercase
152
153   SUBROUTINE xstring(string, ia, ib)
154
155      CHARACTER(LEN=*), INTENT(IN)                       :: string
156      INTEGER, INTENT(OUT)                               :: ia, ib
157
158      ia = 1
159      ib = LEN_TRIM(string)
160      IF (ib > 0) THEN
161         DO WHILE (string(ia:ia) == ' ')
162            ia = ia + 1
163         END DO
164      END IF
165
166   END SUBROUTINE xstring
167
168   FUNCTION str_comp(str1, str2) RESULT(equal)
169
170      CHARACTER(LEN=*), INTENT(IN)                       :: str1, str2
171      LOGICAL                                            :: equal
172
173      INTEGER                                            :: i1, i2, j1, j2
174
175      i1 = 0
176      i2 = 0
177      j1 = 0
178      j2 = 0
179      CALL xstring(str1, i1, i2)
180      CALL xstring(str2, j1, j2)
181      equal = (str1(i1:i2) == str2(j1:j2))
182   END FUNCTION str_comp
183
184   FUNCTION is_whitespace(testchar) RESULT(resval)
185      !! returns .true. if the character passed is a whitespace char.
186      CHARACTER(LEN=1), INTENT(IN)                       :: testchar
187      LOGICAL                                            :: resval
188
189      resval = .FALSE.
190      IF (ANY(default_blank_character == testchar)) resval = .TRUE.
191   END FUNCTION is_whitespace
192
193END MODULE dbcsr_string_utilities
194