Line data Source code
1 : !!****m* ABINIT/m_pawxmlps
2 : !! NAME
3 : !! m_pawxmlps
4 : !!
5 : !! FUNCTION
6 : !! This module reads a PAW pseudopotential file written in XML.
7 : !! Can use either FoX or pure Fortran routines.
8 : !!
9 : !! COPYRIGHT
10 : !! Copyright (C) 2005-2026 ABINIT group (MT, FJ)
11 : !! This file is distributed under the terms of the
12 : !! GNU General Public License, see ~abinit/COPYING
13 : !! or http://www.gnu.org/copyleft/gpl.txt .
14 : !!
15 : !! NOTES
16 : !! FOR DEVELOPPERS: in order to preserve the portability of libPAW library,
17 : !! please consult ~abinit/src/??_libpaw/libpaw-coding-rules.txt
18 : !!
19 : !! SOURCE
20 :
21 : #include "libpaw.h"
22 :
23 : module m_pawxmlps
24 :
25 : USE_DEFS
26 : USE_MSG_HANDLING
27 : USE_MEMORY_PROFILING
28 :
29 : #if defined LIBPAW_HAVE_FOX
30 : use fox_sax
31 : #endif
32 :
33 : use m_pawrad , only : pawrad_type, pawrad_init, pawrad_free, pawrad_ifromr, bound_deriv,pawrad_copy
34 : use m_paw_numeric, only : paw_spline, paw_splint
35 : use m_paw_atomorb, only : atomorb_type, ORB_FROZEN
36 : use m_paw_lmn
37 :
38 : implicit none
39 :
40 : private
41 :
42 : !Procedures used for the Fortran reader
43 : public :: rdpawpsxml
44 : public :: rdpawpsxml_header
45 : public :: rdpawpsxml_core
46 :
47 : !Procedures used for the FoX reader (called from xml_parser in response to events)
48 : #if defined LIBPAW_HAVE_FOX
49 : public :: paw_begin_element1
50 : public :: paw_end_element1
51 : public :: pawdata_chunk
52 : #endif
53 :
54 : ! private procedures and global variables.
55 : private :: paw_rdfromline
56 :
57 : ! This type of real is used by the datatypes below
58 : integer,parameter,private :: dpxml = selected_real_kind(14)
59 :
60 : ! The maximum length of a record in a file connected for sequential access.
61 : integer,parameter,private :: XML_RECL = 50000
62 : integer,parameter,private :: NGAUSSIAN_MAX = 100
63 : !!***
64 :
65 : !!****t* m_pawxmlps/radial_grid_t
66 : !! NAME
67 : !! radial_grid_t
68 : !!
69 : !! FUNCTION
70 : !! Radial grid type for the FoX XML reader
71 : !!
72 : !! SOURCE
73 :
74 : type, public :: radial_grid_t
75 : logical :: tread=.false.
76 : character(len=20) :: eq
77 : character(len=4) :: id
78 : real(dpxml) :: aa
79 : real(dpxml) :: bb
80 : real(dpxml) :: dd
81 : integer :: nn
82 : integer :: istart
83 : integer :: iend
84 : end type radial_grid_t
85 : !!***
86 :
87 : !-------------------------------------------------------------------------
88 :
89 : !!****t* m_pawxmlps/radial_func_t
90 : !! NAME
91 : !! radial_func_t
92 : !!
93 : !! FUNCTION
94 : !! Radial function type for the FoX XML reader
95 : !!
96 : !! SOURCE
97 :
98 : type, public :: radialfunc_t
99 : logical :: tread=.false.
100 : character(len=6) :: grid=' ' !vz_z
101 : character(len=6) :: state=' ' !vz_z
102 : real(dpxml),allocatable :: data(:)
103 : end type radialfunc_t
104 : !!***
105 :
106 : !-------------------------------------------------------------------------
107 :
108 : !!****t* m_pawxmlps/gaussian_expansion_t
109 : !! NAME
110 : !! radial_func_t
111 : !!
112 : !! FUNCTION
113 : !! Radial function type for the FoX XML reader
114 : !!
115 : !! SOURCE
116 :
117 : type, public :: gaussian_expansion_t
118 : logical :: tread=.false.
119 : integer :: ngauss=0
120 : character(len=6) :: state=' '
121 : real(dpxml), dimension(2, NGAUSSIAN_MAX) :: factors
122 : real(dpxml), dimension(2, NGAUSSIAN_MAX) :: expos
123 : end type gaussian_expansion_t
124 : !!***
125 :
126 : !-------------------------------------------------------------------------
127 :
128 : !!****t* m_pawxmlps/shape_function_t
129 : !! NAME
130 : !! shape_function_t
131 : !!
132 : !! FUNCTION
133 : !! Shape function type for the FoX XML reader
134 : !!
135 : !! SOURCE
136 :
137 : type, public :: shape_function_t
138 : logical :: tread=.false.
139 : character(len=20) :: gtype
140 : real(dpxml) :: rc=0
141 : character(len=6) :: grid
142 : integer :: lamb
143 : real(dpxml), allocatable :: data(:,:)
144 : end type shape_function_t
145 : !!***
146 :
147 : !-------------------------------------------------------------------------
148 :
149 : !!****t* m_pawxmlps/state_t
150 : !! NAME
151 : !! state_t
152 : !!
153 : !! FUNCTION
154 : !! State type for the FoX XML reader
155 : !!
156 : !! SOURCE
157 :
158 : type, public :: state_t
159 : logical :: tread=.false.
160 : character(len=6) :: id
161 : real(dpxml) :: ff
162 : real(dpxml) :: rc
163 : real(dpxml) :: ee
164 : integer :: nn
165 : integer :: ll
166 : integer :: kk
167 : end type state_t
168 : !!***
169 :
170 : !-------------------------------------------------------------------------
171 :
172 : !!****t* m_pawxmlps/valence_states_t
173 : !! NAME
174 : !! valence_states_t
175 : !!
176 : !! FUNCTION
177 : !! Valence state type for the FoX XML reader
178 : !!
179 : !! SOURCE
180 :
181 : type, public :: valence_states_t
182 : logical :: tread=.false.
183 : integer :: nval
184 : type(state_t),allocatable :: state(:)
185 : end type valence_states_t
186 : !!***
187 :
188 : !-------------------------------------------------------------------------
189 :
190 : !!****t* m_pawxmlps/generator_t
191 : !! NAME
192 : !! generator_t
193 : !!
194 : !! FUNCTION
195 : !! Generator type for the FoX XML reader
196 : !!
197 : !! SOURCE
198 :
199 : type, public :: generator_t
200 : logical :: tread=.false.
201 : character(len=20) :: gen
202 : character(len=20) :: name
203 : end type generator_t
204 : !!***
205 :
206 : !-------------------------------------------------------------------------
207 :
208 : !!****t* m_pawxmlps/xc_functional_t
209 : !! NAME
210 : !! xc_functional_t function_t
211 : !!
212 : !! FUNCTION
213 : !! XC functional type for the FoX XML reader
214 : !!
215 : !! SOURCE
216 :
217 : type, public :: xc_functional_t
218 : logical :: tread=.false.
219 : character(len=12) :: functionaltype
220 : character(len=100) :: name
221 : end type xc_functional_t
222 : !!***
223 :
224 : !-------------------------------------------------------------------------
225 :
226 : !!****t* m_pawxmlps/atom_t
227 : !! NAME
228 : !! atom_t
229 : !!
230 : !! FUNCTION
231 : !! Atom type for the FoX XML reader
232 : !!
233 : !! SOURCE
234 :
235 : type, public :: atom_t
236 : logical :: tread=.false.
237 : character(len=2) :: symbol
238 : real(dpxml) :: znucl
239 : real(dpxml) :: zion
240 : real(dpxml) :: zval
241 : end type atom_t
242 : !!***
243 :
244 : !-------------------------------------------------------------------------
245 :
246 : !!****t* m_pawxmlps/paw_setup_t
247 : !! NAME
248 : !! paw_setup_t
249 : !!
250 : !! FUNCTION
251 : !! PAW setup type (contain all the data for a PAW setup)
252 : !!
253 : !! SOURCE
254 :
255 : type, public :: paw_setup_t
256 : character(len=3) :: version
257 : logical :: tread=.false.
258 : integer :: ngrid
259 : real(dpxml) :: rpaw
260 : real(dpxml) :: ekin_core
261 : real(dpxml) :: ex_cc
262 : real(dpxml) :: lamb_shielding=0.0D0
263 : character(len=4) :: idgrid
264 : character(len=12) :: optortho
265 : type(atom_t) :: atom
266 : type(xc_functional_t) :: xc_functional
267 : type(generator_t) :: generator
268 : type(valence_states_t) :: valence_states
269 : type(radial_grid_t), allocatable :: radial_grid(:)
270 : type(shape_function_t) :: shape_function
271 : type(radialfunc_t) :: ae_core_density
272 : type(radialfunc_t) :: pseudo_core_density
273 : type(radialfunc_t) :: pseudo_valence_density
274 : type(radialfunc_t) :: zero_potential
275 : type(radialfunc_t) :: LDA_minus_half_potential
276 : type(radialfunc_t) :: ae_core_kinetic_energy_density
277 : type(radialfunc_t) :: pseudo_core_kinetic_energy_density
278 : type(radialfunc_t),allocatable :: ae_partial_wave(:)
279 : type(radialfunc_t),allocatable :: pseudo_partial_wave(:)
280 : type(radialfunc_t),allocatable :: projector_function(:)
281 : type(gaussian_expansion_t),allocatable :: projector_fit(:)
282 : type(radialfunc_t) :: kresse_joubert_local_ionic_potential
283 : type(radialfunc_t) :: blochl_local_ionic_potential
284 : type(radialfunc_t) :: kinetic_energy_differences
285 : type(radialfunc_t) :: exact_exchange_matrix
286 : end type paw_setup_t
287 :
288 : public :: paw_setup_free ! Free memory
289 : public :: paw_setup_copy ! Copy object
290 : !!***
291 :
292 :
293 : !-------------------------------------------------------------------------
294 : !-------------------------------------------------------------------------
295 : !------------- PUBLIC AND PRIVATE VARIABLES ------------------------------
296 : !-------------------------------------------------------------------------
297 : !-------------------------------------------------------------------------
298 :
299 : !Public variables (common to both readers)
300 : integer,save,public,allocatable :: ipsp2xml(:)
301 : integer,save,public :: npsp_pawxml
302 : type(paw_setup_t),public,target,allocatable,save :: paw_setup(:)
303 : type(paw_setup_t),public,target,save :: paw_setuploc
304 :
305 : !Private variables (for the FoX reader)
306 : #if defined LIBPAW_HAVE_FOX
307 : logical,private,save :: in_valenceStates = .false.,in_data=.false.
308 : logical,private,save :: in_generator =.false.
309 : integer,private,save :: ndata
310 : integer,private,save :: ii,ival,igrid,ishpf,lmax,mesh_size
311 : !Pointers to make it easier to manage the data
312 : type(radialfunc_t),private,save,pointer :: rp
313 : type(state_t),private,save,pointer :: valstate (:)
314 : type(radial_grid_t),private,save,pointer :: grids (:)
315 : type(radialfunc_t),private,save,pointer :: shpf(:)
316 : #endif
317 : !!***
318 :
319 :
320 : CONTAINS
321 : !===========================================================
322 : !!***
323 :
324 : !-------------------------------------------------------------------------
325 : !-------------------------------------------------------------------------
326 : !------------- ROUTINES AND FUNCTIONS FOR THE FOX READER -----------------
327 : !-------------------------------------------------------------------------
328 : !-------------------------------------------------------------------------
329 : #if defined LIBPAW_HAVE_FOX
330 :
331 : !!****f* m_pawxmlps/paw_begin_element1
332 : !! NAME
333 : !! begin_element
334 : !!
335 : !! FUNCTION
336 : !! Read an XML tag with a given name.
337 : !! Fills the present module private data.
338 : !!
339 : !! INPUTS
340 : !! namespaceURI = universal resource indicator for XML namespace??? Not used.
341 : !! localName = local equivalent of tag name?? Not used.
342 : !! name = name of XML tag which has been read in
343 : !! attributes = attributes of XML tag
344 : !!
345 : !! OUTPUT
346 : !! Fills private data in present module.
347 : !!
348 : !! SOURCE
349 : subroutine paw_begin_element1(namespaceURI,localName,name,attributes)
350 :
351 : character(len=*),intent(in) :: namespaceURI,localName,name
352 : type(dictionary_t),intent(in) :: attributes
353 :
354 : character(len=100) :: msg,value
355 : integer ::iaewf=0,iproj=0,ipswf=0,iprojfit=0,igauss=0
356 : !Just to fool abirules
357 : value=localName
358 : value=namespaceURI
359 :
360 : select case(name)
361 :
362 : case ("paw_setup")
363 : paw_setuploc%tread=.true.
364 : igrid=0;ishpf=0
365 : paw_setuploc%rpaw=-1.d0
366 : LIBPAW_DATATYPE_ALLOCATE(grids,(10))
367 : LIBPAW_DATATYPE_ALLOCATE(shpf,(7))
368 : value = getValue(attributes,"version")
369 : write(std_out,'(3a)') "Processing a PSEUDO version ",trim(value)," XML file"
370 : paw_setuploc%version=trim(value)
371 :
372 :
373 : case ("atom")
374 : paw_setuploc%atom%tread=.true.
375 : value = getValue(attributes,"symbol")
376 : if (value == "" ) then
377 : msg="Cannot determine atomic symbol"
378 : LIBPAW_ERROR(msg)
379 : end if
380 : paw_setuploc%atom%symbol = trim(value)
381 :
382 : value = getValue(attributes,"Z")
383 : if (value == "" ) then
384 : msg="Cannot determine znucl"
385 : LIBPAW_ERROR(msg)
386 : end if
387 : read(unit=value,fmt=*) paw_setuploc%atom%znucl
388 :
389 : value = getValue(attributes,"core")
390 : if (value == "" ) then
391 : msg="Cannot determine zion"
392 : LIBPAW_ERROR(msg)
393 : end if
394 : read(unit=value,fmt=*) paw_setuploc%atom%zion
395 :
396 : value = getValue(attributes,"valence")
397 : if (value == "" ) then
398 : msg="Cannot determine zval"
399 : LIBPAW_ERROR(msg)
400 : end if
401 : read(unit=value,fmt=*) paw_setuploc%atom%zval
402 :
403 :
404 : case ("xc_functional")
405 : paw_setuploc%xc_functional%tread=.true.
406 : value = getValue(attributes,"type")
407 : if (value == "" ) then
408 : msg="Cannot determine xc-functional-type"
409 : LIBPAW_ERROR(msg)
410 : end if
411 : paw_setuploc%xc_functional%functionaltype = trim(value)
412 :
413 : value = getValue(attributes,"name")
414 : if (value == "" ) then
415 : msg="Cannot determine xc-functional-name "
416 : LIBPAW_ERROR(msg)
417 : end if
418 : paw_setuploc%xc_functional%name= trim(value)
419 :
420 : case ("generator")
421 : paw_setuploc%generator%tread=.true.
422 : in_generator =.true.
423 : value = getValue(attributes,"type")
424 : if (value == "" ) value = "unknown"
425 : paw_setuploc%generator%gen = trim(value)
426 :
427 : value = getValue(attributes,"name")
428 : if (value == "" ) value = "unknown"
429 : paw_setuploc%generator%name = trim(value)
430 :
431 : case ("PAW_radius")
432 : value = getValue(attributes,"rpaw")
433 : if (value == "" ) then
434 : msg="Cannot determine rpaw"
435 : LIBPAW_ERROR(msg)
436 : end if
437 : read(unit=value,fmt=*) paw_setuploc%rpaw
438 :
439 : case ("valence_states")
440 : paw_setuploc%valence_states%tread=.true.
441 : in_valenceStates=.true.
442 : ival=0
443 : lmax=0
444 : LIBPAW_DATATYPE_ALLOCATE(valstate,(50))
445 :
446 : case ("state")
447 : ival=ival+1
448 :
449 : value = getValue(attributes,"n")
450 : if (value == "" ) then
451 : valstate(ival)%nn=-1
452 : else
453 : read(unit=value,fmt=*) valstate(ival)%nn
454 : end if
455 :
456 : value = getValue(attributes,"l")
457 : if (value == "" ) then
458 : msg="Cannot determine l"
459 : LIBPAW_ERROR(msg)
460 : end if
461 : read(unit=value,fmt=*) valstate(ival)%ll
462 : if(valstate(ival)%ll>lmax) lmax=valstate(ival)%ll
463 :
464 : value = getValue(attributes,"f")
465 : if (value == "" ) then
466 : valstate(ival)%ff=-1.d0
467 : else
468 : read(unit=value,fmt=*) valstate(ival)%ff
469 : end if
470 :
471 : value = getValue(attributes,"rc")
472 : if (value == "" ) then
473 : msg="Cannot determine rc"
474 : LIBPAW_ERROR(msg)
475 : end if
476 : read(unit=value,fmt=*) valstate(ival)%rc
477 :
478 : value = getValue(attributes,"e")
479 : if (value == "" ) then
480 : msg="Cannot determine e"
481 : LIBPAW_ERROR(msg)
482 : end if
483 : read(unit=value,fmt=*) valstate(ival)%ee
484 :
485 : value = getValue(attributes,"id")
486 : if (value == "" ) value = "unknown"
487 : valstate(ival)%id = trim(value)
488 :
489 : case ("radial_grid")
490 : igrid=igrid+1
491 : value = getValue(attributes,"eq")
492 : if (value == "" ) value = "unknown"
493 : grids(igrid)%eq = trim(value)
494 :
495 : value = getValue(attributes,"a")
496 : if (value == "" ) then
497 : grids(igrid)%aa=0.d0
498 : else
499 : read(unit=value,fmt=*) grids(igrid)%aa
500 : end if
501 :
502 : value = getValue(attributes,"n")
503 : if (value == "" ) then
504 : grids(igrid)%nn=0
505 : else
506 : read(unit=value,fmt=*) grids(igrid)%nn
507 : end if
508 :
509 : value = getValue(attributes,"d")
510 : if (value == "" ) then
511 : grids(igrid)%dd=0.d0
512 : else
513 : read(unit=value,fmt=*) grids(igrid)%dd
514 : end if
515 :
516 : value = getValue(attributes,"b")
517 : if (value == "" ) then
518 : grids(igrid)%bb=0.d0
519 : else
520 : read(unit=value,fmt=*) grids(igrid)%bb
521 : end if
522 :
523 : value = getValue(attributes,"istart")
524 : if (value == "" ) then
525 : msg="Cannot determine istart"
526 : LIBPAW_ERROR(msg)
527 : end if
528 : read(unit=value,fmt=*) grids(igrid)%istart
529 :
530 : value = getValue(attributes,"iend")
531 : if (value == "" ) then
532 : msg="Cannot determine iend"
533 : LIBPAW_ERROR(msg)
534 : end if
535 : read(unit=value,fmt=*) grids(igrid)%iend
536 :
537 : value = getValue(attributes,"id")
538 : if (value == "" ) value = "unknown"
539 : grids(igrid)%id = trim(value)
540 :
541 : end select
542 :
543 : select case(name)
544 : case ("shape_function")
545 : paw_setuploc%shape_function%tread=.true.
546 : value = getValue(attributes,"type")
547 : if (value == "" ) value = "unknown"
548 : paw_setuploc%shape_function%gtype = trim(value)
549 :
550 : value = getValue(attributes,"grid")
551 : paw_setuploc%shape_function%grid=trim(value)
552 : if (value /= "" ) then
553 : paw_setuploc%shape_function%gtype ="num"
554 : do ii=1,igrid
555 : if(trim(paw_setuploc%shape_function%grid)==trim(grids(ii)%id)) then
556 : mesh_size=grids(ii)%iend-grids(ii)%istart+1
557 : end if
558 : end do
559 : ishpf=ishpf+1
560 : LIBPAW_ALLOCATE(shpf(ishpf)%data,(mesh_size))
561 : rp=>shpf(ishpf)
562 : in_data=.true.
563 : ndata = 0
564 : end if
565 :
566 : value = getValue(attributes,"rc")
567 : if (value == "" ) then
568 : if(paw_setuploc%shape_function%gtype /="num") then
569 : msg="Cannot determine rc"
570 : LIBPAW_ERROR(msg)
571 : end if
572 : else
573 : read(unit=value,fmt=*) paw_setuploc%shape_function%rc
574 : end if
575 :
576 : value = getValue(attributes,"lamb")
577 : if (value == "" ) then
578 : paw_setuploc%shape_function%lamb=0
579 : else
580 : read(unit=value,fmt=*) paw_setuploc%shape_function%lamb
581 : end if
582 :
583 : case ("pseudo_partial_wave")
584 : ipswf=ipswf+1
585 : paw_setuploc%pseudo_partial_wave(ipswf)%tread=.true.
586 : value = getValue(attributes,"grid")
587 : if (value == "" ) value = "unknown"
588 : paw_setuploc%idgrid = trim(value)
589 : paw_setuploc%pseudo_partial_wave(ipswf)%grid=trim(value)
590 :
591 : value = getValue(attributes,"state")
592 : if (value == "" ) then
593 : msg="Cannot determine pseudo_partial_wave state"
594 : LIBPAW_ERROR(msg)
595 : end if
596 : paw_setuploc%pseudo_partial_wave(ipswf)%state=trim(value)
597 :
598 : do ii=1,igrid
599 : if(trim(paw_setuploc%pseudo_partial_wave(ipswf)%grid)==trim(grids(ii)%id)) then
600 : mesh_size=grids(ii)%iend-grids(ii)%istart+1
601 : end if
602 : end do
603 :
604 : LIBPAW_ALLOCATE(paw_setuploc%pseudo_partial_wave(ipswf)%data,(mesh_size))
605 : rp=>paw_setuploc%pseudo_partial_wave(ipswf)
606 : if(ipswf==paw_setuploc%valence_states%nval) ipswf=0
607 : in_data=.true.
608 : ndata = 0
609 :
610 : case ("ae_partial_wave")
611 : iaewf=iaewf+1
612 : paw_setuploc%ae_partial_wave(iaewf)%tread=.true.
613 : value = getValue(attributes,"grid")
614 : if (value == "" ) value = "unknown"
615 : paw_setuploc%ae_partial_wave(iaewf)%grid=trim(value)
616 :
617 : value = getValue(attributes,"state")
618 : if (value == "" ) then
619 : LIBPAW_ERROR("Cannot determine ae_partial_wave state")
620 : end if
621 : paw_setuploc%ae_partial_wave(iaewf)%state=trim(value)
622 :
623 : do ii=1,igrid
624 : if(trim(paw_setuploc%ae_partial_wave(iaewf)%grid)==trim(grids(ii)%id)) then
625 : mesh_size=grids(ii)%iend-grids(ii)%istart+1
626 : end if
627 : end do
628 :
629 : LIBPAW_ALLOCATE(paw_setuploc%ae_partial_wave(iaewf)%data,(mesh_size))
630 : rp=>paw_setuploc%ae_partial_wave(iaewf)
631 : if(iaewf==paw_setuploc%valence_states%nval) iaewf=0
632 : in_data=.true.
633 : ndata = 0
634 :
635 : case ("projector_function")
636 : iproj=iproj+1
637 : paw_setuploc%projector_function(iproj)%tread=.true.
638 : value = getValue(attributes,"grid")
639 : if (value == "" ) value = "unknown"
640 : paw_setuploc%projector_function(iproj)%grid=trim(value)
641 :
642 : value = getValue(attributes,"state")
643 : if (value == "" ) then
644 : msg="Cannot determine projector_function state"
645 : LIBPAW_ERROR(msg)
646 : end if
647 : paw_setuploc%projector_function(iproj)%state=trim(value)
648 :
649 : do ii=1,igrid
650 : if(trim(paw_setuploc%projector_function(iproj)%grid)==trim(grids(ii)%id)) then
651 : mesh_size=grids(ii)%iend-grids(ii)%istart+1
652 : end if
653 : end do
654 :
655 : LIBPAW_ALLOCATE(paw_setuploc%projector_function(iproj)%data,(mesh_size))
656 : rp=>paw_setuploc%projector_function(iproj)
657 : if(iproj==paw_setuploc%valence_states%nval) iproj=0
658 : in_data=.true.
659 : ndata = 0
660 :
661 : case ("projector_fit")
662 : if(.not.allocated(paw_setuploc%projector_fit)) then
663 : LIBPAW_DATATYPE_ALLOCATE(paw_setuploc%projector_fit,(paw_setuploc%valence_states%nval))
664 : end if
665 :
666 : iprojfit=iprojfit+1
667 : paw_setuploc%projector_fit(iprojfit)%tread=.true.
668 : value = getValue(attributes,"state")
669 : if (value == "" ) then
670 : msg="Cannot determine projector_fit state"
671 : LIBPAW_ERROR(msg)
672 : end if
673 : paw_setuploc%projector_fit(iprojfit)%state=trim(value)
674 :
675 : if(iprojfit==paw_setuploc%valence_states%nval) iprojfit=0
676 : igauss = 0
677 :
678 : case ("gaussian")
679 : igauss = igauss + 1
680 : value = getValue(attributes,"factor")
681 : if (value == "" ) then
682 : msg="Cannot determine gaussian factor"
683 : LIBPAW_ERROR(msg)
684 : end if
685 : read(value(2:100), *) paw_setuploc%projector_fit(iprojfit)%factors(1, igauss)
686 : read(value(index(value, ',') + 1:100), *) paw_setuploc%projector_fit(iprojfit)%factors(2, igauss)
687 : value = getValue(attributes,"exponent")
688 : if (value == "" ) then
689 : msg="Cannot determine gaussian exponent"
690 : LIBPAW_ERROR(msg)
691 : end if
692 : read(value(2:100), *) paw_setuploc%projector_fit(iprojfit)%expos(1, igauss)
693 : read(value(index(value, ',') + 1:100), *) paw_setuploc%projector_fit(iprojfit)%expos(2, igauss)
694 :
695 : case ("ae_core_density")
696 : paw_setuploc%ae_core_density%tread=.true.
697 : value = getValue(attributes,"grid")
698 : if (value == "" ) value = "unknown"
699 : paw_setuploc%ae_core_density%grid=trim(value)
700 :
701 : value = getValue(attributes,"state")
702 : if (value == "" ) value = "unknown"
703 : paw_setuploc%ae_core_density%state=trim(value)
704 :
705 : do ii=1,igrid
706 : if(trim(paw_setuploc%ae_core_density%grid)==trim(grids(ii)%id)) then
707 : mesh_size=grids(ii)%iend-grids(ii)%istart+1
708 : end if
709 : end do
710 :
711 : LIBPAW_ALLOCATE(paw_setuploc%ae_core_density%data,(mesh_size))
712 : rp=>paw_setuploc%ae_core_density
713 : in_data=.true.
714 : ndata = 0
715 :
716 : case ("pseudo_core_density")
717 : paw_setuploc%pseudo_core_density%tread=.true.
718 : value = getValue(attributes,"grid")
719 : if (value == "" ) value = "unknown"
720 : paw_setuploc%pseudo_core_density%grid=trim(value)
721 :
722 : value = getValue(attributes,"state")
723 : if (value == "" ) value = "unknown"
724 : paw_setuploc%pseudo_core_density%state=trim(value)
725 :
726 : do ii=1,igrid
727 : if(trim(paw_setuploc%pseudo_core_density%grid)==trim(grids(ii)%id)) then
728 : mesh_size=grids(ii)%iend-grids(ii)%istart+1
729 : end if
730 : end do
731 :
732 : LIBPAW_ALLOCATE(paw_setuploc%pseudo_core_density%data,(mesh_size))
733 : rp=>paw_setuploc%pseudo_core_density
734 : in_data=.true.
735 : ndata = 0
736 :
737 : case ("pseudo_valence_density")
738 : paw_setuploc%pseudo_valence_density%tread=.true.
739 : value = getValue(attributes,"grid")
740 : if (value == "" ) value = "unknown"
741 : paw_setuploc%pseudo_valence_density%grid=trim(value)
742 :
743 : value = getValue(attributes,"state")
744 : if (value == "" ) value = "unknown"
745 : paw_setuploc%pseudo_valence_density%state=trim(value)
746 :
747 : do ii=1,igrid
748 : if(trim(paw_setuploc%pseudo_valence_density%grid)==trim(grids(ii)%id)) then
749 : mesh_size=grids(ii)%iend-grids(ii)%istart+1
750 : end if
751 : end do
752 :
753 : LIBPAW_ALLOCATE(paw_setuploc%pseudo_valence_density%data,(mesh_size))
754 : rp=>paw_setuploc%pseudo_valence_density
755 : in_data=.true.
756 : ndata = 0
757 :
758 : case ("zero_potential")
759 : paw_setuploc%zero_potential%tread=.true.
760 : value = getValue(attributes,"grid")
761 : if (value == "" ) value = "unknown"
762 : paw_setuploc%zero_potential%grid=trim(value)
763 :
764 : value = getValue(attributes,"state")
765 : if (value == "" ) value = "unknown"
766 : paw_setuploc%zero_potential%state=trim(value)
767 :
768 : do ii=1,igrid
769 : if(trim(paw_setuploc%zero_potential%grid)==trim(grids(ii)%id)) then
770 : mesh_size=grids(ii)%iend-grids(ii)%istart+1
771 : end if
772 : end do
773 :
774 : LIBPAW_ALLOCATE(paw_setuploc%zero_potential%data,(mesh_size))
775 : rp=>paw_setuploc%zero_potential
776 : in_data=.true.
777 : ndata = 0
778 :
779 : case ("LDA_minus_half_potential")
780 : paw_setuploc%LDA_minus_half_potential%tread=.true.
781 : value = getValue(attributes,"grid")
782 : if (value == "" ) value = "unknown"
783 : paw_setuploc%LDA_minus_half_potential%grid=trim(value)
784 :
785 : value = getValue(attributes,"state")
786 : if (value == "" ) value = "unknown"
787 : paw_setuploc%LDA_minus_half_potential%state=trim(value)
788 :
789 : do ii=1,igrid
790 : if(trim(paw_setuploc%LDA_minus_half_potential%grid)==trim(grids(ii)%id)) then
791 : mesh_size=grids(ii)%iend-grids(ii)%istart+1
792 : end if
793 : end do
794 :
795 : LIBPAW_ALLOCATE(paw_setuploc%LDA_minus_half_potential%data,(mesh_size))
796 : rp=>paw_setuploc%LDA_minus_half_potential
797 : in_data=.true.
798 : ndata = 0
799 :
800 : case ("ae_core_kinetic_energy_density")
801 : paw_setuploc%ae_core_kinetic_energy_density%tread=.true.
802 : value = getValue(attributes,"grid")
803 : if (value == "" ) value = "unknown"
804 : paw_setuploc%ae_core_kinetic_energy_density%grid=trim(value)
805 :
806 : value = getValue(attributes,"state")
807 : if (value == "" ) value = "unknown"
808 : paw_setuploc%ae_core_kinetic_energy_density%state=trim(value)
809 :
810 : do ii=1,igrid
811 : if(trim(paw_setuploc%ae_core_kinetic_energy_density%grid)==trim(grids(ii)%id)) then
812 : mesh_size=grids(ii)%iend-grids(ii)%istart+1
813 : end if
814 : end do
815 :
816 : LIBPAW_ALLOCATE(paw_setuploc%ae_core_kinetic_energy_density%data,(mesh_size))
817 : rp=>paw_setuploc%ae_core_kinetic_energy_density
818 : in_data=.true.
819 : ndata = 0
820 :
821 : case ("pseudo_core_kinetic_energy_density")
822 : paw_setuploc%pseudo_core_kinetic_energy_density%tread=.true.
823 : value = getValue(attributes,"grid")
824 : if (value == "" ) value = "unknown"
825 : paw_setuploc%pseudo_core_kinetic_energy_density%grid=trim(value)
826 :
827 : value = getValue(attributes,"state")
828 : if (value == "" ) value = "unknown"
829 : paw_setuploc%pseudo_core_kinetic_energy_density%state=trim(value)
830 :
831 : do ii=1,igrid
832 : if(trim(paw_setuploc%pseudo_core_kinetic_energy_density%grid)==trim(grids(ii)%id)) then
833 : mesh_size=grids(ii)%iend-grids(ii)%istart+1
834 : end if
835 : end do
836 :
837 : LIBPAW_ALLOCATE(paw_setuploc%pseudo_core_kinetic_energy_density%data,(mesh_size))
838 : rp=>paw_setuploc%pseudo_core_kinetic_energy_density
839 : in_data=.true.
840 : ndata = 0
841 :
842 : case ("kresse_joubert_local_ionic_potential")
843 : paw_setuploc%kresse_joubert_local_ionic_potential%tread=.true.
844 : value = getValue(attributes,"grid")
845 : if (value == "" ) value = "unknown"
846 : paw_setuploc%kresse_joubert_local_ionic_potential%grid=trim(value)
847 :
848 : value = getValue(attributes,"state")
849 : if (value == "" ) value = "unknown"
850 : paw_setuploc%kresse_joubert_local_ionic_potential%state=trim(value)
851 :
852 : do ii=1,igrid
853 : if(trim(paw_setuploc%kresse_joubert_local_ionic_potential%grid)==trim(grids(ii)%id)) then
854 : mesh_size=grids(ii)%iend-grids(ii)%istart+1
855 : end if
856 : end do
857 :
858 : LIBPAW_ALLOCATE(paw_setuploc%kresse_joubert_local_ionic_potential%data,(mesh_size))
859 : rp=>paw_setuploc%kresse_joubert_local_ionic_potential
860 : in_data=.true.
861 : ndata = 0
862 :
863 : case ("blochl_local_ionic_potential")
864 : paw_setuploc%blochl_local_ionic_potential%tread=.true.
865 : value = getValue(attributes,"grid")
866 : if (value == "" ) value = "unknown"
867 : paw_setuploc%blochl_local_ionic_potential%grid=trim(value)
868 :
869 : value = getValue(attributes,"state")
870 : if (value == "" ) value = "unknown"
871 : paw_setuploc%blochl_local_ionic_potential%state=trim(value)
872 :
873 : do ii=1,igrid
874 : if(trim(paw_setuploc%blochl_local_ionic_potential%grid)==trim(grids(ii)%id)) then
875 : mesh_size=grids(ii)%iend-grids(ii)%istart+1
876 : end if
877 : end do
878 :
879 : LIBPAW_ALLOCATE(paw_setuploc%blochl_local_ionic_potential%data,(mesh_size))
880 : rp=>paw_setuploc%blochl_local_ionic_potential
881 : in_data=.true.
882 : ndata = 0
883 :
884 : case ("kinetic_energy_differences")
885 : paw_setuploc%kinetic_energy_differences%tread=.true.
886 : mesh_size=paw_setuploc%valence_states%nval*paw_setuploc%valence_states%nval
887 : LIBPAW_ALLOCATE(paw_setuploc%kinetic_energy_differences%data,(mesh_size))
888 : rp=>paw_setuploc%kinetic_energy_differences
889 : in_data=.true.
890 : ndata = 0
891 :
892 : end select
893 :
894 : end subroutine paw_begin_element1
895 : !!***
896 :
897 : !-------------------------------------------------------------------------
898 :
899 : !!****f* m_pawxmlps/paw_end_element1
900 : !! NAME
901 : !! end_element
902 : !!
903 : !! FUNCTION
904 : !! End XML tag effect: switches flags in private data of this module
905 : !!
906 : !! INPUTS
907 : !! namespaceURI = universal resource indicator for XML namespace??? Not used.
908 : !! localName = local equivalent of tag name?? Not used.
909 : !! name = name of XML tag which has been read in
910 : !!
911 : !! OUTPUT
912 : !! side effect: private data flags in present module are turned to .false.
913 : !!
914 : !! SOURCE
915 : subroutine paw_end_element1(namespaceURI,localName,name)
916 :
917 : character(len=*),intent(in) :: namespaceURI,localName,name
918 : character(len=100) :: msg,value
919 :
920 : !Just to fool abirules
921 : value=localName
922 : value=namespaceURI
923 :
924 : select case(name)
925 :
926 : case ("generator")
927 : in_generator = .false.
928 :
929 : case ("valence_states")
930 : in_valenceStates = .false.
931 : if(ival>50) then
932 : msg="ival>50"
933 : LIBPAW_ERROR(msg)
934 : end if
935 : if(ival>0)then
936 : LIBPAW_DATATYPE_ALLOCATE(paw_setuploc%valence_states%state,(ival))
937 : paw_setuploc%valence_states%state(ival)%tread=.true.
938 : paw_setuploc%valence_states%nval=ival
939 : do ii=1,ival
940 : paw_setuploc%valence_states%state(ii)=valstate(ii)
941 : end do
942 : end if
943 : LIBPAW_DATATYPE_DEALLOCATE(valstate)
944 : if(.not.allocated(paw_setuploc%ae_partial_wave)) then
945 : LIBPAW_DATATYPE_ALLOCATE(paw_setuploc%ae_partial_wave,(paw_setuploc%valence_states%nval))
946 : end if
947 : if(.not.allocated(paw_setuploc%pseudo_partial_wave)) then
948 : LIBPAW_DATATYPE_ALLOCATE(paw_setuploc%pseudo_partial_wave,(paw_setuploc%valence_states%nval))
949 : end if
950 : if(.not.allocated(paw_setuploc%projector_function)) then
951 : LIBPAW_DATATYPE_ALLOCATE(paw_setuploc%projector_function,(paw_setuploc%valence_states%nval))
952 : end if
953 :
954 : case ("paw_setup")
955 : if(igrid>10) then
956 : msg="igrid>10"
957 : LIBPAW_ERROR(msg)
958 : end if
959 : LIBPAW_DATATYPE_ALLOCATE(paw_setuploc%radial_grid,(igrid))
960 : paw_setuploc%radial_grid(igrid)%tread=.true.
961 : paw_setuploc%ngrid=igrid
962 : do ii=1,igrid
963 : paw_setuploc%radial_grid(ii)=grids(ii)
964 : end do
965 : LIBPAW_DATATYPE_DEALLOCATE(grids)
966 : do ii=1,igrid
967 : if(trim(paw_setuploc%shape_function%grid)==trim(paw_setuploc%radial_grid(ii)%id)) then
968 : mesh_size=paw_setuploc%radial_grid(ii)%iend-paw_setuploc%radial_grid(ii)%istart+1
969 : end if
970 : end do
971 : if(ishpf>10) then
972 : msg="ishpf>7"
973 : LIBPAW_ERROR(msg)
974 : end if
975 : LIBPAW_ALLOCATE(paw_setuploc%shape_function%data,(mesh_size,ishpf))
976 : do ii=1,ishpf
977 : paw_setuploc%shape_function%data(:,ii)=shpf(ii)%data(:)
978 : LIBPAW_DEALLOCATE(shpf(ii)%data)
979 : end do
980 : LIBPAW_DATATYPE_DEALLOCATE(shpf)
981 :
982 : case ("shape_function")
983 : in_data=.false.
984 :
985 : case ("pseudo_partial_wave")
986 : in_data=.false.
987 :
988 : case ("ae_partial_wave")
989 : in_data=.false.
990 :
991 : case ("projector_function")
992 : in_data=.false.
993 :
994 : case ("ae_core_density")
995 : in_data=.false.
996 :
997 : case ("pseudo_core_density")
998 : in_data=.false.
999 :
1000 : case ("pseudo_valence_density")
1001 : in_data=.false.
1002 :
1003 : case ("zero_potential")
1004 : in_data=.false.
1005 :
1006 : case ("LDA_minus_half_potential")
1007 : in_data=.false.
1008 :
1009 : case ("ae_core_kinetic_energy_density")
1010 : in_data=.false.
1011 :
1012 : case ("pseudo_core_kinetic_energy_density")
1013 : in_data=.false.
1014 :
1015 : case ("kresse_joubert_local_ionic_potential")
1016 : in_data=.false.
1017 :
1018 : case ("blochl_local_ionic_potential")
1019 : in_data=.false.
1020 :
1021 : case ("kinetic_energy_differences")
1022 : in_data=.false.
1023 :
1024 : end select
1025 :
1026 : end subroutine paw_end_element1
1027 : !!***
1028 :
1029 : !-------------------------------------------------------------------------
1030 :
1031 : !!****f* m_pawxmlps/pawdata_chunk
1032 : !! NAME
1033 : !! pawdata_chunk
1034 : !!
1035 : !! FUNCTION
1036 : !! Take a string and turn it into useful data structure (reals)
1037 : !!
1038 : !! INPUTS
1039 : !! chunk=raw data for chunk of XML data
1040 : !!
1041 : !! OUTPUT
1042 : !!
1043 : !! SIDE EFFECTS
1044 : !! Copied and translated into module data (side effect)
1045 : !!
1046 : !! SOURCE
1047 : subroutine pawdata_chunk(chunk)
1048 :
1049 : character(len=*),intent(in) :: chunk
1050 :
1051 : integer :: ii,ntokens,status,last_pos
1052 : logical :: in_token
1053 : character(len=len(chunk)) :: str
1054 : character(len=50) :: msg
1055 : character(len=1) :: cc
1056 : real(dpxml),pointer :: x(:)
1057 :
1058 :
1059 : if (len_trim(chunk) == 0) RETURN ! skip empty chunk
1060 :
1061 : if (in_data) then
1062 : str = chunk ; x => rp%data
1063 :
1064 : ! Check the contents of the string and find the number of tokens it contains
1065 : ! The standard separator is generalized whitespace (space, tab, CR, or LF)
1066 : in_token=.false.;ntokens=0;last_pos=0
1067 : do ii=1,len_trim(str)
1068 : cc=str(ii:ii)
1069 : if (in_token) then
1070 : if (cc==char(9).or.cc==char(10).or.cc==char(13).or.cc==char(32)) then
1071 : in_token = .false.
1072 : if (cc==char(10).or.cc==char(13)) str(ii:ii) = " "
1073 : else
1074 : last_pos=ii
1075 : end if
1076 : else
1077 : if (cc==char(9).or.cc==char(10).or.cc==char(13).or.cc==char(32)) then
1078 : if (cc==char(10).or.cc==char(13)) str(ii:ii) = " "
1079 : else
1080 : in_token=.true.
1081 : last_pos=ii
1082 : ntokens=ntokens + 1
1083 : end if
1084 : end if
1085 : end do
1086 :
1087 : if ((ndata+ntokens)>size(x)) then
1088 : msg="data array full"
1089 : LIBPAW_ERROR(msg)
1090 : end if
1091 :
1092 : ! Take the string and turn it into useful reals
1093 : read(unit=str(1:last_pos),fmt=*,iostat=status) x(ndata+1:ndata+ntokens)
1094 : if (status/=0) then
1095 : msg="real conversion error"
1096 : LIBPAW_ERROR(msg)
1097 : end if
1098 : ndata=ndata+ntokens
1099 :
1100 : end if
1101 :
1102 : end subroutine pawdata_chunk
1103 : !!***
1104 :
1105 : #endif
1106 :
1107 : !-------------------------------------------------------------------------
1108 : !-------------------------------------------------------------------------
1109 : !------------- ROUTINES AND FUNCTIONS FOR THE FORTRAN READER -------------
1110 : !-------------------------------------------------------------------------
1111 : !-------------------------------------------------------------------------
1112 :
1113 : !!****f* m_pawxmlps/paw_setup_free
1114 : !! NAME
1115 : !! paw_setup_free
1116 : !!
1117 : !! FUNCTION
1118 : !! Destroy a paw_setup datastructure
1119 : !!
1120 : !! SIDE EFFECTS
1121 : !! paw_setup<paw_setup_type>=Datatype gathering information on XML paw setup.
1122 : !!
1123 : !! SOURCE
1124 :
1125 494 : subroutine paw_setup_free(paw_setupin)
1126 :
1127 : !Arguments ------------------------------------
1128 : !scalars
1129 : type(paw_setup_t),intent(inout) :: paw_setupin
1130 :
1131 : !Local variables-------------------------------
1132 : integer :: ii
1133 :
1134 : ! *********************************************************************
1135 :
1136 494 : paw_setupin%tread=.false.
1137 494 : paw_setupin%atom%tread=.false.
1138 494 : paw_setupin%xc_functional%tread=.false.
1139 494 : paw_setupin%generator%tread=.false.
1140 494 : paw_setupin%valence_states%tread=.false.
1141 494 : paw_setupin%shape_function%tread=.false.
1142 494 : paw_setupin%ae_core_density%tread=.false.
1143 494 : paw_setupin%pseudo_core_density%tread=.false.
1144 494 : paw_setupin%pseudo_valence_density%tread=.false.
1145 494 : paw_setupin%zero_potential%tread=.false.
1146 494 : paw_setupin%LDA_minus_half_potential%tread=.false.
1147 494 : paw_setupin%ae_core_kinetic_energy_density%tread=.false.
1148 494 : paw_setupin%pseudo_core_kinetic_energy_density%tread=.false.
1149 494 : paw_setupin%kresse_joubert_local_ionic_potential%tread=.false.
1150 494 : paw_setupin%blochl_local_ionic_potential%tread=.false.
1151 494 : paw_setupin%kinetic_energy_differences%tread=.false.
1152 494 : paw_setupin%exact_exchange_matrix%tread=.false.
1153 :
1154 494 : if(allocated( paw_setupin%shape_function%data)) then
1155 1 : LIBPAW_DEALLOCATE(paw_setupin%shape_function%data)
1156 : end if
1157 494 : if(allocated( paw_setupin%ae_core_density%data)) then
1158 306 : LIBPAW_DEALLOCATE(paw_setupin%ae_core_density%data)
1159 : end if
1160 494 : if(allocated( paw_setupin%pseudo_core_density%data)) then
1161 306 : LIBPAW_DEALLOCATE(paw_setupin%pseudo_core_density%data)
1162 : end if
1163 494 : if(allocated( paw_setupin%pseudo_valence_density%data)) then
1164 305 : LIBPAW_DEALLOCATE(paw_setupin%pseudo_valence_density%data)
1165 : end if
1166 494 : if(allocated( paw_setupin%zero_potential%data)) then
1167 297 : LIBPAW_DEALLOCATE(paw_setupin%zero_potential%data)
1168 : end if
1169 494 : if(allocated( paw_setupin%LDA_minus_half_potential%data)) then
1170 2 : LIBPAW_DEALLOCATE(paw_setupin%LDA_minus_half_potential%data)
1171 : end if
1172 494 : if(allocated( paw_setupin%ae_core_kinetic_energy_density%data)) then
1173 34 : LIBPAW_DEALLOCATE(paw_setupin%ae_core_kinetic_energy_density%data)
1174 : end if
1175 494 : if(allocated( paw_setupin%pseudo_core_kinetic_energy_density%data)) then
1176 34 : LIBPAW_DEALLOCATE(paw_setupin%pseudo_core_kinetic_energy_density%data)
1177 : end if
1178 494 : if(allocated( paw_setupin%kresse_joubert_local_ionic_potential%data)) then
1179 15 : LIBPAW_DEALLOCATE(paw_setupin%kresse_joubert_local_ionic_potential%data)
1180 : end if
1181 494 : if(allocated( paw_setupin%blochl_local_ionic_potential%data)) then
1182 285 : LIBPAW_DEALLOCATE(paw_setupin%blochl_local_ionic_potential%data)
1183 : end if
1184 494 : if(allocated( paw_setupin%kinetic_energy_differences%data)) then
1185 306 : LIBPAW_DEALLOCATE(paw_setupin%kinetic_energy_differences%data)
1186 : end if
1187 494 : if(allocated( paw_setupin%exact_exchange_matrix%data)) then
1188 271 : LIBPAW_DEALLOCATE(paw_setupin%exact_exchange_matrix%data)
1189 : end if
1190 494 : if (allocated( paw_setupin%ae_partial_wave)) then
1191 1655 : do ii=1,paw_setupin%valence_states%nval
1192 1655 : if(allocated( paw_setupin%ae_partial_wave(ii)%data)) then
1193 1349 : LIBPAW_DEALLOCATE(paw_setupin%ae_partial_wave(ii)%data)
1194 : end if
1195 : end do
1196 1655 : LIBPAW_DATATYPE_DEALLOCATE(paw_setupin%ae_partial_wave)
1197 : end if
1198 494 : if (allocated( paw_setupin%pseudo_partial_wave)) then
1199 1655 : do ii=1,paw_setupin%valence_states%nval
1200 1655 : if(allocated( paw_setupin%pseudo_partial_wave(ii)%data)) then
1201 1349 : LIBPAW_DEALLOCATE(paw_setupin%pseudo_partial_wave(ii)%data)
1202 : end if
1203 : end do
1204 1655 : LIBPAW_DATATYPE_DEALLOCATE(paw_setupin%pseudo_partial_wave)
1205 : end if
1206 494 : if (allocated( paw_setupin%projector_function)) then
1207 1655 : do ii=1,paw_setupin%valence_states%nval
1208 1655 : if(allocated( paw_setupin%projector_function(ii)%data)) then
1209 1349 : LIBPAW_DEALLOCATE(paw_setupin%projector_function(ii)%data)
1210 : end if
1211 : end do
1212 1655 : LIBPAW_DATATYPE_DEALLOCATE(paw_setupin%projector_function)
1213 : end if
1214 494 : if (allocated( paw_setupin%projector_fit)) then
1215 0 : LIBPAW_DATATYPE_DEALLOCATE(paw_setupin%projector_fit)
1216 : end if
1217 494 : if(allocated(paw_setupin%valence_states%state)) then
1218 494 : LIBPAW_DATATYPE_DEALLOCATE(paw_setupin%valence_states%state)
1219 : end if
1220 494 : if(allocated( paw_setupin%radial_grid)) then
1221 494 : LIBPAW_DATATYPE_DEALLOCATE(paw_setupin%radial_grid)
1222 : end if
1223 :
1224 494 : end subroutine paw_setup_free
1225 : !!***
1226 :
1227 : !-------------------------------------------------------------------------
1228 :
1229 : !!****f* m_pawxmlps/paw_setup_copy
1230 : !! NAME
1231 : !! paw_setup_copy
1232 : !!
1233 : !! FUNCTION
1234 : !! Copy a paw_setup datastructure into another
1235 : !!
1236 : !! INPUTS
1237 : !!
1238 : !! paw_setupin<paw_setup_type>=input paw_setup datastructure
1239 : !!
1240 : !! OUTPUT
1241 : !! paw_setupout<paw_setup_type>=output paw_setup datastructure
1242 : !!
1243 : !! SOURCE
1244 :
1245 0 : subroutine paw_setup_copy(paw_setupin,paw_setupout)
1246 :
1247 : !Arguments ------------------------------------
1248 : !scalars
1249 : type(paw_setup_t),intent(in) :: paw_setupin
1250 : type(paw_setup_t),intent(out) :: paw_setupout
1251 :
1252 : !Local variables-------------------------------
1253 : !scalars
1254 : integer :: ii,sz1,sz2
1255 :
1256 : ! *********************************************************************
1257 :
1258 : !scalars
1259 0 : paw_setupout%version=paw_setupin%version
1260 0 : paw_setupout%tread=paw_setupin%tread
1261 0 : paw_setupout%ngrid=paw_setupin%ngrid
1262 0 : paw_setupout%idgrid=paw_setupin%idgrid
1263 0 : paw_setupout%optortho=paw_setupin%optortho
1264 0 : paw_setupout%rpaw=paw_setupin%rpaw
1265 0 : paw_setupout%ekin_core=paw_setupin%ekin_core
1266 0 : paw_setupout%ex_cc=paw_setupin%ex_cc
1267 0 : paw_setupout%lamb_shielding=paw_setupin%lamb_shielding
1268 0 : paw_setupout%atom%tread=paw_setupin%atom%tread
1269 0 : paw_setupout%atom%symbol=paw_setupin%atom%symbol
1270 0 : paw_setupout%atom%znucl=paw_setupin%atom%znucl
1271 0 : paw_setupout%atom%zion=paw_setupin%atom%zion
1272 0 : paw_setupout%atom%zval=paw_setupin%atom%zval
1273 0 : paw_setupout%xc_functional%tread=paw_setupin%xc_functional%tread
1274 0 : paw_setupout%xc_functional%functionaltype=paw_setupin%xc_functional%functionaltype
1275 0 : paw_setupout%xc_functional%name=paw_setupin%xc_functional%name
1276 0 : paw_setupout%generator%tread=paw_setupin%generator%tread
1277 0 : paw_setupout%generator%gen=paw_setupin%generator%gen
1278 0 : paw_setupout%generator%name=paw_setupin%generator%name
1279 0 : paw_setupout%valence_states%tread=paw_setupin%valence_states%tread
1280 0 : paw_setupout%valence_states%nval=paw_setupin%valence_states%nval
1281 0 : paw_setupout%shape_function%tread=paw_setupin%shape_function%tread
1282 0 : paw_setupout%shape_function%gtype=paw_setupin%shape_function%gtype
1283 0 : paw_setupout%shape_function%grid=paw_setupin%shape_function%grid
1284 0 : paw_setupout%shape_function%rc=paw_setupin%shape_function%rc
1285 0 : paw_setupout%shape_function%lamb=paw_setupin%shape_function%lamb
1286 0 : paw_setupout%ae_core_density%tread=paw_setupin%ae_core_density%tread
1287 0 : paw_setupout%ae_core_density%grid=paw_setupin%ae_core_density%grid
1288 0 : paw_setupout%ae_core_density%state=paw_setupin%ae_core_density%state
1289 0 : paw_setupout%pseudo_core_density%tread=paw_setupin%pseudo_core_density%tread
1290 0 : paw_setupout%pseudo_core_density%grid=paw_setupin%pseudo_core_density%grid
1291 0 : paw_setupout%pseudo_core_density%state=paw_setupin%pseudo_core_density%state
1292 0 : paw_setupout%pseudo_valence_density%tread=paw_setupin%pseudo_valence_density%tread
1293 0 : paw_setupout%pseudo_valence_density%grid=paw_setupin%pseudo_valence_density%grid
1294 0 : paw_setupout%pseudo_valence_density%state=paw_setupin%pseudo_valence_density%state
1295 0 : paw_setupout%zero_potential%tread=paw_setupin%zero_potential%tread
1296 0 : paw_setupout%zero_potential%grid=paw_setupin%zero_potential%grid
1297 0 : paw_setupout%zero_potential%state=paw_setupin%zero_potential%state
1298 0 : paw_setupout%LDA_minus_half_potential%tread=paw_setupin%LDA_minus_half_potential%tread
1299 0 : paw_setupout%LDA_minus_half_potential%grid=paw_setupin%LDA_minus_half_potential%grid
1300 0 : paw_setupout%LDA_minus_half_potential%state=paw_setupin%LDA_minus_half_potential%state
1301 : paw_setupout%ae_core_kinetic_energy_density%tread=&
1302 0 : & paw_setupin%ae_core_kinetic_energy_density%tread
1303 : paw_setupout%ae_core_kinetic_energy_density%grid=&
1304 0 : & paw_setupin%ae_core_kinetic_energy_density%grid
1305 : paw_setupout%ae_core_kinetic_energy_density%state=&
1306 0 : & paw_setupin%ae_core_kinetic_energy_density%state
1307 : paw_setupout%pseudo_core_kinetic_energy_density%tread=&
1308 0 : & paw_setupin%pseudo_core_kinetic_energy_density%tread
1309 : paw_setupout%pseudo_core_kinetic_energy_density%grid=&
1310 0 : & paw_setupin%pseudo_core_kinetic_energy_density%grid
1311 : paw_setupout%pseudo_core_kinetic_energy_density%state=&
1312 0 : & paw_setupin%pseudo_core_kinetic_energy_density%state
1313 : paw_setupout%kresse_joubert_local_ionic_potential%tread=&
1314 0 : & paw_setupin%kresse_joubert_local_ionic_potential%tread
1315 : paw_setupout%kresse_joubert_local_ionic_potential%grid=&
1316 0 : & paw_setupin%kresse_joubert_local_ionic_potential%grid
1317 : paw_setupout%kresse_joubert_local_ionic_potential%state=&
1318 0 : & paw_setupin%kresse_joubert_local_ionic_potential%state
1319 : paw_setupout%blochl_local_ionic_potential%tread=&
1320 0 : & paw_setupin%blochl_local_ionic_potential%tread
1321 : paw_setupout%blochl_local_ionic_potential%grid=&
1322 0 : & paw_setupin%blochl_local_ionic_potential%grid
1323 : paw_setupout%blochl_local_ionic_potential%state=&
1324 0 : & paw_setupin%blochl_local_ionic_potential%state
1325 0 : paw_setupout%kinetic_energy_differences%tread=paw_setupin%kinetic_energy_differences%tread
1326 0 : paw_setupout%kinetic_energy_differences%grid=paw_setupin%kinetic_energy_differences%grid
1327 0 : paw_setupout%kinetic_energy_differences%state=paw_setupin%kinetic_energy_differences%state
1328 0 : paw_setupout%exact_exchange_matrix%tread=paw_setupin%exact_exchange_matrix%tread
1329 : ! allocatable arrays
1330 0 : if (allocated(paw_setupin%shape_function%data)) then
1331 0 : sz1=size(paw_setupin%shape_function%data,1)
1332 0 : sz2=size(paw_setupin%shape_function%data,2)
1333 0 : LIBPAW_ALLOCATE(paw_setupout%shape_function%data,(sz1,sz2))
1334 0 : paw_setupout%shape_function%data=paw_setupin%shape_function%data
1335 : end if
1336 0 : if (allocated(paw_setupin%ae_core_density%data)) then
1337 0 : sz1=size(paw_setupin%ae_core_density%data,1)
1338 0 : LIBPAW_ALLOCATE(paw_setupout%ae_core_density%data,(sz1))
1339 0 : paw_setupout%ae_core_density%data=paw_setupin%ae_core_density%data
1340 : end if
1341 0 : if (allocated(paw_setupin%pseudo_core_density%data)) then
1342 0 : sz1=size(paw_setupin%pseudo_core_density%data,1)
1343 0 : LIBPAW_ALLOCATE(paw_setupout%pseudo_core_density%data,(sz1))
1344 0 : paw_setupout%pseudo_core_density%data=paw_setupin%pseudo_core_density%data
1345 : end if
1346 0 : if (allocated(paw_setupin%pseudo_valence_density%data)) then
1347 0 : sz1=size(paw_setupin%pseudo_valence_density%data,1)
1348 0 : LIBPAW_ALLOCATE(paw_setupout%pseudo_valence_density%data,(sz1))
1349 0 : paw_setupout%pseudo_valence_density%data=paw_setupin%pseudo_valence_density%data
1350 : end if
1351 0 : if (allocated(paw_setupin%zero_potential%data)) then
1352 0 : sz1=size(paw_setupin%zero_potential%data,1)
1353 0 : LIBPAW_ALLOCATE(paw_setupout%zero_potential%data,(sz1))
1354 0 : paw_setupout%zero_potential%data=paw_setupin%zero_potential%data
1355 : end if
1356 0 : if (allocated(paw_setupin%LDA_minus_half_potential%data)) then
1357 0 : sz1=size(paw_setupin%LDA_minus_half_potential%data,1)
1358 0 : LIBPAW_ALLOCATE(paw_setupout%LDA_minus_half_potential%data,(sz1))
1359 0 : paw_setupout%LDA_minus_half_potential%data=paw_setupin%LDA_minus_half_potential%data
1360 : end if
1361 0 : if (allocated(paw_setupin%ae_core_kinetic_energy_density%data)) then
1362 0 : sz1=size(paw_setupin%ae_core_kinetic_energy_density%data,1)
1363 0 : LIBPAW_ALLOCATE(paw_setupout%ae_core_kinetic_energy_density%data,(sz1))
1364 0 : paw_setupout%ae_core_kinetic_energy_density%data=paw_setupin%ae_core_kinetic_energy_density%data
1365 : end if
1366 0 : if (allocated(paw_setupin%pseudo_core_kinetic_energy_density%data)) then
1367 0 : sz1=size(paw_setupin%pseudo_core_kinetic_energy_density%data,1)
1368 0 : LIBPAW_ALLOCATE(paw_setupout%pseudo_core_kinetic_energy_density%data,(sz1))
1369 0 : paw_setupout%pseudo_core_kinetic_energy_density%data=paw_setupin%pseudo_core_kinetic_energy_density%data
1370 : end if
1371 0 : if (allocated(paw_setupin%kresse_joubert_local_ionic_potential%data)) then
1372 0 : sz1=size(paw_setupin%kresse_joubert_local_ionic_potential%data,1)
1373 0 : LIBPAW_ALLOCATE(paw_setupout%kresse_joubert_local_ionic_potential%data,(sz1))
1374 0 : paw_setupout%kresse_joubert_local_ionic_potential%data=paw_setupin%kresse_joubert_local_ionic_potential%data
1375 : end if
1376 0 : if (allocated(paw_setupin%blochl_local_ionic_potential%data)) then
1377 0 : sz1=size(paw_setupin%blochl_local_ionic_potential%data,1)
1378 0 : LIBPAW_ALLOCATE(paw_setupout%blochl_local_ionic_potential%data,(sz1))
1379 0 : paw_setupout%blochl_local_ionic_potential%data=paw_setupin%blochl_local_ionic_potential%data
1380 : end if
1381 0 : if (allocated(paw_setupin%exact_exchange_matrix%data)) then
1382 0 : sz1=size(paw_setupin%exact_exchange_matrix%data,1)
1383 0 : LIBPAW_ALLOCATE(paw_setupout%exact_exchange_matrix%data,(sz1))
1384 0 : paw_setupout%exact_exchange_matrix%data=paw_setupin%exact_exchange_matrix%data
1385 : end if
1386 0 : if (allocated(paw_setupin%kinetic_energy_differences%data)) then
1387 0 : sz1=size(paw_setupin%kinetic_energy_differences%data,1)
1388 0 : LIBPAW_ALLOCATE(paw_setupout%kinetic_energy_differences%data,(sz1))
1389 0 : paw_setupout%kinetic_energy_differences%data=paw_setupin%kinetic_energy_differences%data
1390 : end if
1391 0 : if(allocated( paw_setupin%radial_grid)) then
1392 0 : sz1=size(paw_setupin%radial_grid,1)
1393 0 : LIBPAW_DATATYPE_ALLOCATE(paw_setupout%radial_grid,(sz1))
1394 0 : paw_setupout%radial_grid=paw_setupin%radial_grid
1395 : end if
1396 0 : if(allocated(paw_setupin%valence_states%state)) then
1397 0 : sz1=size(paw_setupin%valence_states%state,1)
1398 0 : LIBPAW_DATATYPE_ALLOCATE(paw_setupout%valence_states%state,(sz1))
1399 0 : paw_setupout%valence_states%state=paw_setupin%valence_states%state
1400 : end if
1401 :
1402 0 : if (allocated( paw_setupin%ae_partial_wave)) then
1403 0 : sz1=size(paw_setupin%ae_partial_wave,1)
1404 0 : LIBPAW_DATATYPE_ALLOCATE(paw_setupout%ae_partial_wave,(sz1))
1405 0 : do ii=1,paw_setupin%valence_states%nval
1406 0 : paw_setupout%ae_partial_wave(ii)%tread=paw_setupin%ae_partial_wave(ii)%tread
1407 0 : paw_setupout%ae_partial_wave(ii)%grid=paw_setupin%ae_partial_wave(ii)%grid
1408 0 : paw_setupout%ae_partial_wave(ii)%state=paw_setupin%ae_partial_wave(ii)%state
1409 0 : if(allocated( paw_setupin%ae_partial_wave(ii)%data)) then
1410 0 : sz1=size(paw_setupin%ae_partial_wave(ii)%data,1)
1411 0 : LIBPAW_ALLOCATE(paw_setupout%ae_partial_wave(ii)%data,(sz1))
1412 0 : paw_setupout%ae_partial_wave(ii)%data=paw_setupin%ae_partial_wave(ii)%data
1413 : end if
1414 : end do
1415 : end if
1416 0 : if (allocated( paw_setupin%pseudo_partial_wave)) then
1417 0 : sz1=size(paw_setupin%pseudo_partial_wave,1)
1418 0 : LIBPAW_DATATYPE_ALLOCATE(paw_setupout%pseudo_partial_wave,(sz1))
1419 0 : do ii=1,paw_setupin%valence_states%nval
1420 0 : paw_setupout%pseudo_partial_wave(ii)%tread=paw_setupin%pseudo_partial_wave(ii)%tread
1421 0 : paw_setupout%pseudo_partial_wave(ii)%grid=paw_setupin%pseudo_partial_wave(ii)%grid
1422 0 : paw_setupout%pseudo_partial_wave(ii)%state=paw_setupin%pseudo_partial_wave(ii)%state
1423 0 : if(allocated( paw_setupin%pseudo_partial_wave(ii)%data)) then
1424 0 : sz1=size(paw_setupin%pseudo_partial_wave(ii)%data,1)
1425 0 : LIBPAW_ALLOCATE(paw_setupout%pseudo_partial_wave(ii)%data,(sz1))
1426 0 : paw_setupout%pseudo_partial_wave(ii)%data=paw_setupin%pseudo_partial_wave(ii)%data
1427 : end if
1428 : end do
1429 : end if
1430 0 : if (allocated( paw_setupin%projector_function)) then
1431 0 : sz1=size(paw_setupin%projector_function,1)
1432 0 : LIBPAW_DATATYPE_ALLOCATE(paw_setupout%projector_function,(sz1))
1433 0 : do ii=1,paw_setupin%valence_states%nval
1434 0 : paw_setupout%projector_function(ii)%tread=paw_setupin%projector_function(ii)%tread
1435 0 : paw_setupout%projector_function(ii)%grid=paw_setupin%projector_function(ii)%grid
1436 0 : paw_setupout%projector_function(ii)%state=paw_setupin%projector_function(ii)%state
1437 0 : if(allocated( paw_setupin%projector_function(ii)%data)) then
1438 0 : sz1=size(paw_setupin%projector_function(ii)%data,1)
1439 0 : LIBPAW_ALLOCATE(paw_setupout%projector_function(ii)%data,(sz1))
1440 0 : paw_setupout%projector_function(ii)%data=paw_setupin%projector_function(ii)%data
1441 : end if
1442 : end do
1443 : end if
1444 0 : if (allocated( paw_setupin%projector_fit)) then
1445 0 : sz1=size(paw_setupin%projector_fit,1)
1446 0 : LIBPAW_DATATYPE_ALLOCATE(paw_setupout%projector_fit,(sz1))
1447 0 : do ii=1,paw_setupin%valence_states%nval
1448 0 : paw_setupout%projector_fit(ii)%tread=paw_setupin%projector_fit(ii)%tread
1449 0 : paw_setupout%projector_fit(ii)%ngauss=paw_setupin%projector_fit(ii)%ngauss
1450 0 : paw_setupout%projector_fit(ii)%state=paw_setupin%projector_fit(ii)%state
1451 0 : paw_setupout%projector_fit(ii)%factors=paw_setupin%projector_fit(ii)%factors
1452 0 : paw_setupout%projector_fit(ii)%expos=paw_setupin%projector_fit(ii)%expos
1453 : end do
1454 : end if
1455 :
1456 0 : end subroutine paw_setup_copy
1457 : !!***
1458 :
1459 : !-------------------------------------------------------------------------
1460 :
1461 : !!****f* m_pawxmlps/paw_rdfromline
1462 : !! NAME
1463 : !! paw_rdfromline
1464 : !!
1465 : !! FUNCTION
1466 : !! Read the value of a keyword from a XML line
1467 : !!
1468 : !! INPUTS
1469 : !! keyword= keyword which value has to be read
1470 : !! line= string from which the data are read (line from a XML)
1471 : !!
1472 : !! OUTPUT
1473 : !! ierr= error code
1474 : !! output= (string) value of the keyword
1475 : !!
1476 : !! SOURCE
1477 :
1478 37913 : subroutine paw_rdfromline(keyword,line,output,ierr)
1479 :
1480 : !Arguments ---------------------------------------------
1481 : character(len=*), intent(in) :: keyword,line
1482 : character(len=*), intent(out) :: output
1483 : integer, intent(out) :: ierr
1484 : !Local variables ---------------------------------------
1485 37913 : character(len=len(line)) :: temp
1486 : integer :: pos,pos2
1487 :
1488 : ! *********************************************************************
1489 :
1490 37913 : ierr=1;output=""
1491 37913 : pos=index(line,trim(keyword))
1492 37913 : if (pos>0) then
1493 33463 : temp=line(pos+len_trim(keyword):len_trim(line))
1494 33463 : pos=index(temp,char(34))
1495 33463 : if (pos>0) then
1496 33463 : pos2=index(temp(pos+1:len_trim(temp)),char(34))
1497 33463 : if (pos2>0) then
1498 33463 : output=temp(pos+1:pos+pos2-1)
1499 : end if
1500 : end if
1501 : end if
1502 :
1503 37913 : end subroutine paw_rdfromline
1504 : !!***
1505 :
1506 : !-------------------------------------------------------------------------
1507 :
1508 : !!****f* m_pawxmlps/rdpawpsxml_header
1509 : !! NAME
1510 : !! rdpawpsxml_header
1511 : !!
1512 : !! FUNCTION
1513 : !! Read the header of a PAW pseudopotential XML file generated by AtomPAW
1514 : !!
1515 : !! INPUTS
1516 : !! filename= input file name (atomicdata XML)
1517 : !!
1518 : !! OUTPUT
1519 : !! paw_setup=pseudopotential data structure
1520 : !!
1521 : !! SOURCE
1522 :
1523 188 : subroutine rdpawpsxml_header(ecut_tmp,filename,paw_setup)
1524 :
1525 : !Arguments ---------------------------------------------
1526 :
1527 : character (len=fnlen),intent(in) :: filename
1528 : real(dp), intent(inout) :: ecut_tmp(3,2)
1529 : type(paw_setup_t),intent(inout) :: paw_setup
1530 : !Local variables ---------------------------------------
1531 : integer :: funit,ii,ir,igrid,ival,ierr,ishpf,lmax,mesh_size
1532 : logical :: endfile,found
1533 : character(len=100) :: msg
1534 : character (len=XML_RECL) :: line,readline
1535 : character (len=XML_RECL) :: strg
1536 : character (len=30) :: strg1
1537 : real(dp) :: rc(6)
1538 188 : real(dp), allocatable :: shpf(:,:)
1539 188 : type(state_t), pointer :: valstate (:)
1540 188 : type(radial_grid_t), pointer :: grids (:)
1541 :
1542 : ! *************************************************************************
1543 :
1544 : !Open the atomicdata XML file for reading
1545 188 : open(newunit=funit,file=filename,form='formatted',status='old', recl=XML_RECL)
1546 :
1547 : !Start a reading loop
1548 188 : endfile=.false.
1549 188 : found=.false.
1550 188 : paw_setup%rpaw=-1.d0
1551 188 : rc=-1.d0
1552 :
1553 219369 : do while ((.not.endfile).and.(.not.found))
1554 219182 : read(funit,'(a)',err=10,end=10) readline
1555 219182 : line=adjustl(readline);goto 20
1556 0 : 10 line="";endfile=.true.
1557 : 20 continue
1558 :
1559 : ! --Read VERSION
1560 219182 : if ((line(1:10)=='<paw_setup').or.(line(1:12)=='<paw_dataset')) then
1561 188 : paw_setup%tread=.true.
1562 188 : igrid=0;ishpf=0
1563 2068 : LIBPAW_DATATYPE_ALLOCATE(grids,(10))
1564 :
1565 188 : call paw_rdfromline(" version",line,strg,ierr)
1566 188 : paw_setup%version=trim(strg)
1567 188 : cycle
1568 : end if
1569 :
1570 : ! --Read TITLE, ATOMIC CHARGE AND CORE CHARGE
1571 218994 : if (line(1:6)=='<atom ') then
1572 188 : paw_setup%atom%tread=.true.
1573 188 : call paw_rdfromline(" symbol",line,strg,ierr)
1574 188 : paw_setup%atom%symbol=trim(strg)
1575 188 : call paw_rdfromline(" Z",line,strg,ierr)
1576 188 : if (len(trim(strg))<=30) then
1577 188 : strg1=trim(strg)
1578 188 : read(unit=strg1,fmt=*) paw_setup%atom%znucl
1579 : else
1580 0 : read(unit=strg,fmt=*) paw_setup%atom%znucl
1581 : end if
1582 188 : call paw_rdfromline(" core",line,strg,ierr)
1583 188 : if (len(trim(strg))<=30) then
1584 188 : strg1=trim(strg)
1585 188 : read(unit=strg1,fmt=*) paw_setup%atom%zion
1586 : else
1587 0 : read(unit=strg,fmt=*) paw_setup%atom%zion
1588 : end if
1589 188 : call paw_rdfromline(" valence",line,strg,ierr)
1590 188 : if (len(trim(strg))<=30) then
1591 188 : strg1=trim(strg)
1592 188 : read(unit=strg1,fmt=*) paw_setup%atom%zval
1593 : else
1594 0 : read(unit=strg,fmt=*) paw_setup%atom%zval
1595 : end if
1596 : cycle
1597 : end if
1598 :
1599 : ! --Read Ecut and Ecutdg
1600 218806 : if (line(1:8)=='<pw_ecut') then
1601 155 : call paw_rdfromline(" low",line,strg,ierr)
1602 155 : if (len(trim(strg))<=30) then
1603 155 : strg1=trim(strg)
1604 155 : read(unit=strg1,fmt=*) ecut_tmp(1,1)
1605 : else
1606 0 : read(unit=strg,fmt=*) ecut_tmp(1,1)
1607 : end if
1608 155 : call paw_rdfromline(" medium",line,strg,ierr)
1609 155 : if (len(trim(strg))<=30) then
1610 155 : strg1=trim(strg)
1611 155 : read(unit=strg1,fmt=*) ecut_tmp(2,1)
1612 : else
1613 0 : read(unit=strg,fmt=*) ecut_tmp(2,1)
1614 : end if
1615 155 : call paw_rdfromline(" high",line,strg,ierr)
1616 155 : if (len(trim(strg))<=30) then
1617 155 : strg1=trim(strg)
1618 155 : read(unit=strg1,fmt=*) ecut_tmp(3,1)
1619 : else
1620 0 : read(unit=strg,fmt=*) ecut_tmp(3,1)
1621 : end if
1622 : cycle
1623 : end if
1624 :
1625 : ! --Read EXCHANGE-CORRELATION TYPE
1626 218651 : if (line(1:14)=='<xc_functional') then
1627 188 : paw_setup%xc_functional%tread=.true.
1628 188 : call paw_rdfromline(" type",line,strg,ierr)
1629 188 : paw_setup%xc_functional%functionaltype = trim(strg)
1630 188 : call paw_rdfromline(" name",line,strg,ierr)
1631 188 : paw_setup%xc_functional%name= trim(strg)
1632 188 : cycle
1633 : end if
1634 :
1635 : ! --Read GENERATOR
1636 218463 : if (line(1:10)=='<generator') then
1637 188 : paw_setup%generator%tread=.true.
1638 188 : call paw_rdfromline(" type",line,strg,ierr)
1639 188 : paw_setup%generator%gen = trim(strg)
1640 188 : call paw_rdfromline(" name",line,strg,ierr)
1641 188 : paw_setup%generator%name= trim(strg)
1642 188 : cycle
1643 : end if
1644 :
1645 : ! --Read PAW RADIUS
1646 218275 : if (line(1:11)=='<PAW_radius') then
1647 1 : call paw_rdfromline(" rpaw",line,strg,ierr)
1648 1 : if (len(trim(strg))<=30) then
1649 1 : strg1=trim(strg)
1650 1 : read(unit=strg1,fmt=*) paw_setup%rpaw
1651 : else
1652 0 : read(unit=strg,fmt=*) paw_setup%rpaw
1653 : end if
1654 : cycle
1655 : end if
1656 218274 : if (line(1:11)=='<paw_radius') then
1657 178 : call paw_rdfromline(" rc",line,strg,ierr)
1658 178 : if (len(trim(strg))<=30) then
1659 178 : strg1=trim(strg)
1660 178 : read(unit=strg1,fmt=*) paw_setup%rpaw
1661 : else
1662 0 : read(unit=strg,fmt=*) paw_setup%rpaw
1663 : end if
1664 : cycle
1665 : end if
1666 :
1667 : ! --Read BASIS SIZE, ORBITALS, RC AND OCCUPATIONS/STATE IDs
1668 218096 : if (line(1:16)=='<valence_states>') then
1669 188 : paw_setup%valence_states%tread=.true.
1670 9588 : LIBPAW_DATATYPE_ALLOCATE(valstate,(50))
1671 1042 : ival=0
1672 1042 : lmax=0
1673 1230 : do while (line(1:17)/='</valence_states>')
1674 1042 : read(funit,'(a)') readline;line=adjustl(readline)
1675 1230 : if (line(1:6)=='<state') then
1676 854 : ival=ival+1
1677 854 : if (ival>50) then
1678 0 : close(funit)
1679 0 : msg="Error in rdpawps1xml: basis size too large (>50)!"
1680 0 : LIBPAW_ERROR(msg)
1681 : end if
1682 854 : call paw_rdfromline(" n",line,strg,ierr)
1683 854 : if (strg == "" ) then
1684 390 : valstate(ival)%nn=-1
1685 : else
1686 464 : if (len(trim(strg))<=30) then
1687 464 : strg1=trim(strg)
1688 464 : read(unit=strg1,fmt=*) valstate(ival)%nn
1689 : else
1690 0 : read(unit=strg,fmt=*) valstate(ival)%nn
1691 : end if
1692 : end if
1693 854 : call paw_rdfromline(" l",line,strg,ierr)
1694 854 : if (len(trim(strg))<=30) then
1695 854 : strg1=trim(strg)
1696 854 : read(unit=strg1,fmt=*) valstate(ival)%ll
1697 : else
1698 0 : read(unit=strg,fmt=*) valstate(ival)%ll
1699 : end if
1700 854 : if(valstate(ival)%ll>lmax) lmax=valstate(ival)%ll
1701 854 : call paw_rdfromline(" f",line,strg,ierr)
1702 854 : if (strg == "" ) then
1703 390 : valstate(ival)%ff=-1.d0
1704 : else
1705 464 : if (len(trim(strg))<=30) then
1706 464 : strg1=trim(strg)
1707 464 : read(unit=strg1,fmt=*) valstate(ival)%ff
1708 : else
1709 0 : read(unit=strg,fmt=*) valstate(ival)%ff
1710 : end if
1711 : end if
1712 854 : call paw_rdfromline(" rc",line,strg,ierr)
1713 854 : if (len(trim(strg))<=30) then
1714 854 : strg1=trim(strg)
1715 854 : read(unit=strg1,fmt=*) valstate(ival)%rc
1716 : else
1717 0 : read(unit=strg,fmt=*) valstate(ival)%rc
1718 : end if
1719 854 : call paw_rdfromline(" e",line,strg,ierr)
1720 854 : if (len(trim(strg))<=30) then
1721 854 : strg1=trim(strg)
1722 854 : read(unit=strg1,fmt=*) valstate(ival)%ee
1723 : else
1724 0 : read(unit=strg,fmt=*) valstate(ival)%ee
1725 : end if
1726 854 : call paw_rdfromline(" id",line,strg,ierr)
1727 854 : valstate(ival)%id = trim(strg)
1728 : end if
1729 : end do
1730 : cycle
1731 : end if
1732 :
1733 : ! --Read MESH_STEP AND NUMBER OF POINTS
1734 217908 : if (line(1:12)=='<radial_grid')then
1735 215 : igrid=igrid+1
1736 215 : call paw_rdfromline(" eq",line,strg,ierr)
1737 215 : grids(igrid)%eq = trim(strg)
1738 215 : call paw_rdfromline(" a",line,strg,ierr)
1739 215 : if (strg == "" ) then
1740 0 : grids(igrid)%aa=0.d0
1741 : else
1742 215 : if (len(trim(strg))<=30) then
1743 215 : strg1=trim(strg)
1744 215 : read(unit=strg1,fmt=*) grids(igrid)%aa
1745 : else
1746 0 : read(unit=strg,fmt=*) grids(igrid)%aa
1747 : end if
1748 : end if
1749 215 : call paw_rdfromline(" n",line,strg,ierr)
1750 215 : if (strg == "" ) then
1751 214 : grids(igrid)%nn=0
1752 : else
1753 1 : if (len(trim(strg))<=30) then
1754 1 : strg1=trim(strg)
1755 1 : read(unit=strg1,fmt=*) grids(igrid)%nn
1756 : else
1757 0 : read(unit=strg,fmt=*) grids(igrid)%nn
1758 : end if
1759 : end if
1760 215 : call paw_rdfromline(" d",line,strg,ierr)
1761 215 : if (strg == "" ) then
1762 1 : grids(igrid)%dd=0.d0
1763 : else
1764 214 : if (len(trim(strg))<=30) then
1765 214 : strg1=trim(strg)
1766 214 : read(unit=strg1,fmt=*) grids(igrid)%dd
1767 : else
1768 0 : read(unit=strg,fmt=*) grids(igrid)%dd
1769 : end if
1770 : end if
1771 215 : call paw_rdfromline(" b",line,strg,ierr)
1772 215 : if (strg == "" ) then
1773 215 : grids(igrid)%bb=0.d0
1774 : else
1775 0 : if (len(trim(strg))<=30) then
1776 0 : strg1=trim(strg)
1777 0 : read(unit=strg1,fmt=*) grids(igrid)%bb
1778 : else
1779 0 : read(unit=strg,fmt=*) grids(igrid)%bb
1780 : end if
1781 : end if
1782 215 : call paw_rdfromline("istart",line,strg,ierr)
1783 215 : if (len(trim(strg))<=30) then
1784 215 : strg1=trim(strg)
1785 215 : read(unit=strg1,fmt=*) grids(igrid)%istart
1786 : else
1787 0 : read(unit=strg,fmt=*) grids(igrid)%istart
1788 : end if
1789 215 : call paw_rdfromline("iend",line,strg,ierr)
1790 215 : if (len(trim(strg))<=30) then
1791 215 : strg1=trim(strg)
1792 215 : read(unit=strg1,fmt=*) grids(igrid)%iend
1793 : else
1794 0 : read(unit=strg,fmt=*) grids(igrid)%iend
1795 : end if
1796 215 : call paw_rdfromline(" id",line,strg,ierr)
1797 215 : grids(igrid)%id = trim(strg)
1798 215 : if(igrid>10)then
1799 0 : close(funit)
1800 0 : msg="igrid>10"
1801 0 : LIBPAW_ERROR(msg)
1802 : end if
1803 : cycle
1804 : end if
1805 :
1806 : ! --Read SHAPE TYPE
1807 217880 : if (line(1:15)=='<shape_function') then
1808 192 : paw_setup%shape_function%tread=.true.
1809 192 : call paw_rdfromline(" type",line,strg,ierr)
1810 192 : paw_setup%shape_function%gtype = trim(strg)
1811 192 : call paw_rdfromline(" rc",line,strg,ierr)
1812 192 : if (strg /= "" ) then
1813 187 : if (len(trim(strg))<=30) then
1814 187 : strg1=trim(strg)
1815 187 : read(unit=strg1,fmt=*) paw_setup%shape_function%rc
1816 : else
1817 0 : read(unit=strg,fmt=*) paw_setup%shape_function%rc
1818 : end if
1819 : end if
1820 192 : call paw_rdfromline(" lamb",line,strg,ierr)
1821 192 : if (strg == "" ) then
1822 192 : paw_setup%shape_function%lamb=0
1823 : else
1824 0 : if (len(trim(strg))<=30) then
1825 0 : strg1=trim(strg)
1826 0 : read(unit=strg1,fmt=*) paw_setup%shape_function%lamb
1827 : else
1828 0 : read(unit=strg,fmt=*) paw_setup%shape_function%lamb
1829 : end if
1830 : end if
1831 192 : found=paw_setup%shape_function%tread
1832 192 : call paw_rdfromline("grid",line,strg,ierr)
1833 192 : paw_setup%shape_function%grid=trim(strg)
1834 192 : if (strg /= "" ) then
1835 5 : paw_setup%shape_function%gtype ="num"
1836 5 : do ii=1,igrid
1837 5 : if(trim(paw_setup%shape_function%grid)==trim(grids(ii)%id)) then
1838 5 : mesh_size=grids(ii)%iend-grids(ii)%istart+1
1839 5 : exit
1840 : end if
1841 : end do
1842 5 : if(.not.allocated(shpf)) then
1843 3 : LIBPAW_ALLOCATE(shpf,(mesh_size,7))
1844 : end if
1845 5 : ishpf=ishpf+1
1846 5 : read(funit,*) (shpf(ir,ishpf),ir=1,mesh_size)
1847 5 : call paw_rdfromline(" l",line,strg,ierr)
1848 5 : if (strg /= "" ) then
1849 5 : found=.false.
1850 5 : if(paw_setup%valence_states%tread) then
1851 5 : if(ishpf==2*lmax+1) found=.true.
1852 : else
1853 0 : write(msg,'(a,a,a)')"the grids and the states must be read before the shapefunction",ch10,&
1854 0 : & "Action: Modify your XML PAW data file"
1855 0 : LIBPAW_ERROR(msg)
1856 : end if
1857 : end if
1858 : end if
1859 : cycle
1860 : end if
1861 :
1862 : ! End of reading loop
1863 : end do
1864 188 : if(ival>0)then
1865 1418 : LIBPAW_DATATYPE_ALLOCATE(paw_setup%valence_states%state,(ival))
1866 188 : paw_setup%valence_states%state(ival)%tread=.true.
1867 188 : paw_setup%valence_states%nval=ival
1868 1042 : do ii=1,ival
1869 1042 : paw_setup%valence_states%state(ii)=valstate(ii)
1870 : end do
1871 : end if
1872 188 : LIBPAW_DATATYPE_DEALLOCATE(valstate)
1873 779 : LIBPAW_DATATYPE_ALLOCATE(paw_setup%radial_grid,(igrid))
1874 188 : paw_setup%radial_grid(igrid)%tread=.true.
1875 188 : paw_setup%ngrid=igrid
1876 403 : do ii=1,igrid
1877 403 : paw_setup%radial_grid(ii)=grids(ii)
1878 : end do
1879 188 : LIBPAW_DATATYPE_DEALLOCATE(grids)
1880 188 : if(allocated(shpf)) then
1881 1 : LIBPAW_DEALLOCATE(shpf)
1882 : end if
1883 188 : close(funit)
1884 :
1885 188 : end subroutine rdpawpsxml_header
1886 : !!***
1887 :
1888 : !-------------------------------------------------------------------------
1889 :
1890 : !!****f* m_pawxmlps/rdpawpsxml
1891 : !! NAME
1892 : !! rdpawpsxml
1893 : !!
1894 : !! FUNCTION
1895 : !! Read the PAW pseudopotential XML file generated by AtomPAW
1896 : !!
1897 : !! INPUTS
1898 : !! filename= input file name (atomicdata XML)
1899 : !!
1900 : !! OUTPUT
1901 : !! paw_setup=pseudopotential data structure
1902 : !!
1903 : !! SOURCE
1904 :
1905 306 : subroutine rdpawpsxml(filename,paw_setup)
1906 :
1907 : !Arguments ---------------------------------------------
1908 : character (len=fnlen),intent(in) :: filename
1909 : type(paw_setup_t),intent(inout) :: paw_setup
1910 : !Local variables ---------------------------------------
1911 : integer :: funit, iaewf,ii,ipswf,iproj,ir,igrid,ival,ierr,ishpf,lmax,mesh_size,igauss,iprojfit
1912 : logical :: endfile,found,endgauss
1913 : character(len=100) :: msg
1914 : character (len=XML_RECL) :: line,readline
1915 : character (len=XML_RECL) :: strg
1916 : character (len=30) :: strg1
1917 : real(dp) :: rc(6)
1918 306 : real(dp), allocatable :: shpf(:,:)
1919 306 : type(state_t), pointer :: valstate (:)
1920 306 : type(radial_grid_t), pointer :: grids (:)
1921 :
1922 : ! *************************************************************************
1923 :
1924 : !Open the atomicdata XML file for reading
1925 306 : open(newunit=funit,file=filename,form='formatted',status='old', recl=XML_RECL)
1926 :
1927 : !Start a reading loop
1928 306 : endfile=.false.
1929 306 : found=.false.
1930 306 : paw_setup%rpaw=-1.d0
1931 2142 : rc=-1.d0
1932 :
1933 334899 : do while ((.not.endfile).and.(.not.found))
1934 334594 : read(funit,'(a)',err=10,end=10) readline
1935 334594 : line=adjustl(readline);goto 20
1936 0 : 10 line="";endfile=.true.
1937 : 20 continue
1938 :
1939 : ! --Read VERSION
1940 334594 : if ((line(1:10)=='<paw_setup').or.(line(1:12)=='<paw_dataset')) then
1941 306 : paw_setup%tread=.true.
1942 306 : igrid=0;ishpf=0
1943 3366 : LIBPAW_DATATYPE_ALLOCATE(grids,(10))
1944 :
1945 306 : call paw_rdfromline(" version",line,strg,ierr)
1946 306 : paw_setup%version=trim(strg)
1947 306 : cycle
1948 : end if
1949 :
1950 : ! --Read TITLE, ATOMIC CHARGE AND CORE CHARGE
1951 334288 : if (line(1:6)=='<atom ') then
1952 306 : paw_setup%atom%tread=.true.
1953 306 : call paw_rdfromline(" symbol",line,strg,ierr)
1954 306 : paw_setup%atom%symbol=trim(strg)
1955 306 : call paw_rdfromline(" Z",line,strg,ierr)
1956 306 : if (len(trim(strg))<=30) then
1957 306 : strg1=trim(strg)
1958 306 : read(unit=strg1,fmt=*) paw_setup%atom%znucl
1959 : else
1960 0 : read(unit=strg,fmt=*) paw_setup%atom%znucl
1961 : end if
1962 306 : call paw_rdfromline(" core",line,strg,ierr)
1963 306 : if (len(trim(strg))<=30) then
1964 306 : strg1=trim(strg)
1965 306 : read(unit=strg1,fmt=*) paw_setup%atom%zion
1966 : else
1967 0 : read(unit=strg,fmt=*) paw_setup%atom%zion
1968 : end if
1969 306 : call paw_rdfromline(" valence",line,strg,ierr)
1970 306 : if (len(trim(strg))<=30) then
1971 306 : strg1=trim(strg)
1972 306 : read(unit=strg1,fmt=*) paw_setup%atom%zval
1973 : else
1974 0 : read(unit=strg,fmt=*) paw_setup%atom%zval
1975 : end if
1976 : cycle
1977 : end if
1978 :
1979 : ! --Read EXCHANGE-CORRELATION TYPE
1980 333982 : if (line(1:14)=='<xc_functional') then
1981 306 : paw_setup%xc_functional%tread=.true.
1982 306 : call paw_rdfromline(" type",line,strg,ierr)
1983 306 : paw_setup%xc_functional%functionaltype = trim(strg)
1984 306 : call paw_rdfromline(" name",line,strg,ierr)
1985 306 : paw_setup%xc_functional%name= trim(strg)
1986 306 : cycle
1987 : end if
1988 :
1989 : ! --Read GENERATOR
1990 333676 : if (line(1:10)=='<generator') then
1991 306 : paw_setup%generator%tread=.true.
1992 306 : call paw_rdfromline(" type",line,strg,ierr)
1993 306 : paw_setup%generator%gen = trim(strg)
1994 306 : call paw_rdfromline(" name",line,strg,ierr)
1995 306 : paw_setup%generator%name= trim(strg)
1996 306 : cycle
1997 : end if
1998 :
1999 : ! --Read core kinetic energy
2000 333370 : if (line(1:12)=='<core_energy') then
2001 305 : call paw_rdfromline(" kinetic",line,strg,ierr)
2002 305 : if (len(trim(strg))<=30) then
2003 305 : strg1=trim(strg)
2004 305 : read(unit=strg1,fmt=*) paw_setup%ekin_core
2005 : else
2006 0 : read(unit=strg,fmt=*) paw_setup%ekin_core
2007 : end if
2008 : cycle
2009 : end if
2010 :
2011 : ! --Read PAW RADIUS
2012 333065 : if (line(1:11)=='<PAW_radius') then
2013 5 : call paw_rdfromline(" rpaw",line,strg,ierr)
2014 5 : if (len(trim(strg))<=30) then
2015 5 : strg1=trim(strg)
2016 5 : read(unit=strg1,fmt=*) paw_setup%rpaw
2017 : else
2018 0 : read(unit=strg,fmt=*) paw_setup%rpaw
2019 : end if
2020 : cycle
2021 : end if
2022 333060 : if (line(1:11)=='<paw_radius') then
2023 269 : call paw_rdfromline(" rc",line,strg,ierr)
2024 269 : if (len(trim(strg))<=30) then
2025 269 : strg1=trim(strg)
2026 269 : read(unit=strg1,fmt=*) paw_setup%rpaw
2027 : else
2028 0 : read(unit=strg,fmt=*) paw_setup%rpaw
2029 : end if
2030 : cycle
2031 : end if
2032 :
2033 : ! --Read BASIS SIZE, ORBITALS, RC AND OCCUPATIONS/STATE IDs
2034 332791 : if (line(1:16)=='<valence_states>') then
2035 306 : paw_setup%valence_states%tread=.true.
2036 15606 : LIBPAW_DATATYPE_ALLOCATE(valstate,(50))
2037 1655 : ival=0
2038 1655 : lmax=0
2039 1961 : do while (line(1:17)/='</valence_states>')
2040 1655 : read(funit,'(a)') readline;line=adjustl(readline)
2041 1961 : if (line(1:6)=='<state') then
2042 1349 : ival=ival+1
2043 1349 : if (ival>50) then
2044 0 : close(funit)
2045 0 : msg="Error in rdpawps1xml: basis size too large (>50)!"
2046 0 : LIBPAW_ERROR(msg)
2047 : end if
2048 1349 : call paw_rdfromline(" n",line,strg,ierr)
2049 1349 : if (strg == "" ) then
2050 571 : valstate(ival)%nn=-1
2051 : else
2052 778 : if (len(trim(strg))<=30) then
2053 778 : strg1=trim(strg)
2054 778 : read(unit=strg1,fmt=*) valstate(ival)%nn
2055 : else
2056 0 : read(unit=strg,fmt=*) valstate(ival)%nn
2057 : end if
2058 : end if
2059 1349 : call paw_rdfromline(" l",line,strg,ierr)
2060 1349 : if (len(trim(strg))<=30) then
2061 1349 : strg1=trim(strg)
2062 1349 : read(unit=strg1,fmt=*) valstate(ival)%ll
2063 : else
2064 0 : read(unit=strg,fmt=*) valstate(ival)%ll
2065 : end if
2066 1349 : if(valstate(ival)%ll>lmax) lmax=valstate(ival)%ll
2067 1349 : call paw_rdfromline(" f",line,strg,ierr)
2068 1349 : if (strg == "" ) then
2069 571 : valstate(ival)%ff=-1.d0
2070 : else
2071 778 : if (len(trim(strg))<=30) then
2072 778 : strg1=trim(strg)
2073 778 : read(unit=strg1,fmt=*) valstate(ival)%ff
2074 : else
2075 0 : read(unit=strg,fmt=*) valstate(ival)%ff
2076 : end if
2077 : end if
2078 1349 : call paw_rdfromline(" rc",line,strg,ierr)
2079 1349 : if (len(trim(strg))<=30) then
2080 1349 : strg1=trim(strg)
2081 1349 : read(unit=strg1,fmt=*) valstate(ival)%rc
2082 : else
2083 0 : read(unit=strg,fmt=*) valstate(ival)%rc
2084 : end if
2085 1349 : call paw_rdfromline(" e",line,strg,ierr)
2086 1349 : if (len(trim(strg))<=30) then
2087 1349 : strg1=trim(strg)
2088 1349 : read(unit=strg1,fmt=*) valstate(ival)%ee
2089 : else
2090 0 : read(unit=strg,fmt=*) valstate(ival)%ee
2091 : end if
2092 1349 : call paw_rdfromline(" id",line,strg,ierr)
2093 1349 : valstate(ival)%id = trim(strg)
2094 : end if
2095 : end do
2096 : cycle
2097 : end if
2098 :
2099 : ! --Read MESH_STEP AND NUMBER OF POINTS
2100 332485 : if (line(1:12)=='<radial_grid')then
2101 435 : igrid=igrid+1
2102 435 : call paw_rdfromline(" eq",line,strg,ierr)
2103 435 : grids(igrid)%eq = trim(strg)
2104 435 : call paw_rdfromline(" a",line,strg,ierr)
2105 435 : if (strg == "" ) then
2106 0 : grids(igrid)%aa=0.d0
2107 : else
2108 435 : if (len(trim(strg))<=30) then
2109 435 : strg1=trim(strg)
2110 435 : read(unit=strg1,fmt=*) grids(igrid)%aa
2111 : else
2112 0 : read(unit=strg,fmt=*) grids(igrid)%aa
2113 : end if
2114 : end if
2115 435 : call paw_rdfromline(" n",line,strg,ierr)
2116 435 : if (strg == "" ) then
2117 433 : grids(igrid)%nn=0
2118 : else
2119 2 : if (len(trim(strg))<=30) then
2120 2 : strg1=trim(strg)
2121 2 : read(unit=strg1,fmt=*) grids(igrid)%nn
2122 : else
2123 0 : read(unit=strg,fmt=*) grids(igrid)%nn
2124 : end if
2125 : end if
2126 435 : call paw_rdfromline(" d",line,strg,ierr)
2127 435 : if (strg == "" ) then
2128 2 : grids(igrid)%dd=0.d0
2129 : else
2130 433 : if (len(trim(strg))<=30) then
2131 433 : strg1=trim(strg)
2132 433 : read(unit=strg1,fmt=*) grids(igrid)%dd
2133 : else
2134 0 : read(unit=strg,fmt=*) grids(igrid)%dd
2135 : end if
2136 : end if
2137 435 : call paw_rdfromline(" b",line,strg,ierr)
2138 435 : if (strg == "" ) then
2139 435 : grids(igrid)%bb=0.d0
2140 : else
2141 0 : if (len(trim(strg))<=30) then
2142 0 : strg1=trim(strg)
2143 0 : read(unit=strg1,fmt=*) grids(igrid)%bb
2144 : else
2145 0 : read(unit=strg,fmt=*) grids(igrid)%bb
2146 : end if
2147 : end if
2148 435 : call paw_rdfromline("istart",line,strg,ierr)
2149 435 : if (len(trim(strg))<=30) then
2150 435 : strg1=trim(strg)
2151 435 : read(unit=strg1,fmt=*) grids(igrid)%istart
2152 : else
2153 0 : read(unit=strg,fmt=*) grids(igrid)%istart
2154 : end if
2155 435 : call paw_rdfromline("iend",line,strg,ierr)
2156 435 : if (len(trim(strg))<=30) then
2157 435 : strg1=trim(strg)
2158 435 : read(unit=strg1,fmt=*) grids(igrid)%iend
2159 : else
2160 0 : read(unit=strg,fmt=*) grids(igrid)%iend
2161 : end if
2162 435 : call paw_rdfromline(" id",line,strg,ierr)
2163 435 : grids(igrid)%id = trim(strg)
2164 435 : if(igrid>10)then
2165 0 : close(funit)
2166 0 : msg="igrid>10"
2167 0 : LIBPAW_ERROR(msg)
2168 : end if
2169 : cycle
2170 : end if
2171 :
2172 : ! --Read SHAPE TYPE
2173 332355 : if (line(1:15)=='<shape_function') then
2174 310 : paw_setup%shape_function%tread=.true.
2175 310 : call paw_rdfromline(" type",line,strg,ierr)
2176 310 : paw_setup%shape_function%gtype = trim(strg)
2177 310 : call paw_rdfromline(" rc",line,strg,ierr)
2178 310 : if (strg /= "" ) then
2179 305 : if (len(trim(strg))<=30) then
2180 305 : strg1=trim(strg)
2181 305 : read(unit=strg1,fmt=*) paw_setup%shape_function%rc
2182 : else
2183 0 : read(unit=strg,fmt=*) paw_setup%shape_function%rc
2184 : end if
2185 : end if
2186 310 : call paw_rdfromline(" lamb",line,strg,ierr)
2187 310 : if (strg == "" ) then
2188 310 : paw_setup%shape_function%lamb=0
2189 : else
2190 0 : if (len(trim(strg))<=30) then
2191 0 : strg1=trim(strg)
2192 0 : read(unit=strg1,fmt=*) paw_setup%shape_function%lamb
2193 : else
2194 0 : read(unit=strg,fmt=*) paw_setup%shape_function%lamb
2195 : end if
2196 : end if
2197 310 : found=paw_setup%shape_function%tread
2198 310 : call paw_rdfromline("grid",line,strg,ierr)
2199 310 : paw_setup%shape_function%grid=trim(strg)
2200 310 : if (strg /= "" ) then
2201 5 : paw_setup%shape_function%gtype ="num"
2202 5 : do ii=1,igrid
2203 5 : if(trim(paw_setup%shape_function%grid)==trim(grids(ii)%id)) then
2204 5 : mesh_size=grids(ii)%iend-grids(ii)%istart+1
2205 5 : exit
2206 : end if
2207 : end do
2208 5 : if(.not.allocated(shpf)) then
2209 3 : LIBPAW_ALLOCATE(shpf,(mesh_size,7))
2210 : end if
2211 5 : ishpf=ishpf+1
2212 5 : read(funit,*) (shpf(ir,ishpf),ir=1,mesh_size)
2213 5 : call paw_rdfromline(" l",line,strg,ierr)
2214 5 : if (strg /= "" ) then
2215 5 : found=.false.
2216 5 : if(paw_setup%valence_states%tread) then
2217 5 : if(ishpf==2*lmax+1) found=.true.
2218 : else
2219 0 : write(msg,'(a,a,a)')"the grids and the states must be read before the shapefunction",ch10,&
2220 0 : & "Action: Modify your XML PAW data file"
2221 0 : LIBPAW_ERROR(msg)
2222 : end if
2223 : end if
2224 : end if
2225 : cycle
2226 : end if
2227 :
2228 : ! End of reading loop
2229 : end do
2230 :
2231 306 : if(igrid==0.or.ival==0) then
2232 0 : write(msg,'(a,a,a)')"the grids and the states must be read before the shapefunction",ch10,&
2233 0 : & "Action: Modify your XML PAW data file"
2234 0 : LIBPAW_ERROR(msg)
2235 : end if
2236 306 : if(ishpf>0)then
2237 4 : LIBPAW_ALLOCATE(paw_setup%shape_function%data,(mesh_size,ishpf))
2238 6 : do ii=1,ishpf
2239 2976 : paw_setup%shape_function%data(:,ii)=shpf(:,ii)
2240 : end do
2241 1 : LIBPAW_DEALLOCATE(shpf)
2242 : end if
2243 :
2244 306 : if(ival>0)then
2245 2267 : LIBPAW_DATATYPE_ALLOCATE(paw_setup%valence_states%state,(ival))
2246 306 : paw_setup%valence_states%state(ival)%tread=.true.
2247 306 : paw_setup%valence_states%nval=ival
2248 1655 : do ii=1,ival
2249 1655 : paw_setup%valence_states%state(ii)=valstate(ii)
2250 : end do
2251 : end if
2252 306 : LIBPAW_DATATYPE_DEALLOCATE(valstate)
2253 306 : if(.not.allocated(paw_setup%ae_partial_wave)) then
2254 2267 : LIBPAW_DATATYPE_ALLOCATE(paw_setup%ae_partial_wave,(paw_setup%valence_states%nval))
2255 : end if
2256 306 : if(.not.allocated(paw_setup%pseudo_partial_wave)) then
2257 2267 : LIBPAW_DATATYPE_ALLOCATE(paw_setup%pseudo_partial_wave,(paw_setup%valence_states%nval))
2258 : end if
2259 306 : if(.not.allocated(paw_setup%projector_function)) then
2260 2267 : LIBPAW_DATATYPE_ALLOCATE(paw_setup%projector_function,(paw_setup%valence_states%nval))
2261 : end if
2262 :
2263 1353 : LIBPAW_DATATYPE_ALLOCATE(paw_setup%radial_grid,(igrid))
2264 306 : paw_setup%radial_grid(igrid)%tread=.true.
2265 306 : paw_setup%ngrid=igrid
2266 741 : do ii=1,igrid
2267 741 : paw_setup%radial_grid(ii)=grids(ii)
2268 : end do
2269 306 : LIBPAW_DATATYPE_DEALLOCATE(grids)
2270 :
2271 : !Start a reading loop
2272 306 : ipswf=0;iaewf=0;iproj=0;iprojfit=0
2273 306 : endfile=.false.
2274 21837 : do while (.not.endfile)
2275 21531 : read(funit,'(a)',err=11,end=11) readline
2276 21225 : line=adjustl(readline);goto 21
2277 306 : 11 line="";endfile=.true.
2278 : 21 continue
2279 :
2280 : ! --Read core density CORE_DENSITY
2281 21531 : if (line(1:16)=='<ae_core_density') then
2282 306 : paw_setup%ae_core_density%tread=.true.
2283 306 : call paw_rdfromline(" grid",line,strg,ierr)
2284 306 : if (strg == "" ) strg = "unknown"
2285 306 : paw_setup%ae_core_density%grid=trim(strg)
2286 364 : do ii=1,paw_setup%ngrid
2287 364 : if(trim(paw_setup%ae_core_density%grid)==trim(paw_setup%radial_grid(ii)%id)) then
2288 306 : mesh_size=paw_setup%radial_grid(ii)%iend-paw_setup%radial_grid(ii)%istart+1
2289 306 : exit
2290 : end if
2291 : end do
2292 306 : call paw_rdfromline(" rc",line,strg,ierr)
2293 306 : if (strg /= "" ) then
2294 253 : if (len(trim(strg))<=30) then
2295 253 : strg1=trim(strg)
2296 253 : read(unit=strg1,fmt=*) rc(1)
2297 : else
2298 0 : read(unit=strg,fmt=*) rc(1)
2299 : end if
2300 : end if
2301 918 : LIBPAW_ALLOCATE(paw_setup%ae_core_density%data,(mesh_size))
2302 : !MGNAG v7[62]
2303 : ! Runtime Error: m_pawxmlps_cpp.f90, line 1657:
2304 : ! Record too long for input bufferProgram terminated by I/O error on unit 9
2305 : ! (File="/home/buildbot/ABINIT_OD/petrus_nag/gmatteo_7.7.1-training/tests/Pspdir/Al.LDA",Formatted,Sequential)
2306 514059 : read(funit,*) (paw_setup%ae_core_density%data(ir),ir=1,mesh_size)
2307 612 : cycle
2308 : end if
2309 :
2310 : ! --Read pseudized core density CORETAIL_DENSITY
2311 21225 : if (line(1:20)=='<pseudo_core_density') then
2312 306 : paw_setup%pseudo_core_density%tread=.true.
2313 306 : call paw_rdfromline(" grid",line,strg,ierr)
2314 306 : if (strg == "" ) strg = "unknown"
2315 306 : paw_setup%pseudo_core_density%grid=trim(strg)
2316 364 : do ii=1,paw_setup%ngrid
2317 364 : if(trim(paw_setup%pseudo_core_density%grid)==trim(paw_setup%radial_grid(ii)%id)) then
2318 306 : mesh_size=paw_setup%radial_grid(ii)%iend-paw_setup%radial_grid(ii)%istart+1
2319 306 : exit
2320 : end if
2321 : end do
2322 306 : call paw_rdfromline(" rc",line,strg,ierr)
2323 306 : if (strg /= "" ) then
2324 269 : if (len(trim(strg))<=30) then
2325 269 : strg1=trim(strg)
2326 269 : read(unit=strg1,fmt=*) rc(2)
2327 : else
2328 0 : read(unit=strg,fmt=*) rc(2)
2329 : end if
2330 : end if
2331 918 : LIBPAW_ALLOCATE(paw_setup%pseudo_core_density%data,(mesh_size))
2332 514059 : read(funit,*) (paw_setup%pseudo_core_density%data(ir),ir=1,mesh_size)
2333 612 : cycle
2334 : end if
2335 :
2336 : ! --Read core density CORE_DENSITY
2337 20919 : if (line(1:31)=='<ae_core_kinetic_energy_density') then
2338 34 : paw_setup%ae_core_kinetic_energy_density%tread=.true.
2339 34 : call paw_rdfromline(" grid",line,strg,ierr)
2340 34 : if (strg == "" ) strg = "unknown"
2341 34 : paw_setup%ae_core_kinetic_energy_density%grid=trim(strg)
2342 34 : do ii=1,paw_setup%ngrid
2343 34 : if(trim(paw_setup%ae_core_kinetic_energy_density%grid)==trim(paw_setup%radial_grid(ii)%id)) then
2344 34 : mesh_size=paw_setup%radial_grid(ii)%iend-paw_setup%radial_grid(ii)%istart+1
2345 34 : exit
2346 : end if
2347 : end do
2348 34 : call paw_rdfromline(" rc",line,strg,ierr)
2349 34 : if (strg /= "" ) then
2350 32 : if (len(trim(strg))<=30) then
2351 32 : strg1=trim(strg)
2352 32 : read(unit=strg1,fmt=*) rc(1)
2353 : else
2354 0 : read(unit=strg,fmt=*) rc(1)
2355 : end if
2356 : end if
2357 102 : LIBPAW_ALLOCATE(paw_setup%ae_core_kinetic_energy_density%data,(mesh_size))
2358 : !MGNAG v7[62]
2359 : ! Runtime Error: m_pawxmlps_cpp.f90, line 1657:
2360 : ! Record too long for input bufferProgram terminated by I/O error on unit 9
2361 : ! (File="/home/buildbot/ABINIT_OD/petrus_nag/gmatteo_7.7.1-training/tests/Pspdir/Al.LDA",Formatted,Sequential)
2362 64962 : read(funit,*) (paw_setup%ae_core_kinetic_energy_density%data(ir),ir=1,mesh_size)
2363 68 : cycle
2364 : end if
2365 :
2366 : ! --Read pseudized core density CORETAIL_DENSITY
2367 20885 : if (line(1:35)=='<pseudo_core_kinetic_energy_density') then
2368 34 : paw_setup%pseudo_core_kinetic_energy_density%tread=.true.
2369 34 : call paw_rdfromline(" grid",line,strg,ierr)
2370 34 : if (strg == "" ) strg = "unknown"
2371 34 : paw_setup%pseudo_core_kinetic_energy_density%grid=trim(strg)
2372 34 : do ii=1,paw_setup%ngrid
2373 34 : if(trim(paw_setup%pseudo_core_kinetic_energy_density%grid)==trim(paw_setup%radial_grid(ii)%id)) then
2374 34 : mesh_size=paw_setup%radial_grid(ii)%iend-paw_setup%radial_grid(ii)%istart+1
2375 34 : exit
2376 : end if
2377 : end do
2378 34 : call paw_rdfromline(" rc",line,strg,ierr)
2379 34 : if (strg /= "" ) then
2380 32 : if (len(trim(strg))<=30) then
2381 32 : strg1=trim(strg)
2382 32 : read(unit=strg1,fmt=*) rc(2)
2383 : else
2384 0 : read(unit=strg,fmt=*) rc(2)
2385 : end if
2386 : end if
2387 102 : LIBPAW_ALLOCATE(paw_setup%pseudo_core_kinetic_energy_density%data,(mesh_size))
2388 64962 : read(funit,*) (paw_setup%pseudo_core_kinetic_energy_density%data(ir),ir=1,mesh_size)
2389 68 : cycle
2390 : end if
2391 :
2392 : ! --Read pseudized valence density PSEUDO_VALENCE_DENSITY
2393 20851 : if (line(1:23)=='<pseudo_valence_density') then
2394 305 : paw_setup%pseudo_valence_density%tread=.true.
2395 305 : call paw_rdfromline(" grid",line,strg,ierr)
2396 305 : if (strg == "" ) strg = "unknown"
2397 305 : paw_setup%pseudo_valence_density%grid=trim(strg)
2398 432 : do ii=1,paw_setup%ngrid
2399 432 : if(trim(paw_setup%pseudo_valence_density%grid)==trim(paw_setup%radial_grid(ii)%id)) then
2400 305 : mesh_size=paw_setup%radial_grid(ii)%iend-paw_setup%radial_grid(ii)%istart+1
2401 305 : exit
2402 : end if
2403 : end do
2404 305 : call paw_rdfromline(" rc",line,strg,ierr)
2405 305 : if (strg /= "" ) then
2406 269 : if (len(trim(strg))<=30) then
2407 269 : strg1=trim(strg)
2408 269 : read(unit=strg1,fmt=*) rc(3)
2409 : else
2410 0 : read(unit=strg,fmt=*) rc(3)
2411 : end if
2412 : end if
2413 915 : LIBPAW_ALLOCATE(paw_setup%pseudo_valence_density%data,(mesh_size))
2414 517598 : read(funit,*) (paw_setup%pseudo_valence_density%data(ir),ir=1,mesh_size)
2415 610 : cycle
2416 : end if
2417 :
2418 : ! --Read Vbare potential VLOCFUN
2419 20546 : if (line(1:15)=='<zero_potential') then
2420 297 : paw_setup%zero_potential%tread=.true.
2421 297 : call paw_rdfromline(" grid",line,strg,ierr)
2422 297 : if (strg == "" ) strg = "unknown"
2423 297 : paw_setup%zero_potential%grid=trim(strg)
2424 351 : do ii=1,paw_setup%ngrid
2425 351 : if(trim(paw_setup%zero_potential%grid)==trim(paw_setup%radial_grid(ii)%id)) then
2426 297 : mesh_size=paw_setup%radial_grid(ii)%iend-paw_setup%radial_grid(ii)%istart+1
2427 297 : exit
2428 : end if
2429 : end do
2430 297 : call paw_rdfromline(" rc",line,strg,ierr)
2431 297 : if (strg /= "" ) then
2432 269 : if (len(trim(strg))<=30) then
2433 269 : strg1=trim(strg)
2434 269 : read(unit=strg1,fmt=*) rc(4)
2435 : else
2436 0 : read(unit=strg,fmt=*) rc(4)
2437 : end if
2438 : end if
2439 891 : LIBPAW_ALLOCATE(paw_setup%zero_potential%data,(mesh_size))
2440 509306 : read(funit,*) (paw_setup%zero_potential%data(ir),ir=1,mesh_size)
2441 594 : cycle
2442 : end if
2443 :
2444 : ! --Read external potential
2445 20249 : if (line(1:25)=='<LDA_minus_half_potential') then
2446 2 : paw_setup%LDA_minus_half_potential%tread=.true.
2447 2 : call paw_rdfromline(" grid",line,strg,ierr)
2448 2 : if (strg == "" ) strg = "unknown"
2449 2 : paw_setup%LDA_minus_half_potential%grid=trim(strg)
2450 2 : do ii=1,paw_setup%ngrid
2451 2 : if(trim(paw_setup%LDA_minus_half_potential%grid)==trim(paw_setup%radial_grid(ii)%id)) then
2452 2 : mesh_size=paw_setup%radial_grid(ii)%iend-paw_setup%radial_grid(ii)%istart+1
2453 2 : exit
2454 : end if
2455 : end do
2456 2 : call paw_rdfromline(" rc",line,strg,ierr)
2457 2 : if (strg /= "" ) then
2458 2 : if (len(trim(strg))<=30) then
2459 2 : strg1=trim(strg)
2460 2 : read(unit=strg1,fmt=*) rc(4)
2461 : else
2462 0 : read(unit=strg,fmt=*) rc(4)
2463 : end if
2464 : end if
2465 6 : LIBPAW_ALLOCATE(paw_setup%LDA_minus_half_potential%data,(mesh_size))
2466 4004 : read(funit,*) (paw_setup%LDA_minus_half_potential%data(ir),ir=1,mesh_size)
2467 4 : cycle
2468 : end if
2469 :
2470 : ! --Read Vloc for Abinit potential VLOC_ION
2471 20247 : if (line(1:37)=='<kresse_joubert_local_ionic_potential') then
2472 15 : paw_setup%kresse_joubert_local_ionic_potential%tread=.true.
2473 15 : call paw_rdfromline(" grid",line,strg,ierr)
2474 15 : if (strg == "" ) strg = "unknown"
2475 15 : paw_setup%kresse_joubert_local_ionic_potential%grid=trim(strg)
2476 45 : do ii=1,paw_setup%ngrid
2477 45 : if(trim(paw_setup%kresse_joubert_local_ionic_potential%grid)==trim(paw_setup%radial_grid(ii)%id)) then
2478 15 : mesh_size=paw_setup%radial_grid(ii)%iend-paw_setup%radial_grid(ii)%istart+1
2479 15 : exit
2480 : end if
2481 : end do
2482 15 : call paw_rdfromline(" rc",line,strg,ierr)
2483 15 : if (strg /= "" ) then
2484 2 : if (len(trim(strg))<=30) then
2485 2 : strg1=trim(strg)
2486 2 : read(unit=strg1,fmt=*) rc(5)
2487 : else
2488 0 : read(unit=strg,fmt=*) rc(5)
2489 : end if
2490 : end if
2491 45 : LIBPAW_ALLOCATE(paw_setup%kresse_joubert_local_ionic_potential%data,(mesh_size))
2492 11528 : read(funit,*) (paw_setup%kresse_joubert_local_ionic_potential%data(ir),ir=1,mesh_size)
2493 30 : cycle
2494 : end if
2495 20232 : if (line(1:29)=='<blochl_local_ionic_potential') then
2496 285 : paw_setup%blochl_local_ionic_potential%tread=.true.
2497 285 : call paw_rdfromline(" grid",line,strg,ierr)
2498 285 : if (strg == "" ) strg = "unknown"
2499 285 : paw_setup%blochl_local_ionic_potential%grid=trim(strg)
2500 330 : do ii=1,paw_setup%ngrid
2501 330 : if(trim(paw_setup%blochl_local_ionic_potential%grid)==trim(paw_setup%radial_grid(ii)%id)) then
2502 285 : mesh_size=paw_setup%radial_grid(ii)%iend-paw_setup%radial_grid(ii)%istart+1
2503 285 : exit
2504 : end if
2505 : end do
2506 285 : call paw_rdfromline(" rc",line,strg,ierr)
2507 285 : if (strg /= "" ) then
2508 267 : if (len(trim(strg))<=30) then
2509 267 : strg1=trim(strg)
2510 267 : read(unit=strg1,fmt=*) rc(6)
2511 : else
2512 0 : read(unit=strg,fmt=*) rc(6)
2513 : end if
2514 : end if
2515 855 : LIBPAW_ALLOCATE(paw_setup%blochl_local_ionic_potential%data,(mesh_size))
2516 501602 : read(funit,*) (paw_setup%blochl_local_ionic_potential%data(ir),ir=1,mesh_size)
2517 570 : cycle
2518 : end if
2519 :
2520 : ! --Read WAVE FUNCTIONS PHI
2521 19947 : if (line(1:16)=='<ae_partial_wave') then
2522 1349 : iaewf=iaewf+1
2523 1349 : paw_setup%ae_partial_wave(iaewf)%tread=.true.
2524 1349 : call paw_rdfromline(" grid",line,strg,ierr)
2525 1349 : if (strg == "" ) strg = "unknown"
2526 1349 : paw_setup%ae_partial_wave(iaewf)%grid=trim(strg)
2527 1349 : call paw_rdfromline(" state",line,strg,ierr)
2528 1349 : paw_setup%ae_partial_wave(iaewf)%state=trim(strg)
2529 1349 : do ii=1,paw_setup%ngrid
2530 1349 : if(trim(paw_setup%ae_partial_wave(iaewf)%grid)==trim(paw_setup%radial_grid(ii)%id)) then
2531 1349 : mesh_size=paw_setup%radial_grid(ii)%iend-paw_setup%radial_grid(ii)%istart+1
2532 1349 : exit
2533 : end if
2534 : end do
2535 4047 : LIBPAW_ALLOCATE(paw_setup%ae_partial_wave(iaewf)%data,(mesh_size))
2536 2250725 : read(funit,*) (paw_setup%ae_partial_wave(iaewf)%data(ir),ir=1,mesh_size)
2537 2698 : cycle
2538 : end if
2539 :
2540 : ! --Read PSEUDO WAVE FUNCTIONS TPHI
2541 18598 : if (line(1:20)=='<pseudo_partial_wave') then
2542 1349 : ipswf=ipswf+1
2543 1349 : paw_setup%pseudo_partial_wave(ipswf)%tread=.true.
2544 1349 : call paw_rdfromline(" grid",line,strg,ierr)
2545 1349 : if (strg == "" ) strg = "unknown"
2546 1349 : paw_setup%idgrid = trim(strg)
2547 1349 : paw_setup%pseudo_partial_wave(ipswf)%grid=trim(strg)
2548 1349 : call paw_rdfromline(" state",line,strg,ierr)
2549 1349 : paw_setup%pseudo_partial_wave(ipswf)%state=trim(strg)
2550 1349 : do ii=1,paw_setup%ngrid
2551 1349 : if(trim(paw_setup%pseudo_partial_wave(ipswf)%grid)==trim(paw_setup%radial_grid(ii)%id)) then
2552 1349 : mesh_size=paw_setup%radial_grid(ii)%iend-paw_setup%radial_grid(ii)%istart+1
2553 1349 : exit
2554 : end if
2555 : end do
2556 4047 : LIBPAW_ALLOCATE(paw_setup%pseudo_partial_wave(ipswf)%data,(mesh_size))
2557 2250725 : read(funit,*) (paw_setup%pseudo_partial_wave(ipswf)%data(ir),ir=1,mesh_size)
2558 2698 : cycle
2559 : end if
2560 :
2561 : ! --Read PROJECTORS TPROJ
2562 17249 : if (line(1:19)=='<projector_function') then
2563 1349 : iproj=iproj+1
2564 1349 : paw_setup%projector_function(iproj)%tread=.true.
2565 1349 : call paw_rdfromline(" grid",line,strg,ierr)
2566 1349 : if (strg == "" ) strg = "unknown"
2567 1349 : paw_setup%projector_function(iproj)%grid=trim(strg)
2568 1349 : call paw_rdfromline(" state",line,strg,ierr)
2569 1349 : paw_setup%projector_function(iproj)%state=trim(strg)
2570 1475 : do ii=1,paw_setup%ngrid
2571 1475 : if(trim(paw_setup%projector_function(iproj)%grid)==trim(paw_setup%radial_grid(ii)%id)) then
2572 1349 : mesh_size=paw_setup%radial_grid(ii)%iend-paw_setup%radial_grid(ii)%istart+1
2573 1349 : exit
2574 : end if
2575 : end do
2576 4047 : LIBPAW_ALLOCATE(paw_setup%projector_function(iproj)%data,(mesh_size))
2577 2250101 : read(funit,*) (paw_setup%projector_function(iproj)%data(ir),ir=1,mesh_size)
2578 2698 : cycle
2579 : end if
2580 :
2581 : ! --Read PROJECTORS TPROJ as gaussian representations
2582 15900 : if (line(1:14)=='<projector_fit') then
2583 0 : if(.not.allocated(paw_setup%projector_fit)) then
2584 0 : LIBPAW_DATATYPE_ALLOCATE(paw_setup%projector_fit,(paw_setup%valence_states%nval))
2585 : end if
2586 0 : iprojfit=iprojfit+1
2587 0 : paw_setup%projector_fit(iprojfit)%tread=.true.
2588 0 : call paw_rdfromline(" state",line,strg,ierr)
2589 0 : paw_setup%projector_fit(iprojfit)%state=trim(strg)
2590 0 : igauss = 0
2591 0 : endgauss = .false.
2592 0 : do while(.not. endgauss)
2593 0 : read(funit,'(a)',err=12,end=12) readline
2594 0 : line=adjustl(readline);goto 22
2595 0 : 12 line="";endgauss=.true.
2596 : 22 continue
2597 0 : endgauss = (line(1:15)=='</projector_fit')
2598 0 : if (line(1:9)=='<gaussian') then
2599 0 : igauss = igauss + 1
2600 0 : call paw_rdfromline(" factor",line,strg,ierr)
2601 : read(strg(index(strg, '{') + 1:index(strg, ',') - 1), *) &
2602 0 : & paw_setup%projector_fit(iprojfit)%factors(1, igauss)
2603 : read(strg(index(strg, ',') + 1:index(strg, '}') - 1), *) &
2604 0 : & paw_setup%projector_fit(iprojfit)%factors(2, igauss)
2605 0 : call paw_rdfromline(" exponent",line,strg,ierr)
2606 : read(strg(index(strg, '{') + 1:index(strg, ',') - 1), *) &
2607 0 : & paw_setup%projector_fit(iprojfit)%expos(1, igauss)
2608 : read(strg(index(strg, ',') + 1:index(strg, '}') - 1), *) &
2609 0 : & paw_setup%projector_fit(iprojfit)%expos(2, igauss)
2610 : end if
2611 : end do
2612 0 : paw_setup%projector_fit(iprojfit)%ngauss = igauss
2613 0 : cycle
2614 : end if
2615 :
2616 : ! --Read Kinetic term KINETIC_ENERGY_MATRIX
2617 15900 : if (line(1:28)=='<kinetic_energy_differences>') then
2618 306 : paw_setup%kinetic_energy_differences%tread=.true.
2619 306 : mesh_size=paw_setup%valence_states%nval*paw_setup%valence_states%nval
2620 918 : LIBPAW_ALLOCATE(paw_setup%kinetic_energy_differences%data,(mesh_size))
2621 6643 : read(funit,*) (paw_setup%kinetic_energy_differences%data(ir),ir=1,mesh_size)
2622 306 : cycle
2623 : end if
2624 :
2625 : ! --Read Exact exchange term EXACT_EXCHANGE_X_MATRIX
2626 15594 : if (line(1:25)=='<exact_exchange_X_matrix>') then
2627 271 : paw_setup%exact_exchange_matrix%tread=.true.
2628 271 : mesh_size=paw_setup%valence_states%nval*paw_setup%valence_states%nval
2629 813 : LIBPAW_ALLOCATE(paw_setup%exact_exchange_matrix%data,(mesh_size))
2630 6028 : read(funit,*) (paw_setup%exact_exchange_matrix%data(ir),ir=1,mesh_size)
2631 271 : cycle
2632 : end if
2633 :
2634 : ! --Read Exact exchange core-core energy
2635 15323 : if (line(1:25)=='<exact_exchange core-core') then
2636 271 : call paw_rdfromline(" core-core",line,strg,ierr)
2637 271 : if (len(trim(strg))<=30) then
2638 271 : strg1=trim(strg)
2639 271 : read(unit=strg1,fmt=*) paw_setup%ex_cc
2640 : else
2641 0 : read(unit=strg,fmt=*) paw_setup%ex_cc
2642 : end if
2643 : cycle
2644 : end if
2645 :
2646 : ! --Read Lamb shielding
2647 15052 : if (line(1:25)=='<lamb_shielding shielding') then
2648 15 : call paw_rdfromline(" shielding",line,strg,ierr)
2649 15 : if (len(trim(strg))<=30) then
2650 15 : strg1=trim(strg)
2651 15 : read(unit=strg1,fmt=*) paw_setup%lamb_shielding
2652 : else
2653 0 : read(unit=strg,fmt=*) paw_setup%lamb_shielding
2654 : end if
2655 : cycle
2656 : end if
2657 :
2658 :
2659 : ! --Read orthogonalisation scheme
2660 15037 : if (line(1:18)=='<orthogonalisation') then
2661 0 : call paw_rdfromline(" scheme",line,strg,ierr)
2662 0 : if (len(trim(strg))<=30) then
2663 0 : strg1=trim(strg)
2664 0 : read(unit=strg1,fmt=*) paw_setup%optortho
2665 : else
2666 0 : read(unit=strg,fmt=*) paw_setup%optortho
2667 : end if
2668 : cycle
2669 : end if
2670 :
2671 : ! --Read the Atompaw input file
2672 15037 : ir=0
2673 306 : if ((line(1:13)=='<!-- Program:').and.(ir==1)) then
2674 : msg=" "
2675 : do while ((msg(1:9)/=' Program:').and.(msg(1:8)/='Program:'))
2676 : read(funit,'(a)') msg
2677 : write(ab_out,'(a)') trim(msg)
2678 : end do
2679 : cycle
2680 : end if
2681 :
2682 : ! End of reading loop
2683 : end do
2684 530 : if(paw_setup%rpaw<0.d0) paw_setup%rpaw=maxval(rc)
2685 : !Close the XML atomicdata file
2686 306 : close(funit)
2687 :
2688 : !Test flags: is anything OK ?
2689 : found=paw_setup%atom%tread.and.paw_setup%valence_states%tread.and.&
2690 306 : & paw_setup%xc_functional%tread.and.paw_setup%shape_function%tread
2691 :
2692 306 : if (.not.paw_setup%atom%tread) then
2693 0 : msg="ATOM SYMBOL not found !"
2694 0 : LIBPAW_WARNING(msg)
2695 : end if
2696 306 : if (.not.paw_setup%valence_states%tread) then
2697 0 : msg="VALENCE STATES not found!"
2698 0 : LIBPAW_WARNING(msg)
2699 : end if
2700 306 : if (.not.paw_setup%xc_functional%tread) then
2701 0 : msg="EXCHANGE/CORRELATION not found !"
2702 0 : LIBPAW_WARNING(msg)
2703 : end if
2704 306 : if (.not.paw_setup%shape_function%tread) then
2705 0 : msg="SHAPE FUNCTION TYPE not found !"
2706 0 : LIBPAW_WARNING(msg)
2707 : end if
2708 :
2709 306 : if (.not.found) then
2710 0 : msg="Aborting now"
2711 0 : LIBPAW_ERROR(msg)
2712 : end if
2713 :
2714 612 : end subroutine rdpawpsxml
2715 : !!***
2716 :
2717 : !-------------------------------------------------------------------------
2718 :
2719 : !!****f* m_pawxmlps/rdpawpsxml_core
2720 : !! NAME
2721 : !! rdpawpsxml_core
2722 : !!
2723 : !! FUNCTION
2724 : !! Read the core wavefunctions in the XML file generated by AtomPAW
2725 : !!
2726 : !! INPUTS
2727 : !! filename= input file name (atomicdata XML)
2728 : !!
2729 : !! OUTPUT
2730 : !! Atm<paw_atomorb_type>= Structure defining the set of core orbitals
2731 : !!
2732 : !! SOURCE
2733 :
2734 7 : subroutine rdpawpsxml_core(atm,filename,rcut,pawrad)
2735 :
2736 : !Arguments ---------------------------------------------
2737 : character (len=*),intent(in) :: filename
2738 : real(dp), intent(in) :: rcut
2739 : type(atomorb_type), intent(inout) :: atm
2740 : type(pawrad_type),intent(in),optional :: pawrad
2741 :
2742 : !Local variables ---------------------------------------
2743 : integer :: funit,iaewf,imeshae,imsh,ir,igrid,icor,ierr,maxmeshz,mesh_size,nmesh
2744 : integer :: ilmn,jl,jlmn,k0lmn,klmn
2745 : integer :: iln,imainmesh,isppol,ms,msz_cut,i2j,il
2746 : logical :: endfile,found,tread,diracrel
2747 : real(dp) :: yp1,ypn,znucl
2748 : character(len=100) :: msg,version
2749 : character (len=XML_RECL) :: line,readline
2750 : character (len=XML_RECL) :: strg
2751 : character (len=30) :: strg1
2752 7 : integer,allocatable :: mesh_shift(:)
2753 7 : real(dp),allocatable :: work(:),phitmp(:,:)
2754 7 : character (len=20), allocatable :: gridwf(:),statewf(:)
2755 7 : type(state_t),allocatable :: corestate (:)
2756 7 : type(radial_grid_t),allocatable :: grids (:)
2757 7 : type(pawrad_type),allocatable :: radmesh(:)
2758 :
2759 : ! *************************************************************************
2760 :
2761 :
2762 : !Open the atomicdata XML file for reading
2763 7 : funit=100
2764 7 : open(unit=funit,file=filename,form='formatted',status='old', recl=XML_RECL)
2765 :
2766 : !Start a reading loop
2767 7 : endfile=.false.
2768 7 : found=.false.
2769 7 : diracrel=.false.
2770 :
2771 112 : do while ((.not.endfile).and.(.not.found))
2772 112 : read(funit,'(a)',err=10,end=10) readline
2773 112 : line=adjustl(readline);goto 20
2774 0 : 10 line="";endfile=.true.
2775 : 20 continue
2776 :
2777 : ! --Read VERSION
2778 112 : if (line(1:10)=='<paw_setup') then
2779 7 : tread=.true.
2780 7 : igrid=0
2781 77 : LIBPAW_DATATYPE_ALLOCATE(grids,(10))
2782 :
2783 7 : call paw_rdfromline(" version",line,strg,ierr)
2784 : version=trim(strg)
2785 7 : cycle
2786 : end if
2787 :
2788 : ! --read atom type
2789 105 : if (line(1:5)=='<atom') then
2790 7 : tread=.true.
2791 7 : call paw_rdfromline(" Z",line,strg,ierr)
2792 7 : strg1=trim(strg)
2793 7 : read(unit=strg1,fmt=*) znucl
2794 7 : call paw_rdfromline(" core",line,strg,ierr)
2795 7 : strg1=trim(strg)
2796 7 : read(unit=strg1,fmt=*) Atm%zcore
2797 7 : cycle
2798 : end if
2799 :
2800 :
2801 : ! --Read GENERATOR
2802 98 : if (line(1:10)=='<generator') then
2803 7 : tread=.true.
2804 7 : call paw_rdfromline(" type",line,strg,ierr)
2805 7 : if(strg=="dirac-relativistic") then
2806 105 : diracrel=.true.
2807 : endif
2808 : cycle
2809 : end if
2810 :
2811 : ! --Read BASIS SIZE, ORBITALS, RC AND OCCUPATIONS/STATE IDs
2812 91 : if (line(1:13)=='<core_states>') then
2813 7 : tread=.true.
2814 357 : LIBPAW_DATATYPE_ALLOCATE(corestate,(50))
2815 28 : icor=0
2816 35 : do while (line(1:14)/='</core_states>')
2817 28 : read(funit,'(a)') readline;line=adjustl(readline)
2818 35 : if (line(1:6)=='<state') then
2819 21 : icor=icor+1
2820 21 : if (icor>50) then
2821 0 : close(funit)
2822 0 : msg="basis size too large (>50)!"
2823 0 : LIBPAW_ERROR(msg)
2824 : end if
2825 21 : call paw_rdfromline(" n",line,strg,ierr)
2826 21 : if (strg == "" ) then
2827 0 : corestate(icor)%nn=-1
2828 : else
2829 21 : if (len(trim(strg))<=30) then
2830 21 : strg1=trim(strg)
2831 21 : read(unit=strg1,fmt=*) corestate(icor)%nn
2832 : else
2833 0 : read(unit=strg,fmt=*) corestate(icor)%nn
2834 : end if
2835 : end if
2836 21 : call paw_rdfromline(" l",line,strg,ierr)
2837 21 : if (len(trim(strg))<=30) then
2838 21 : strg1=trim(strg)
2839 21 : read(unit=strg1,fmt=*) corestate(icor)%ll
2840 : else
2841 0 : read(unit=strg,fmt=*) corestate(icor)%ll
2842 : end if
2843 21 : if(diracrel) then!does not work if xml file is in the wrong order, which is bad xml, alternatives?
2844 8 : call paw_rdfromline(" kappa",line,strg,ierr)
2845 8 : if (len(trim(strg))<=30) then
2846 8 : strg1=trim(strg)
2847 8 : read(unit=strg1,fmt=*) corestate(icor)%kk
2848 : else
2849 0 : read(unit=strg,fmt=*) corestate(icor)%kk
2850 : end if
2851 : endif
2852 21 : call paw_rdfromline(" f",line,strg,ierr)
2853 21 : if (strg == "" ) then
2854 0 : corestate(icor)%ff=-1.d0
2855 : else
2856 21 : if (len(trim(strg))<=30) then
2857 21 : strg1=trim(strg)
2858 21 : read(unit=strg1,fmt=*) corestate(icor)%ff
2859 : else
2860 0 : read(unit=strg,fmt=*) corestate(icor)%ff
2861 : end if
2862 : end if
2863 21 : call paw_rdfromline(" rc",line,strg,ierr)
2864 21 : if (strg == "" ) then
2865 21 : corestate(icor)%rc=-1
2866 : else
2867 0 : if (len(trim(strg))<=30) then
2868 0 : strg1=trim(strg)
2869 0 : read(unit=strg1,fmt=*) corestate(icor)%rc
2870 : else
2871 0 : read(unit=strg,fmt=*) corestate(icor)%rc
2872 : end if
2873 : end if
2874 21 : call paw_rdfromline(" e",line,strg,ierr)
2875 21 : if (len(trim(strg))<=30) then
2876 21 : strg1=trim(strg)
2877 21 : read(unit=strg1,fmt=*) corestate(icor)%ee
2878 : else
2879 0 : read(unit=strg,fmt=*) corestate(icor)%ee
2880 : end if
2881 21 : call paw_rdfromline(" id",line,strg,ierr)
2882 21 : corestate(icor)%id = trim(strg)
2883 : end if
2884 : end do
2885 : cycle
2886 : end if
2887 :
2888 : ! --Read MESH_STEP AND NUMBER OF POINTS
2889 84 : if (line(1:12)=='<radial_grid')then
2890 7 : igrid=igrid+1
2891 7 : call paw_rdfromline(" eq",line,strg,ierr)
2892 7 : grids(igrid)%eq = trim(strg)
2893 7 : call paw_rdfromline(" a",line,strg,ierr)
2894 7 : if (strg == "" ) then
2895 0 : grids(igrid)%aa=0.d0
2896 : else
2897 7 : if (len(trim(strg))<=30) then
2898 7 : strg1=trim(strg)
2899 7 : read(unit=strg1,fmt=*) grids(igrid)%aa
2900 : else
2901 0 : read(unit=strg,fmt=*) grids(igrid)%aa
2902 : end if
2903 : end if
2904 7 : call paw_rdfromline(" n",line,strg,ierr)
2905 7 : if (strg == "" ) then
2906 7 : grids(igrid)%nn=0
2907 : else
2908 0 : if (len(trim(strg))<=30) then
2909 0 : strg1=trim(strg)
2910 0 : read(unit=strg1,fmt=*) grids(igrid)%nn
2911 : else
2912 0 : read(unit=strg,fmt=*) grids(igrid)%nn
2913 : end if
2914 : end if
2915 7 : call paw_rdfromline(" d",line,strg,ierr)
2916 7 : if (strg == "" ) then
2917 0 : grids(igrid)%dd=0.d0
2918 : else
2919 7 : if (len(trim(strg))<=30) then
2920 7 : strg1=trim(strg)
2921 7 : read(unit=strg1,fmt=*) grids(igrid)%dd
2922 : else
2923 0 : read(unit=strg,fmt=*) grids(igrid)%dd
2924 : end if
2925 : end if
2926 7 : call paw_rdfromline(" b",line,strg,ierr)
2927 7 : if (strg == "" ) then
2928 7 : grids(igrid)%bb=0.d0
2929 : else
2930 0 : if (len(trim(strg))<=30) then
2931 0 : strg1=trim(strg)
2932 0 : read(unit=strg1,fmt=*) grids(igrid)%bb
2933 : else
2934 0 : read(unit=strg,fmt=*) grids(igrid)%bb
2935 : end if
2936 : end if
2937 7 : call paw_rdfromline("istart",line,strg,ierr)
2938 7 : if (len(trim(strg))<=30) then
2939 7 : strg1=trim(strg)
2940 7 : read(unit=strg1,fmt=*) grids(igrid)%istart
2941 : else
2942 0 : read(unit=strg,fmt=*) grids(igrid)%istart
2943 : end if
2944 7 : call paw_rdfromline("iend",line,strg,ierr)
2945 7 : if (len(trim(strg))<=30) then
2946 7 : strg1=trim(strg)
2947 7 : read(unit=strg1,fmt=*) grids(igrid)%iend
2948 : else
2949 0 : read(unit=strg,fmt=*) grids(igrid)%iend
2950 : end if
2951 7 : call paw_rdfromline(" id",line,strg,ierr)
2952 7 : grids(igrid)%id = trim(strg)
2953 : if(igrid>10)then
2954 : close(funit)
2955 : msg="igrid>10"
2956 : LIBPAW_ERROR(msg)
2957 : end if
2958 : found=.true.
2959 : cycle
2960 : end if
2961 :
2962 : ! End of reading loop
2963 : end do
2964 :
2965 7 : Atm%fname = filename
2966 7 : Atm%l_max=0
2967 7 : Atm%ixc=0
2968 7 : Atm%method=0
2969 7 : Atm%l_size=0
2970 7 : Atm%ln2_size=0
2971 7 : Atm%lmn_size=0
2972 7 : Atm%lmn2_size=0
2973 7 : Atm%rcore=0.0_dp
2974 7 : Atm%nspden=1
2975 7 : Atm%nsppol=1
2976 7 : Atm%ln_size=icor
2977 7 : Atm%dirac=diracrel
2978 7 : Atm%mesh_size=0
2979 7 : Atm%nspinor=1
2980 7 : Atm%znucl=znucl
2981 7 : Atm%mult=1
2982 : Atm%lmn2_size = 0
2983 7 : Atm%zion=Atm%znucl-Atm%zcore
2984 7 : Atm%zcore_orig=Atm%zcore
2985 7 : if(Atm%dirac) Atm%nspinor=2
2986 7 : nmesh=igrid
2987 7 : if(nmesh>0)then
2988 35 : LIBPAW_DATATYPE_ALLOCATE(radmesh,(nmesh))
2989 21 : LIBPAW_ALLOCATE(mesh_shift,(nmesh))
2990 14 : do imsh=1,nmesh
2991 7 : radmesh(imsh)%mesh_type=-1
2992 7 : radmesh(imsh)%rstep=zero
2993 7 : radmesh(imsh)%lstep=zero
2994 7 : mesh_shift(imsh)=0
2995 21 : select case(trim(grids(imsh)%eq))
2996 : case("r=a*exp(d*i)")
2997 0 : mesh_shift(imsh)=1
2998 0 : radmesh(imsh)%mesh_type=3
2999 0 : radmesh(imsh)%mesh_size=grids(imsh)%iend-grids(imsh)%istart+1+mesh_shift(imsh)
3000 0 : radmesh(imsh)%rstep=grids(imsh)%aa
3001 0 : radmesh(imsh)%lstep=grids(imsh)%dd
3002 : case("r=a*i/(1-b*i)")
3003 : write(msg, '(3a)' )&
3004 0 : & ' the grid r=a*i/(1-b*i) is not implemented in ABINIT !',ch10,&
3005 0 : & ' Action: check your psp file.'
3006 0 : LIBPAW_ERROR(msg)
3007 : case("r=a*i/(n-i)")
3008 0 : mesh_shift(imsh)=0
3009 0 : radmesh(imsh)%mesh_type=5
3010 0 : radmesh(imsh)%mesh_size=grids(imsh)%iend-grids(imsh)%istart+1+mesh_shift(imsh)
3011 0 : radmesh(imsh)%rstep=grids(imsh)%aa
3012 0 : radmesh(imsh)%lstep=dble(grids(imsh)%nn)
3013 : case("r=a*(exp(d*i)-1)")
3014 7 : mesh_shift(imsh)=0
3015 7 : radmesh(imsh)%mesh_type=2
3016 7 : radmesh(imsh)%mesh_size=grids(imsh)%iend-grids(imsh)%istart+1+mesh_shift(imsh)
3017 7 : if(grids(imsh)%istart==1)radmesh(imsh)%mesh_size=radmesh(imsh)%mesh_size+1
3018 7 : radmesh(imsh)%rstep=grids(imsh)%aa
3019 7 : radmesh(imsh)%lstep=grids(imsh)%dd
3020 : case("r=d*i")
3021 0 : mesh_shift(imsh)=0
3022 0 : radmesh(imsh)%mesh_type=1
3023 0 : radmesh(imsh)%mesh_size=grids(imsh)%iend-grids(imsh)%istart+1+mesh_shift(imsh)
3024 0 : if(grids(imsh)%istart==1)radmesh(imsh)%mesh_size=radmesh(imsh)%mesh_size+1
3025 0 : radmesh(imsh)%rstep=grids(imsh)%dd
3026 : case("r=(i/n+a)^5/a-a^4")
3027 : write(msg, '(3a)' )&
3028 0 : & ' the grid r=(i/n+a)^5/a-a^4 is not implemented in ABINIT !',ch10,&
3029 0 : & ' Action: check your psp file.'
3030 14 : LIBPAW_ERROR(msg)
3031 : end select
3032 : end do
3033 : end if
3034 :
3035 : !Initialize radial meshes
3036 14 : do imsh=1,nmesh
3037 14 : call pawrad_init(radmesh(imsh))
3038 : end do
3039 :
3040 14 : maxmeshz=maxval(radmesh(:)%mesh_size)
3041 21 : LIBPAW_DATATYPE_ALLOCATE(gridwf,(Atm%ln_size))
3042 14 : LIBPAW_DATATYPE_ALLOCATE(statewf,(Atm%ln_size))
3043 28 : LIBPAW_ALLOCATE(phitmp,(maxmeshz,Atm%ln_size))
3044 46049 : phitmp(:,:)=zero
3045 :
3046 : !Start of reading loop
3047 : iaewf=0 ; endfile=.false.
3048 17052 : do while (.not.endfile)
3049 17045 : read(funit,'(a)',err=11,end=11) readline
3050 17038 : line=adjustl(readline);goto 21
3051 7 : 11 line="";endfile=.true.
3052 : 21 continue
3053 :
3054 : ! --Read CORE WAVE FUNCTIONS PHI
3055 17052 : if (line(1:21)=='<ae_core_wavefunction') then
3056 21 : iaewf=iaewf+1
3057 21 : tread=.true.
3058 21 : call paw_rdfromline(" grid",line,strg,ierr)
3059 21 : if (strg == "" ) strg = "unknown"
3060 21 : gridwf(iaewf)=trim(strg)
3061 21 : call paw_rdfromline(" state",line,strg,ierr)
3062 21 : statewf(iaewf)=trim(strg)
3063 21 : do imsh=1,nmesh
3064 21 : if(trim(gridwf(iaewf))==trim(grids(imsh)%id)) then
3065 21 : mesh_size=grids(imsh)%iend-grids(imsh)%istart+1
3066 21 : exit
3067 : end if
3068 : end do
3069 21 : read(funit,*) (phitmp(ir,iaewf),ir=1,mesh_size)
3070 21 : cycle
3071 : end if
3072 : ! End of reading loop
3073 : end do
3074 :
3075 7 : atm%zcore_conv=.false.
3076 7 : atm%nc_conv=.false.
3077 7 : atm%nresid_c=one
3078 :
3079 7 : if(Atm%ln_size==0)then
3080 0 : LIBPAW_ALLOCATE(Atm%mode,(1,1,2))
3081 0 : Atm%mode = ORB_FROZEN
3082 : else
3083 28 : LIBPAW_ALLOCATE(Atm%eig,(Atm%ln_size,Atm%nsppol))
3084 21 : LIBPAW_ALLOCATE(Atm%occ,(Atm%ln_size,Atm%nsppol))
3085 21 : LIBPAW_ALLOCATE(Atm%occ_res,(Atm%ln_size,Atm%nsppol))
3086 21 : LIBPAW_ALLOCATE(Atm%occ_respc,(Atm%ln_size,Atm%nsppol))
3087 21 : LIBPAW_ALLOCATE(Atm%indln,(2,Atm%ln_size))
3088 7 : if (Atm%dirac) then
3089 6 : LIBPAW_ALLOCATE(Atm%kappa,(Atm%ln_size))
3090 : endif
3091 14 : do isppol=1,Atm%nsppol
3092 35 : do iln=1,Atm%ln_size
3093 42 : do imsh=1,nmesh
3094 63 : if(trim(gridwf(iln))==trim(grids(imsh)%id)) imeshae=imsh
3095 : end do
3096 21 : if (iln==1.and.isppol==1) then
3097 7 : imainmesh=imeshae
3098 7 : if(present(pawrad)) then
3099 3 : Atm%mesh_size = pawrad%mesh_size
3100 3 : Atm%rcore=pawrad%rad(pawrad%mesh_size)
3101 3 : call pawrad_copy(pawrad,atm%radmesh)
3102 4 : elseif(rcut>tol16) then
3103 0 : msz_cut =min(pawrad_ifromr(radmesh(imeshae),rcut)+6,radmesh(imeshae)%mesh_size) ! add six more points six more points
3104 0 : Atm%mesh_size = msz_cut
3105 0 : Atm%rcore = radmesh(imeshae)%rad(msz_cut)
3106 0 : call pawrad_init(Atm%radmesh,Atm%mesh_size,radmesh(imeshae)%mesh_type,radmesh(imeshae)%rstep,radmesh(imeshae)%lstep,-one)
3107 : else
3108 4 : Atm%mesh_size= radmesh(imeshae)%mesh_size
3109 4 : Atm%rcore=corestate(iln)%rc
3110 4 : call pawrad_init(Atm%radmesh,radmesh(imeshae)%mesh_size,radmesh(imeshae)%mesh_type,radmesh(imeshae)%rstep,radmesh(imeshae)%lstep,-one)
3111 : endif
3112 35 : LIBPAW_ALLOCATE(Atm%phi,(Atm%mesh_size,Atm%ln_size,Atm%nsppol))
3113 14 : else if ((imeshae/=imainmesh).and.(.not.present(pawrad))) then
3114 : write(msg,'(3a)')&
3115 0 : & ' All Phi core must be given on the same radial mesh !',ch10,&
3116 0 : & ' Action: check your pseudopotential file.'
3117 0 : ABI_ERROR(msg)
3118 : end if
3119 21 : Atm%indln(2,iln)=corestate(iln)%nn
3120 21 : Atm%indln(1,iln)=corestate(iln)%ll
3121 21 : if(Atm%dirac) Atm%kappa(iln)=corestate(iln)%kk
3122 21 : Atm%eig(iln,isppol)=corestate(iln)%ee
3123 21 : Atm%occ(iln,isppol)=corestate(iln)%ff
3124 28 : if(present(pawrad)) then
3125 : if ((pawrad%mesh_type/=radmesh(imeshae)%mesh_type) &
3126 : & .or.(pawrad%rstep/=radmesh(imeshae)%rstep) &
3127 8 : & .or.(pawrad%lstep/=radmesh(imeshae)%lstep)) then
3128 4 : ms=pawrad%mesh_size
3129 4 : if (radmesh(imeshae)%rmax<pawrad%rmax+tol8) ms=pawrad_ifromr(pawrad,radmesh(imeshae)%rmax)-1
3130 4 : mesh_size=radmesh(imeshae)%mesh_size
3131 12 : LIBPAW_ALLOCATE(work,(mesh_size))
3132 4 : call bound_deriv(phitmp(1:mesh_size,iln),radmesh(imeshae),mesh_size,yp1,ypn)
3133 4 : call paw_spline(radmesh(imeshae)%rad(1:mesh_size),phitmp(1:mesh_size,iln),mesh_size,yp1,ypn,work(1:mesh_size))
3134 : call paw_splint(mesh_size,radmesh(imeshae)%rad(1:mesh_size),phitmp(1:mesh_size,iln),work(1:mesh_size),&
3135 4 : & ms,pawrad%rad(1:ms),Atm%phi(1:ms,iln,isppol))
3136 4 : LIBPAW_DEALLOCATE(work)
3137 8004 : Atm%phi(1:ms,iln,isppol)=Atm%phi(1:ms,iln,isppol)*pawrad%rad(1:ms)
3138 : else
3139 : ! shft=mesh_shift(imeshae)
3140 4 : mesh_size=min(radmesh(imeshae)%mesh_size,pawrad%mesh_size)
3141 8008 : Atm%phi(1:mesh_size,iln,isppol)=phitmp(1:mesh_size,iln)*radmesh(imeshae)%rad(1:mesh_size)
3142 4 : if (mesh_size<pawrad%mesh_size) Atm%phi(mesh_size+1:pawrad%mesh_size,iln,isppol)=zero
3143 : ! phi_cor(1+shft:mesh_size,iln)=phitmp(1:mesh_size-shft,iln)*radmesh(imeshae)%rad(1:mesh_size-shft)
3144 : ! if (shft==1) phi_cor(1,iln)=zero
3145 : end if
3146 : else
3147 26026 : Atm%phi(:,iln,isppol) = phitmp(1:Atm%mesh_size,iln)*radmesh(imeshae)%rad(1:Atm%mesh_size)
3148 : endif
3149 : end do
3150 : enddo
3151 7 : if(Atm%dirac) then
3152 2 : Atm%lmn_size=0
3153 10 : do iln=1,Atm%ln_size
3154 8 : il=Atm%indln(1,iln)
3155 8 : i2j=2*il-sign(1,Atm%kappa(iln))
3156 10 : Atm%lmn_size=Atm%lmn_size+i2j+1
3157 : end do
3158 2 : Atm%lmn_size=Atm%lmn_size*2
3159 10 : call make_indlmn(Atm%ln_size,Atm%lmn_size,Atm%indln(1,:),Atm%indlmn,kappa=Atm%kappa)
3160 : else
3161 5 : Atm%lmn_size=0
3162 18 : do iln=1,Atm%ln_size
3163 13 : il=Atm%indln(1,iln)
3164 18 : Atm%lmn_size=Atm%lmn_size+2*il+1
3165 : end do
3166 18 : call make_indlmn(Atm%ln_size, Atm%lmn_size, Atm%indln(1,:), Atm%indlmn)
3167 : endif
3168 28 : Atm%l_max=maxval(Atm%indln(1,:))+1
3169 7 : Atm%ln2_size = Atm%ln_size *(Atm%ln_size +1)/2
3170 7 : Atm%lmn2_size = Atm%lmn_size*(Atm%lmn_size+1)/2
3171 : ! * Setup of indklmn and klm_diag.
3172 21 : LIBPAW_ALLOCATE(Atm%indklmn,(8,Atm%lmn2_size))
3173 21 : LIBPAW_ALLOCATE(Atm%klm_diag,(Atm%lmn2_size))
3174 7 : call make_indklmn(HUGE(1), Atm%lmn_size, Atm%lmn2_size,Atm%indlmn,Atm%indklmn, Atm%klm_diag)
3175 :
3176 : ! * Setup of klmntomn.
3177 21 : LIBPAW_ALLOCATE(Atm%klmntomn,(4,Atm%lmn2_size))
3178 68 : do jlmn=1,Atm%lmn_size
3179 61 : jl= Atm%indlmn(1,jlmn)
3180 61 : k0lmn=jlmn*(jlmn-1)/2
3181 549 : do ilmn=1,jlmn
3182 481 : il= Atm%indlmn(1,ilmn)
3183 481 : klmn=k0lmn+ilmn
3184 481 : Atm%klmntomn(1,klmn) = Atm%indlmn(2,ilmn)+il+1 ! im
3185 481 : Atm%klmntomn(2,klmn) = Atm%indlmn(2,jlmn)+jl+1 ! jm
3186 481 : Atm%klmntomn(3,klmn) = Atm%indlmn(3,ilmn) ! in
3187 542 : Atm%klmntomn(4,klmn) = Atm%indlmn(3,jlmn) ! jn
3188 : end do
3189 : end do
3190 :
3191 7 : Atm%l_size =2*Atm%l_max-1
3192 35 : LIBPAW_ALLOCATE(Atm%mode,(Atm%ln_size,Atm%nsppol,2))
3193 77 : Atm%mode = ORB_FROZEN
3194 28 : LIBPAW_ALLOCATE(Atm%max_occ,(Atm%ln_size,Atm%nsppol))
3195 42 : Atm%max_occ=Atm%occ
3196 :
3197 : ! ! * Setup of kln2ln.
3198 : ! !TODO this has to be tested
3199 : ! LIBPAW_ALLOCATE(Atm%kln2ln,(6,Atm%ln2_size))
3200 : ! call make_kln2ln(Atm%lmn_size,Atm%lmn2_size,Atm%ln2_size,Atm%indlmn,Atm%indklmn,Atm%kln2ln)
3201 : end if
3202 :
3203 :
3204 7 : if (allocated(radmesh)) then
3205 7 : call pawrad_free(radmesh)
3206 14 : LIBPAW_DATATYPE_DEALLOCATE(radmesh)
3207 : end if
3208 7 : if (allocated(mesh_shift)) then
3209 7 : LIBPAW_DATATYPE_DEALLOCATE(mesh_shift)
3210 : end if
3211 :
3212 7 : if (allocated(grids)) then
3213 7 : LIBPAW_DATATYPE_DEALLOCATE(grids)
3214 : end if
3215 7 : if (allocated(corestate)) then
3216 7 : LIBPAW_DATATYPE_DEALLOCATE(corestate)
3217 : end if
3218 :
3219 7 : if (allocated(gridwf)) then
3220 7 : LIBPAW_DATATYPE_DEALLOCATE(gridwf)
3221 : end if
3222 7 : if (allocated(statewf)) then
3223 7 : LIBPAW_DATATYPE_DEALLOCATE(statewf)
3224 : end if
3225 7 : if (allocated(phitmp)) then
3226 7 : LIBPAW_DEALLOCATE(phitmp)
3227 : end if
3228 :
3229 : !Close the XML atomicdata file
3230 7 : close(funit)
3231 :
3232 :
3233 14 : end subroutine rdpawpsxml_core
3234 : !!***
3235 :
3236 : !-------------------------------------------------------------------------
3237 :
3238 0 : end module m_pawxmlps
3239 : !!***
|
