mirror of https://gitlab.com/QEF/q-e.git
146 lines
6.5 KiB
Fortran
146 lines
6.5 KiB
Fortran
! Copyright (C) 2008 Quantum ESPRESSO group
|
|
! This file is distributed under the terms of the
|
|
! GNU General Public License. See the file `License'
|
|
! in the root directory of the present distribution,
|
|
! or http://www.gnu.org/copyleft/gpl.txt .
|
|
!
|
|
!=----------------------------------------------------------------------------=!
|
|
MODULE upf_module
|
|
!=----------------------------------------------------------------------------=!
|
|
!! author: Unknown
|
|
!! this module handles reading of unified pseudopotential format (UPF)
|
|
!! in either v1 or v2 or schema format.
|
|
!! @Note
|
|
!! 14/11/17 Pietro Delugas: new revision passed from iotk to FoX lib,
|
|
!! added support for new schema format
|
|
!
|
|
USE kinds, ONLY: DP
|
|
USE pseudo_types, ONLY: pseudo_upf, deallocate_pseudo_upf
|
|
USE read_upf_v1_module, ONLY: scan_begin, scan_end
|
|
!
|
|
IMPLICIT NONE
|
|
PRIVATE
|
|
PUBLIC :: read_upf, scan_begin, scan_end
|
|
!
|
|
CONTAINS
|
|
|
|
!------------------------------------------------+
|
|
SUBROUTINE read_upf(upf, grid, ierr, unit, filename) !
|
|
!---------------------------------------------+
|
|
!! Reads pseudopotential in UPF format (either v.1 or v.2 or upf_schema).
|
|
!! Derived-type variable *upf* and optionally *grid* store in output the
|
|
!! data read from file.
|
|
!! If unit number is provided with the *unit* argument, only UPF v1 format
|
|
!! is chhecked; the PP file must be opened and closed outside the routine.
|
|
!! Otherwise the *filename* argument must be given, file is opened and closed
|
|
!! inside the routine, all formats will be checked.
|
|
!! @Note last revision: 11-05-2018 OG - removed xml_only
|
|
!
|
|
USE radial_grids, ONLY: radial_grid_type, deallocate_radial_grid
|
|
USE read_upf_v1_module,ONLY: read_upf_v1
|
|
USE read_upf_v2_module,ONLY: read_upf_v2
|
|
USE read_upf_schema_module ,ONLY: read_upf_schema
|
|
USE mp, ONLY: mp_bcast, mp_sum
|
|
USE mp_images, ONLY: intra_image_comm, my_image_id
|
|
USE io_global, ONLY: ionode, ionode_id, stdout
|
|
USE io_files, ONLY: tmp_dir
|
|
USE FoX_DOM, ONLY: Node, domException, parseFile, getFirstChild, getExceptionCode,&
|
|
getTagName
|
|
USE wrappers, ONLY: f_remove
|
|
USE emend_upf_module, ONLY: make_emended_upf_copy
|
|
IMPLICIT NONE
|
|
INTEGER,INTENT(IN), OPTIONAL :: unit
|
|
!! i/o unit:
|
|
CHARACTER(len=*),INTENT(IN),OPTIONAL :: filename
|
|
!! i/o filename
|
|
TYPE(pseudo_upf),INTENT(INOUT) :: upf
|
|
!! the derived type storing the pseudo data
|
|
TYPE(radial_grid_type),OPTIONAL,INTENT(INOUT),TARGET :: grid
|
|
!! derived type where is possible to store data on the radial mesh
|
|
INTEGER,INTENT(OUT) :: ierr
|
|
!! ierr=0: xml schema, ierr=-1: UPF v.1, ierr=-2: UPF v.2
|
|
!! ierr>0: error reading PP file
|
|
!
|
|
TYPE(Node),POINTER :: u,doc
|
|
INTEGER :: u_temp,& ! i/o unit in case of upf v1
|
|
iun, ferr
|
|
TYPE(DOMException) :: ex
|
|
INTEGER, EXTERNAL :: find_free_unit
|
|
CHARACTER(LEN=256) :: temp_upf_file
|
|
CHARACTER(LEN=1024) :: msg
|
|
LOGICAL :: should_be_xml
|
|
|
|
ierr = 0
|
|
IF ( present ( unit ) ) THEN
|
|
REWIND (unit)
|
|
CALL deallocate_pseudo_upf(upf)
|
|
CALL deallocate_radial_grid( grid )
|
|
CALL read_upf_v1 (unit, upf, grid, ierr )
|
|
IF (ierr == 0 ) ierr = -1
|
|
!
|
|
ELSE IF (PRESENT(filename) ) THEN
|
|
doc => parseFile(TRIM(filename), EX = ex )
|
|
ierr = getExceptionCode( ex )
|
|
IF ( ierr == 81 ) THEN
|
|
WRITE(temp_upf_file, '("tmp_",I0,".UPF")') my_image_id
|
|
IF ( ionode ) THEN
|
|
CALL make_emended_upf_copy( TRIM(filename), TRIM(tmp_dir)//trim(temp_upf_file), should_be_xml)
|
|
END IF
|
|
CALL mp_bcast ( should_be_xml, ionode_id, intra_image_comm)
|
|
IF ( should_be_xml) THEN
|
|
doc => parseFile(TRIM(tmp_dir)//trim(temp_upf_file), EX = ex, IOSTAT = ferr )
|
|
ierr = getExceptionCode( ex )
|
|
CALL mp_sum(ferr,intra_image_comm)
|
|
IF ( ferr /= 0 ) THEN
|
|
WRITE (msg, '(A)') 'Failure while trying to fix '//trim(filename) // '.'// new_line('a') // &
|
|
'For fixing manually UPF files see: '// new_line('a') // &
|
|
'https://gitlab.com/QEF/q-e/blob/master/upftools/how_to_fix_upf.md'
|
|
CALL errore('read_upf: ', TRIM(msg), ferr )
|
|
ELSE
|
|
WRITE ( msg, '(A)') 'Pseudo file '// trim(filename) // ' has been successfully fixed on the fly.' &
|
|
// new_line('a') // 'To avoid this message in the future you can permanently fix ' &
|
|
// new_line('a') // ' your pseudo files following instructions given in: ' &
|
|
// new_line('a') // 'https://gitlab.com/QEF/q-e/blob/master/upftools/how_to_fix_upf.md'
|
|
CALL infomsg('read_upf:', trim(msg) )
|
|
END IF
|
|
END IF
|
|
!
|
|
IF (ionode) ferr = f_remove(TRIM(tmp_dir)//TRIM(temp_upf_file) )
|
|
temp_upf_file=""
|
|
END IF
|
|
IF ( ierr == 0 ) THEN
|
|
u => getFirstChild(doc)
|
|
SELECT CASE (TRIM(getTagname(u)))
|
|
CASE ('UPF')
|
|
CALL read_upf_v2( u, upf, grid, ierr )
|
|
IF ( ierr == 0 ) ierr = -2
|
|
CASE ('qe_pp:pseudo')
|
|
CALL read_upf_schema( u, upf, grid, ierr)
|
|
CASE default
|
|
ierr = 1
|
|
CALL errore('read_upf', 'xml format '//TRIM(getTagName(u))//' not implemented', ierr)
|
|
END SELECT
|
|
IF ( ierr > 0 ) CALL errore( 'read_upf', 'File is Incomplete or wrong: '//TRIM(filename), ierr)
|
|
!
|
|
ELSE IF ( ierr > 0 ) THEN
|
|
!
|
|
u_temp = find_free_unit()
|
|
OPEN (UNIT = u_temp, FILE = TRIM(filename), STATUS = 'old', FORM = 'formatted', IOSTAT = ierr)
|
|
CALL errore ("upf_module:read_upf", "error while opening file " // TRIM(filename), ierr)
|
|
CALL deallocate_pseudo_upf( upf )
|
|
CALL deallocate_radial_grid( grid )
|
|
CALL read_upf_v1( u_temp, upf, grid, ierr )
|
|
IF ( ierr == 0 ) ierr = -1
|
|
CLOSE ( u_temp)
|
|
!
|
|
END IF
|
|
ELSE
|
|
CALL errore('read_upf', 'Nothing to read !!! Provide either filename or unit optional arguments',1)
|
|
END IF
|
|
!
|
|
END SUBROUTINE read_upf
|
|
!=----------------------------------------------------------------------------=!
|
|
END MODULE upf_module
|
|
!=----------------------------------------------------------------------------=!
|
|
|