Branch data Line data Source code
1 : : !!****m* ABINIT/flib_pwscf
2 : : !! NAME
3 : : !! flib_pwscf
4 : : !!
5 : : !! FUNCTION
6 : : !! the following is a partial import of the flib directory of espresso
7 : : !! provides small routines for other pwscf-imported subroutines
8 : : !!
9 : : !! COPYRIGHT
10 : : ! Copyright (C) 2001-2004 Carlo Cavazzoni and PWSCF group
11 : : !! Copyright (C) 2008-2026 ABINIT group (MVer)
12 : : !! This file is distributed under the terms of the
13 : : !! GNU General Public License, see ~abinit/COPYING
14 : : !! or http://www.gnu.org/copyleft/gpl.txt .
15 : : !!
16 : : !! SOURCE
17 : :
18 : : #if defined HAVE_CONFIG_H
19 : : #include "config.h"
20 : : #endif
21 : :
22 : : module flib_pwscf
23 : :
24 : : implicit none
25 : :
26 : : contains
27 : : !!***
28 : :
29 : : !!****f* flib_pwscf/matches
30 : : !!
31 : : !! NAME
32 : : !! matches
33 : : !!
34 : : !! FUNCTION
35 : : !! .TRUE. if string1 is contained in string2, .FALSE. otherwise
36 : : !!
37 : : !! INPUTS
38 : : !!
39 : : !! OUTPUT
40 : : !!
41 : : !! SOURCE
42 : : !-----------------------------------------------------------------------
43 : 8824 : FUNCTION matches( string1, string2 )
44 : : !-----------------------------------------------------------------------
45 : : !IMPLICIT NONE
46 : : !
47 : : CHARACTER (LEN=*), INTENT(IN) :: string1, string2
48 : : LOGICAL :: matches
49 : : INTEGER :: len1, len2, l
50 : : !
51 : : !
52 : 8824 : len1 = LEN_TRIM( string1 )
53 : 8824 : len2 = LEN_TRIM( string2 )
54 : : !
55 [ + + ]: 67240 : DO l = 1, ( len2 - len1 + 1 )
56 : : !
57 [ + + ]: 67240 : IF ( string1(1:len1) == string2(l:(l+len1-1)) ) THEN
58 : : !
59 : : matches = .TRUE.
60 : : !
61 : : RETURN
62 : : !
63 : : END IF
64 : : !
65 : : END DO
66 : : !
67 : : matches = .FALSE.
68 : : !
69 : : RETURN
70 : : !
71 : : END FUNCTION matches
72 : : !!***
73 : :
74 : : !!****f* flib_pwscf/capital
75 : : !!
76 : : !! NAME
77 : : !! capital
78 : : !!
79 : : !! FUNCTION
80 : : !! converts character to capital if lowercase
81 : : !! copy character to output in all other cases
82 : : !!
83 : : !! INPUTS
84 : : !!
85 : : !! OUTPUT
86 : : !!
87 : : !! SOURCE
88 : : !-----------------------------------------------------------------------
89 : 40 : FUNCTION capital( in_char )
90 : : !-----------------------------------------------------------------------
91 : : !IMPLICIT NONE
92 : : !
93 : : CHARACTER(LEN=1), INTENT(IN) :: in_char
94 : : CHARACTER(LEN=1) :: capital
95 : : CHARACTER(LEN=26), PARAMETER :: lower = 'abcdefghijklmnopqrstuvwxyz', &
96 : : upper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
97 : : INTEGER :: i
98 : : !
99 : : !
100 [ + + ]: 1080 : DO i=1, 26
101 : : !
102 [ - + ]: 1080 : IF ( in_char == lower(i:i) ) THEN
103 : : !
104 : 0 : capital = upper(i:i)
105 : : !
106 : 0 : RETURN
107 : : !
108 : : END IF
109 : : !
110 : : END DO
111 : : !
112 : 40 : capital = in_char
113 : : !
114 : 40 : RETURN
115 : : !
116 : : END FUNCTION capital
117 : : !!***
118 : :
119 : : !!****f* flib_pwscf/lowercase
120 : : !!
121 : : !! NAME
122 : : !! lowercase
123 : : !!
124 : : !! FUNCTION
125 : : !! converts character to lowercase if capital
126 : : !! copy character to output in all other cases
127 : : !!
128 : : !! INPUTS
129 : : !!
130 : : !! OUTPUT
131 : : !!
132 : : !! SOURCE
133 : : !
134 : : !-----------------------------------------------------------------------
135 : 0 : FUNCTION lowercase( in_char )
136 : : !-----------------------------------------------------------------------
137 : : !IMPLICIT NONE
138 : : !
139 : : CHARACTER(LEN=1), INTENT(IN) :: in_char
140 : : CHARACTER(LEN=1) :: lowercase
141 : : CHARACTER(LEN=26), PARAMETER :: lower = 'abcdefghijklmnopqrstuvwxyz', &
142 : : upper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
143 : : INTEGER :: i
144 : : !
145 : : !
146 [ # # ]: 0 : DO i=1, 26
147 : : !
148 [ # # ]: 0 : IF ( in_char == upper(i:i) ) THEN
149 : : !
150 : 0 : lowercase = lower(i:i)
151 : : !
152 : 0 : RETURN
153 : : !
154 : : END IF
155 : : !
156 : : END DO
157 : : !
158 : 0 : lowercase = in_char
159 : : !
160 : 0 : RETURN
161 : : !
162 : : END FUNCTION lowercase
163 : : !!***
164 : :
165 : : !!****f* flib_pwscf/errore
166 : : !!
167 : : !! NAME
168 : : !! errore
169 : : !!
170 : : !! FUNCTION
171 : : !!
172 : : !! INPUTS
173 : : !!
174 : : !! OUTPUT
175 : : !!
176 : : !! SOURCE
177 : :
178 : 8 : subroutine errore (routine, error, code)
179 : :
180 : : use defs_basis, only: std_out,std_out_default
181 : : !implicit none
182 : :
183 : : !args
184 : : character(*), intent(in) :: routine
185 : : character(*), intent(in) :: error
186 : : integer, intent(in) :: code
187 : :
188 [ + - ]: 8 : if (code == 0) return
189 : :
190 : 0 : write(std_out,*) ' in subroutine : ', trim(routine)
191 : 0 : write(std_out,*) error
192 : 0 : write(std_out,*) 'error code ', code
193 : 0 : stop
194 : : end subroutine errore
195 : :
196 : : end module flib_pwscf
197 : : !!***
|
