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