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
|
