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 : !!***
|
