Branch data Line data Source code
1 : : !
2 : : ! Copyright (C) 2001-2002 PWSCF group
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 : : ! MJV 18/6/2009: imported into abinit
9 : : ! commented program part
10 : : ! added small module for flib utilities
11 : : !
12 : :
13 : : #if defined HAVE_CONFIG_H
14 : : #include "config.h"
15 : : #endif
16 : :
17 : : module m_read_upf_pwscf
18 : :
19 : : private
20 : : public :: read_pseudo
21 : :
22 : : contains
23 : :
24 : : !---------------------------------------------------------------------
25 : : !program read_ps
26 : : ! !---------------------------------------------------------------------
27 : : ! !
28 : : ! ! Read pseudopotentials in the Unified Pseudopotential Format (UPF)
29 : : ! !
30 : : ! implicit none
31 : : ! integer :: is, ios, iunps = 4
32 : : ! character (len=256) :: filein
33 : : ! !
34 : : ! is = 0
35 : : !10 print '('' Input PP file # '',i2,'' in UPF format > '',$)', is+1
36 : : ! read (5, '(a)', end = 20, err = 20) filein
37 : : ! open(unit=iunps,file=filein,status='old',form='formatted',iostat=ios)
38 : : ! if (ios.ne.0) stop
39 : : ! is = is + 1
40 : : ! call read_pseudo(is, iunps)
41 : : ! close (unit=iunps)
42 : : ! go to 10
43 : : !20 stop
44 : : !end program read_ps
45 : : !
46 : : !---------------------------------------------------------------------
47 : 2 : subroutine read_pseudo (is, iunps)
48 : : !---------------------------------------------------------------------
49 : : !
50 : : ! Read pseudopotential in the Unified Pseudopotential Format (UPF)
51 : : !
52 : : use defs_basis, only : std_out,std_out_default
53 : : use flib_pwscf
54 : : use pseudo_pwscf
55 : : implicit none
56 : : !
57 : : integer :: is, iunps
58 : : ! is : index of this pseudopotential
59 : : ! iunps: unit connected with pseudopotential file
60 : : !
61 [ - + ]: 2 : if (is < 0 .or. is > npsx ) then
62 : 0 : call errore ('read_pseudo', 'Wrong is number', 1)
63 : : end if
64 : 2 : write(std_out,* ) " Reading pseudopotential file in UPF format..."
65 : : !------->Search for Header
66 : 2 : call scan_begin (iunps, "HEADER", .true.)
67 : 2 : call read_pseudo_header (is, iunps)
68 : 2 : call scan_end (iunps, "HEADER")
69 : :
70 : : !-------->Search for mesh information
71 : 2 : call scan_begin (iunps, "MESH", .true.)
72 : 2 : call read_pseudo_mesh (is, iunps)
73 : 2 : call scan_end (iunps, "MESH")
74 : : !-------->If present, search for nlcc
75 [ + - ]: 2 : if (nlcc (is) ) then
76 : 2 : call scan_begin (iunps, "NLCC", .true.)
77 : 2 : call read_pseudo_nlcc (is, iunps)
78 : 2 : call scan_end (iunps, "NLCC")
79 : : endif
80 : : !-------->Search for Local potential
81 : 2 : call scan_begin (iunps, "LOCAL", .true.)
82 : 2 : call read_pseudo_local (is, iunps)
83 : 2 : call scan_end (iunps, "LOCAL")
84 : : !-------->Search for Nonlocal potential
85 : 2 : call scan_begin (iunps, "NONLOCAL", .true.)
86 : 2 : call read_pseudo_nl (is, iunps)
87 : 2 : call scan_end (iunps, "NONLOCAL")
88 : : !-------->Search for atomic wavefunctions
89 : 2 : call scan_begin (iunps, "PSWFC", .true.)
90 : 2 : call read_pseudo_pswfc (is, iunps)
91 : 2 : call scan_end (iunps, "PSWFC")
92 : : !-------->Search for atomic charge
93 : 2 : call scan_begin (iunps, "RHOATOM", .true.)
94 : 2 : call read_pseudo_rhoatom (is, iunps)
95 : 2 : call scan_end (iunps, "RHOATOM")
96 : : !
97 : 2 : write(std_out,* ) " ...done"
98 : 2 : return
99 : : end subroutine read_pseudo
100 : : !---------------------------------------------------------------------
101 : :
102 : 26 : subroutine scan_begin (iunps, string, rew)
103 : : !---------------------------------------------------------------------
104 : : !
105 : : use flib_pwscf
106 : : use pseudo_pwscf
107 : : implicit none
108 : : ! Unit of the input file
109 : : integer :: iunps
110 : : ! Label to be matched
111 : : character (len=*) :: string
112 : : logical :: rew
113 : : ! Flag: if .true. rewind the file
114 : : character (len=80) :: rstring
115 : : ! String read from file
116 : : integer :: ios
117 : :
118 : 26 : ios = 0
119 [ + + ]: 26 : if (rew) rewind (iunps)
120 [ + - ]: 8690 : do while (ios.eq.0)
121 [ + - ]: 8690 : read (iunps, *, iostat = ios, err = 300) rstring
122 [ + + ]: 8690 : if (matches ("<PP_"//string//">", rstring) ) return
123 : : enddo
124 : 0 : 300 call errore ('scan_begin', 'No '//string//' block', abs (ios) )
125 : :
126 : : end subroutine scan_begin
127 : : !---------------------------------------------------------------------
128 : :
129 : 26 : subroutine scan_end (iunps, string)
130 : : !---------------------------------------------------------------------
131 : : use flib_pwscf
132 : : use pseudo_pwscf
133 : : implicit none
134 : : ! Unit of the input file
135 : : integer :: iunps
136 : : ! Label to be matched
137 : : character (len=*) :: string
138 : : ! String read from file
139 : : character (len=80) :: rstring
140 : : integer :: ios
141 : :
142 [ + - ]: 26 : read (iunps, '(a)', iostat = ios, err = 300) rstring
143 [ + - ]: 26 : if (matches ("</PP_"//string//">", rstring) ) return
144 : : 300 call errore ('scan_end', &
145 : 0 : 'No '//string//' block end statement, possibly corrupted file', - 1)
146 : : end subroutine scan_end
147 : : !
148 : : !---------------------------------------------------------------------
149 : :
150 : 2 : subroutine read_pseudo_header (is, iunps)
151 : : !---------------------------------------------------------------------
152 : : !
153 : : use flib_pwscf
154 : : use pseudo_pwscf
155 : : implicit none
156 : : !
157 : : integer :: is, iunps
158 : : !
159 : : integer :: nv, ios, nw
160 : : character (len=75) :: dummy
161 : :
162 [ + - ]: 2 : read (iunps, *, err = 100, iostat = ios) nv, dummy
163 [ + - ]: 2 : read (iunps, *, err = 100, iostat = ios) psd (is), dummy
164 [ + - ]: 2 : read (iunps, *, err = 100, iostat = ios) pseudotype
165 [ - + ]: 2 : if (matches (pseudotype, "US") ) isus (is) = .true.
166 [ + - ]: 2 : read (iunps, *, err = 100, iostat = ios) nlcc (is), dummy
167 [ + - ]: 2 : read (iunps, '(a20,t24,a)', err = 100, iostat = ios) dft(is), dummy
168 : 2 : read (iunps, * ) zp (is), dummy
169 : 2 : read (iunps, * ) etotps, dummy
170 : 2 : read (iunps, * ) ecutwfc, ecutrho
171 : 2 : read (iunps, * ) lmax (is), dummy
172 [ + - ]: 2 : read (iunps, *, err = 100, iostat = ios) mesh (is), dummy
173 [ + - ]: 2 : read (iunps, *, err = 100, iostat = ios) ntwfc(is), nbeta (is), dummy
174 [ + - ]: 2 : read (iunps, '(a)', err = 100, iostat = ios) dummy
175 [ + + ]: 10 : do nw = 1, ntwfc(is)
176 : 10 : read (iunps, * ) els (nw,is), lchi (nw, is), oc (nw, is)
177 : : enddo
178 : 2 : return
179 : 0 : 100 call errore ('read_pseudo_header', 'Reading pseudo file', abs (ios))
180 : : end subroutine read_pseudo_header
181 : : !
182 : : !---------------------------------------------------------------------
183 : 2 : subroutine read_pseudo_local (is, iunps)
184 : : !---------------------------------------------------------------------
185 : : !
186 : : use flib_pwscf
187 : : use pseudo_pwscf
188 : : implicit none
189 : : !
190 : : integer :: is, iunps
191 : : !
192 : : integer :: ir, ios
193 : : !
194 [ + - ]: 2 : read (iunps, *, err=100, iostat=ios) (vloc0(ir,is) , ir=1,mesh(is))
195 : :
196 : 2 : 100 call errore ('read_pseudo_local','Reading pseudo file', abs(ios) )
197 : :
198 : 2 : return
199 : : end subroutine read_pseudo_local
200 : : !
201 : : !---------------------------------------------------------------------
202 : :
203 : 2 : subroutine read_pseudo_mesh (is, iunps)
204 : : !---------------------------------------------------------------------
205 : : !
206 : : use flib_pwscf
207 : : use pseudo_pwscf
208 : : implicit none
209 : : !
210 : : integer :: is, iunps
211 : : !
212 : : integer :: ir, ios
213 : : !
214 : 2 : call scan_begin (iunps, "R", .false.)
215 [ + - ]: 2 : read (iunps, *, err = 100, iostat = ios) (r(ir,is), ir=1,mesh(is) )
216 : 2 : call scan_end (iunps, "R")
217 : 2 : call scan_begin (iunps, "RAB", .false.)
218 [ + - ]: 2 : read (iunps, *, err = 100, iostat = ios) (rab(ir,is), ir=1,mesh(is) )
219 : 2 : call scan_end (iunps, "RAB")
220 : :
221 : 2 : return
222 : :
223 : 0 : 100 call errore ('read_pseudo_mesh', 'Reading pseudo file', abs (ios) )
224 : : end subroutine read_pseudo_mesh
225 : : !
226 : : !---------------------------------------------------------------------
227 : :
228 : 2 : subroutine read_pseudo_nl (is, iunps)
229 : : !---------------------------------------------------------------------
230 : : !
231 : : use flib_pwscf
232 : : use pseudo_pwscf
233 : : implicit none
234 : : !
235 : : integer :: is, iunps
236 : : !
237 : : integer :: nb, mb, n, ir, nd, ios, idum, ldum, icon, lp, i
238 : : ! counters
239 : : character (len=75) :: dummy
240 : : !
241 [ + + ]: 8 : do nb = 1, nbeta (is)
242 : 6 : call scan_begin (iunps, "BETA", .false.)
243 [ + - ]: 6 : read (iunps, *, err = 100, iostat = ios) idum, lll(nb,is), dummy
244 [ + - ]: 6 : read (iunps, *, err = 100, iostat = ios) ikk2(nb,is)
245 : : read (iunps, *, err = 100, iostat = ios) &
246 [ + - ]: 6 : (betar(ir,nb,is), ir=1,ikk2(nb,is))
247 [ - + ]: 6 : do ir = ikk2(nb,is) + 1, mesh (is)
248 : 6 : betar (ir, nb, is) = 0.d0
249 : : enddo
250 : 8 : call scan_end (iunps, "BETA")
251 : : enddo
252 : :
253 : 2 : call scan_begin (iunps, "DIJ", .false.)
254 [ + - ]: 2 : read (iunps, *, err = 100, iostat = ios) nd, dummy
255 [ + + + + ]: 146 : dion (:,:,is) = 0.d0
256 [ + + ]: 8 : do icon = 1, nd
257 [ + - ]: 6 : read (iunps, *, err = 100, iostat = ios) nb, mb, dion(nb,mb,is)
258 : 8 : dion (mb,nb,is) = dion (nb,mb,is)
259 : : enddo
260 : 2 : call scan_end (iunps, "DIJ")
261 : :
262 [ - + ]: 2 : if (isus (is) ) then
263 : 0 : call scan_begin (iunps, "QIJ", .false.)
264 [ # # ]: 0 : read (iunps, *, err = 100, iostat = ios) nqf(is)
265 : 0 : nqlc (is)= 2 * lmax (is) + 1
266 [ # # ]: 0 : if (nqlc(is).gt.lqmax .or. nqlc(is).lt.0) &
267 : 0 : call errore (' read_pseudo_nl', 'Wrong nqlc', nqlc (is) )
268 [ # # ]: 0 : if (nqf(is).ne.0) then
269 : 0 : call scan_begin (iunps, "RINNER", .false.)
270 : : read (iunps,*,err=100,iostat=ios) &
271 [ # # # # : 0 : (idum,rinner(i,is),i=1,nqlc(is))
# # ]
272 : 0 : call scan_end (iunps, "RINNER")
273 : : end if
274 [ # # ]: 0 : do nb = 1, nbeta(is)
275 [ # # ]: 0 : do mb = nb, nbeta(is)
276 : :
277 [ # # ]: 0 : read (iunps,*,err=100,iostat=ios) idum, idum, ldum, dummy
278 : : !" i j (l)"
279 [ # # ]: 0 : if (ldum.ne.lll(mb,is) ) then
280 : 0 : call errore ('read_pseudo_nl','inconsistent angular momentum for Q_ij', 1)
281 : : end if
282 : :
283 [ # # ]: 0 : read (iunps,*,err=100,iostat=ios) qqq(nb,mb,is), dummy
284 : : ! "Q_int"
285 : 0 : qqq(mb,nb,is) = qqq(nb,mb,is)
286 : :
287 : : read (iunps,*,err=100,iostat=ios) &
288 [ # # ]: 0 : (qfunc(n,nb,mb,is), n=1,mesh(is))
289 [ # # ]: 0 : do n = 0, mesh (is)
290 : 0 : qfunc(n,mb,nb,is) = qfunc(n,nb,mb,is)
291 : : enddo
292 : :
293 [ # # ]: 0 : if (nqf(is).gt.0) then
294 : 0 : call scan_begin (iunps, "QFCOEF", .false.)
295 : : read (iunps,*,err=100,iostat=ios) &
296 [ # # ]: 0 : ((qfcoef(i,lp,nb,mb,is),i=1,nqf(is)),lp=1,nqlc(is))
297 : 0 : call scan_end (iunps, "QFCOEF")
298 : : end if
299 : :
300 : : enddo
301 : : enddo
302 : 0 : call scan_end (iunps, "QIJ")
303 : : else
304 [ + + + + ]: 146 : qqq (:,:,is) = 0.d0
305 [ + + + + : 256146 : qfunc(:,:,:,is) =0.d0
+ + ]
306 : : endif
307 : :
308 : 2 : 100 call errore ('read_pseudo_nl', 'Reading pseudo file', abs (ios) )
309 : 2 : return
310 : : end subroutine read_pseudo_nl
311 : : !
312 : : !---------------------------------------------------------------------
313 : 2 : subroutine read_pseudo_nlcc (is, iunps)
314 : : !---------------------------------------------------------------------
315 : : !
316 : : use flib_pwscf
317 : : use pseudo_pwscf
318 : : implicit none
319 : : !
320 : : integer :: is, iunps
321 : : !
322 : : integer :: ir, ios
323 : :
324 [ + - ]: 2 : read (iunps, *, err = 100, iostat = ios) (rho_atc(ir,is), ir=1,mesh(is) )
325 : : !
326 : 2 : 100 call errore ('read_pseudo_nlcc', 'Reading pseudo file', abs (ios) )
327 : 2 : return
328 : : end subroutine read_pseudo_nlcc
329 : : !
330 : : !---------------------------------------------------------------------
331 : 2 : subroutine read_pseudo_pswfc (is, iunps)
332 : : !---------------------------------------------------------------------
333 : : !
334 : : use flib_pwscf
335 : : use pseudo_pwscf
336 : : implicit none
337 : : !
338 : : integer :: is, iunps
339 : : !
340 : : character (len=75) :: dummy
341 : : integer :: nb, ir, ios
342 : : !
343 [ + + ]: 10 : do nb = 1, ntwfc(is)
344 [ + - ]: 8 : read (iunps,*,err=100,iostat=ios) dummy !Wavefunction labels
345 [ + - ]: 10 : read (iunps,*,err=100,iostat=ios) (chi(ir,nb,is), ir=1,mesh(is))
346 : : enddo
347 : 2 : 100 call errore ('read_pseudo_pswfc', 'Reading pseudo file', abs(ios))
348 : 2 : return
349 : :
350 : : end subroutine read_pseudo_pswfc
351 : : !
352 : : !---------------------------------------------------------------------
353 : 2 : subroutine read_pseudo_rhoatom (is, iunps)
354 : : !---------------------------------------------------------------------
355 : : !
356 : : use flib_pwscf
357 : : use pseudo_pwscf
358 : : implicit none
359 : : !
360 : : integer :: is, iunps
361 : : !
362 : : integer :: ir, ios
363 : :
364 [ + - ]: 2 : read (iunps,*,err=100,iostat=ios) (rho_at(ir,is), ir=1,mesh(is))
365 : 2 : return
366 : :
367 : 0 : 100 call errore ('read_pseudo_rhoatom','Reading pseudo file',abs(ios))
368 : :
369 : : end subroutine read_pseudo_rhoatom
370 : : !
371 : : !!***
372 : :
373 : : end module m_read_upf_pwscf
374 : : !!***
|
