Branch data Line data Source code
1 : : !
2 : : ! Copyright (C) 2020 Quantum ESPRESSO Foundation
3 : : ! This file is distributed under the terms of the
4 : : ! GNU General Public License. See the file `License'
5 : : ! in the root directory of the present distribution,
6 : : ! or http://www.gnu.org/copyleft/gpl.txt .
7 : : !
8 : :
9 : : #if defined HAVE_CONFIG_H
10 : : #include "config.h"
11 : : #endif
12 : :
13 : : #include "abi_common.h"
14 : :
15 : : MODULE upf_utils
16 : : !
17 : : IMPLICIT NONE
18 : : PRIVATE
19 : :
20 : : PUBLIC :: capital, lowercase, isnumeric, matches, version_compare
21 : :
22 : : ! ... FUNCTION capital : converts a lowercase letter to uppercase
23 : : ! returns input character if not a lowercase letter
24 : : ! ... FUNCTION lowercase : as above, in reverse
25 : : ! ... FUNCTION isnumeric : returns .true. if input character is a digit
26 : : !
27 : : ! ... FUNCTION matches : returns .true. if string1 matches string2
28 : : !
29 : : ! ... FUNCTION version_compare: Compare two version strings; the result can be
30 : : ! "newer", "equal", "older", ""
31 : : !
32 : : CHARACTER(LEN=26), PARAMETER :: lower = 'abcdefghijklmnopqrstuvwxyz', &
33 : : upper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
34 : :
35 : : CONTAINS
36 : :
37 : : !-----------------------------------------------------------------------
38 : 1520 : FUNCTION capital( in_char )
39 : : !-----------------------------------------------------------------------
40 : : !
41 : : ! ... converts character to capital if lowercase
42 : : ! ... copy character to output in all other cases
43 : : !
44 : : !IMPLICIT NONE
45 : : !
46 : : CHARACTER(LEN=1), INTENT(IN) :: in_char
47 : : CHARACTER(LEN=1) :: capital
48 : : INTEGER :: i
49 : : !
50 [ + + ]: 21424 : DO i=1, 26
51 [ + + ]: 21424 : IF ( in_char == lower(i:i) ) THEN
52 : 1328 : capital = upper(i:i)
53 : 1328 : RETURN
54 : : END IF
55 : : END DO
56 : 192 : capital = in_char
57 : : !
58 : : END FUNCTION capital
59 : : !
60 : : !-----------------------------------------------------------------------
61 : 0 : FUNCTION lowercase( in_char )
62 : : !-----------------------------------------------------------------------
63 : : !
64 : : ! ... converts character to lowercase if capital
65 : : ! ... copy character to output in all other cases
66 : : !
67 : : !IMPLICIT NONE
68 : : !
69 : : CHARACTER(LEN=1), INTENT(IN) :: in_char
70 : : CHARACTER(LEN=1) :: lowercase
71 : : INTEGER :: i
72 : : !
73 [ # # ]: 0 : DO i=1, 26
74 [ # # ]: 0 : IF ( in_char == upper(i:i) ) THEN
75 : 0 : lowercase = lower(i:i)
76 : 0 : RETURN
77 : : END IF
78 : : END DO
79 : 0 : lowercase = in_char
80 : : !
81 : : END FUNCTION lowercase
82 : : !
83 : : !-----------------------------------------------------------------------
84 : 0 : LOGICAL FUNCTION isnumeric ( in_char )
85 : : !-----------------------------------------------------------------------
86 : : !
87 : : ! ... check if a character is a number
88 : : !
89 : : !IMPLICIT NONE
90 : : !
91 : : CHARACTER(LEN=1), INTENT(IN) :: in_char
92 : : CHARACTER(LEN=10), PARAMETER :: numbers = '0123456789'
93 : : INTEGER :: i
94 : : !
95 [ # # ]: 0 : DO i=1, 10
96 : 0 : isnumeric = ( in_char == numbers(i:i) )
97 [ # # ]: 0 : IF ( isnumeric ) RETURN
98 : : END DO
99 : : !
100 : : END FUNCTION isnumeric
101 : : !
102 : : !-----------------------------------------------------------------------
103 : 0 : FUNCTION matches( string1, string2 )
104 : : !-----------------------------------------------------------------------
105 : : !
106 : : ! ... .TRUE. if string1 is contained in string2, .FALSE. otherwise
107 : : !
108 : : !IMPLICIT NONE
109 : : !
110 : : CHARACTER (LEN=*), INTENT(IN) :: string1, string2
111 : : LOGICAL :: matches
112 : : INTEGER :: len1, len2, l
113 : : !
114 : : !
115 : 0 : len1 = LEN_TRIM( string1 )
116 : 0 : len2 = LEN_TRIM( string2 )
117 : : !
118 [ # # ]: 0 : DO l = 1, ( len2 - len1 + 1 )
119 [ # # ]: 0 : IF ( string1(1:len1) == string2(l:(l+len1-1)) ) THEN
120 : : matches = .TRUE.
121 : : RETURN
122 : : END IF
123 : : END DO
124 : : matches = .FALSE.
125 : : !
126 : : END FUNCTION matches
127 : : !
128 : : !--------------------------------------------------------------------------
129 : 0 : SUBROUTINE version_parse(str, major, minor, patch, ierr)
130 : : !--------------------------------------------------------------------------
131 : : !
132 : : ! Determine the major, minor and patch numbers from
133 : : ! a version string with the fmt "i.j.k"
134 : : !
135 : : ! The ierr variable assumes the following values
136 : : !
137 : : ! ierr < 0 emtpy string
138 : : ! ierr = 0 no problem
139 : : ! ierr > 0 fatal error
140 : : !
141 : : !IMPLICIT NONE
142 : : CHARACTER(*), INTENT(in) :: str
143 : : INTEGER, INTENT(out) :: major, minor, patch, ierr
144 : : !
145 : : INTEGER :: i1, i2, length
146 : : INTEGER :: ierrtot
147 : : CHARACTER(10) :: num(3)
148 : :
149 : : !
150 : 0 : major = 0
151 : 0 : minor = 0
152 : 0 : patch = 0
153 : :
154 : 0 : length = LEN_TRIM( str )
155 : : !
156 [ # # ]: 0 : IF ( length == 0 ) THEN
157 : : !
158 : 0 : ierr = -1
159 : 0 : RETURN
160 : : !
161 : : ENDIF
162 : :
163 : 0 : i1 = SCAN( str, ".")
164 : 0 : i2 = SCAN( str, ".", BACK=.TRUE.)
165 : : !
166 [ # # # # ]: 0 : IF ( i1 == 0 .OR. i2 == 0 .OR. i1 == i2 ) THEN
167 : : !
168 : 0 : ierr = 1
169 : 0 : RETURN
170 : : !
171 : : ENDIF
172 : : !
173 [ # # ]: 0 : num(1) = str( 1 : i1-1 )
174 [ # # ]: 0 : num(2) = str( i1+1 : i2-1 )
175 [ # # ]: 0 : num(3) = str( i2+1 : )
176 : : !
177 : 0 : ierrtot = 0
178 : : !
179 : 0 : READ( num(1), *, IOSTAT=ierr ) major
180 [ # # ]: 0 : IF (ierr/=0) RETURN
181 : : !
182 : 0 : READ( num(2), *, IOSTAT=ierr ) minor
183 [ # # ]: 0 : IF (ierr/=0) RETURN
184 : : !
185 : 0 : READ( num(3), *, IOSTAT=ierr ) patch
186 [ # # ]: 0 : IF (ierr/=0) RETURN
187 : : !
188 : : END SUBROUTINE version_parse
189 : : !
190 : : !--------------------------------------------------------------------------
191 : 0 : FUNCTION version_compare(str1, str2)
192 : : !--------------------------------------------------------------------------
193 : : !
194 : : ! Compare two version strings; the result is
195 : : !
196 : : ! "newer": str1 is newer that str2
197 : : ! "equal": str1 is equal to str2
198 : : ! "older": str1 is older than str2
199 : : ! " ": str1 or str2 has a wrong format
200 : : !
201 : : !IMPLICIT NONE
202 : : CHARACTER(*) :: str1, str2
203 : : CHARACTER(10) :: version_compare
204 : : !
205 : : INTEGER :: version1(3), version2(3)
206 : : INTEGER :: basis, icheck1, icheck2
207 : : INTEGER :: ierr
208 : : !
209 : :
210 : 0 : version_compare = " "
211 : : !
212 : 0 : CALL version_parse( str1, version1(1), version1(2), version1(3), ierr)
213 [ # # ]: 0 : IF ( ierr/=0 ) RETURN
214 : : !
215 : 0 : CALL version_parse( str2, version2(1), version2(2), version2(3), ierr)
216 [ # # ]: 0 : IF ( ierr/=0 ) RETURN
217 : : !
218 : : !
219 : 0 : basis = 1000
220 : : !
221 : 0 : icheck1 = version1(1) * basis**2 + version1(2)* basis + version1(3)
222 : 0 : icheck2 = version2(1) * basis**2 + version2(2)* basis + version2(3)
223 : : !
224 [ # # ]: 0 : IF ( icheck1 > icheck2 ) THEN
225 : : !
226 : 0 : version_compare = 'newer'
227 : : !
228 [ # # ]: 0 : ELSEIF( icheck1 == icheck2 ) THEN
229 : : !
230 : 0 : version_compare = 'equal'
231 : : !
232 : : ELSE
233 : : !
234 : 0 : version_compare = 'older'
235 : : !
236 : : ENDIF
237 : : !
238 : : END FUNCTION version_compare
239 : :
240 : : END MODULE upf_utils
|
