scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

More upf cleanup: on-the-fly fix for UPF v.2 files containing undesired & characters moved one level up 

(it was inside read_upf, now it has to be called explicitly after read_upf fails). The rationale is to
disentangle PP reading from parallelism (now parallelism is hidden deep inside PP reading), eventually
moving all utilities for reading and convering PP's into a single, "almost stand-alone" library.
This commit is contained in:
Paolo Giannozzi 2019-01-03 15:55:31 +01:00
parent 8870d4ff3a
commit c80872f1b1
8 changed files with 116 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
Modules/emend_upf.f90
View File

@ -10,17 +10,17 @@ MODULE emend_upf_module
!! Contains utility to make the old UPF format readable by FoX
PRIVATE
PUBLIC make_emended_upf_copy, check_upf_file
PUBLIC make_emended_upf_copy
CONTAINS
SUBROUTINE make_emended_upf_copy( filename, tempname, xml_check)
FUNCTION make_emended_upf_copy( filename, tempname) RESULT(xml_check)
!! author: Pietro Delugas
!! Utility to make the old UPF format readable by FoX
!! Replaces "&" with "&" in file "filename", writes to file "tempname"
!
IMPLICIT NONE
CHARACTER(LEN=*),INTENT(IN) :: filename, tempname
LOGICAL,INTENT(OUT) :: xml_check
LOGICAL :: xml_check
!
INTEGER :: iun_source, iun_dest, ierr
INTEGER,EXTERNAL :: find_free_unit
@ -60,36 +60,10 @@ SUBROUTINE make_emended_upf_copy( filename, tempname, xml_check)
END DO copy_loop
!
CLOSE ( iun_source)
CLOSE ( iun_dest )
END SUBROUTINE make_emended_upf_copy
CLOSE ( iun_dest )
!
END FUNCTION make_emended_upf_copy
!
FUNCTION check_upf_file(filename, errcode) RESULT(ok)
!! checks whether the upf file filename is complian to xml syntax
!! the errorcode returned by the checking routine may optionally be
!! written in the errorcode argument
USE FoX_dom, ONLY: Node, DOMException, parseFile, getExceptionCode
IMPLICIT NONE
CHARACTER(LEN=*),INTENT(IN) :: filename
!! name of the upf file being checked
INTEGER,OPTIONAL,INTENT(OUT) :: errcode
!! if present contains the error code returnd by the upf check
LOGICAL :: ok
!! if true the upf file is compliant to xml syntax
!
TYPE(Node),POINTER :: doc
TYPE(DOMException) :: dom_ex
INTEGER :: ierr
doc => parseFile(TRIM(filename), EX = dom_ex)
ierr = getExceptionCode(dom_ex)
IF (PRESENT(errcode)) errcode=ierr
IF (ierr /= 0 ) THEN
ok = .FALSE.
ELSE
ok =.TRUE.
ENDIF
!
END FUNCTION check_upf_file
FUNCTION check(in) RESULT (out)
CHARACTER (LEN = *) :: in

7
Modules/make.depend
View File

@ -302,6 +302,7 @@ read_ncpp.o : pseudo_types.o
read_pseudo.o : ../UtilXlib/mp.o
read_pseudo.o : atom.o
read_pseudo.o : constants.o
read_pseudo.o : emend_upf.o
read_pseudo.o : funct.o
read_pseudo.o : gth.o
read_pseudo.o : io_files.o
@ -371,18 +372,12 @@ tsvdw.o : kind.o
tsvdw.o : mp_bands.o
tsvdw.o : mp_images.o
tsvdw.o : uspp.o
upf.o : ../UtilXlib/mp.o
upf.o : emend_upf.o
upf.o : io_files.o
upf.o : io_global.o
upf.o : kind.o
upf.o : mp_images.o
upf.o : pseudo_types.o
upf.o : radial_grids.o
upf.o : read_upf_schema.o
upf.o : read_upf_v1.o
upf.o : read_upf_v2.o
upf.o : wrappers.o
upf_to_internal.o : pseudo_types.o
upf_to_internal.o : radial_grids.o
uspp.o : constants.o

35
Modules/read_pseudo.f90
View File

@ -12,7 +12,7 @@ MODULE read_pseudo_mod
!! read pseudopotential files and store the data on internal variables of the
!! program. Note that all processors read the same file!
!
USE io_files, ONLY: pseudo_dir, pseudo_dir_cur, psfile
USE io_files, ONLY: pseudo_dir, pseudo_dir_cur, psfile, tmp_dir
USE ions_base, ONLY: ntyp => nsp
!! global variables required on input
!
@ -48,8 +48,9 @@ SUBROUTINE readpp ( input_dft, printout, ecutwfc_pp, ecutrho_pp )
USE funct, ONLY: enforce_input_dft, set_dft_from_name, &
set_dft_from_indices, get_iexch, get_icorr, get_igcx, get_igcc, get_inlc
use radial_grids, ONLY: deallocate_radial_grid, nullify_radial_grid
USE wrappers, ONLY: md5_from_file
USE wrappers, ONLY: md5_from_file, f_remove
USE upf_module, ONLY: read_upf
USE emend_upf_module, ONLY: make_emended_upf_copy
USE upf_to_internal, ONLY: add_upf_grid, set_upf_q
USE read_uspp_module, ONLY: readvan, readrrkj
USE m_gth, ONLY: readgth
@ -64,7 +65,8 @@ SUBROUTINE readpp ( input_dft, printout, ecutwfc_pp, ecutrho_pp )
! 2D Coulomb cutoff: modify this (at your own risks) if problems with cutoff
! being smaller than pseudo rcut. original value=10.0
CHARACTER(len=256) :: file_pseudo ! file name complete with path
LOGICAL :: printout_ = .FALSE., exst
CHARACTER(len=256) :: msg
LOGICAL :: printout_ = .FALSE., exst, is_xml
INTEGER :: iunps, isupf, nt, nb, ir, ios
INTEGER :: iexch_, icorr_, igcx_, igcc_, inlc_
!
@ -155,11 +157,38 @@ SUBROUTINE readpp ( input_dft, printout, ecutwfc_pp, ecutrho_pp )
& ' from file :',/,3X,A)") nt, TRIM(file_pseudo)
END IF
!
isupf = 0
CALL read_upf(upf(nt), rgrid(nt), isupf, filename = file_pseudo )
!
!! start reading - check first if files are readable as xml files,
!! then as UPF v.2, then as UPF v.1
!
IF (isupf ==-81 ) THEN
IF ( ionode ) THEN
is_xml = make_emended_upf_copy( TRIM(file_pseudo), &
TRIM(tmp_dir)//TRIM(file_pseudo) )
END IF
!
!! error -81 may mean that file contains offending characters
!! fix and write file to tmp_dir (done by a single processor)
!
CALL read_upf(upf(nt), rgrid(nt), isupf, &
filename = TRIM(tmp_dir)//file_pseudo )
!! then try again to read from the fixed file ,
!
IF (is_xml) THEN
!
WRITE ( msg, '(A)') 'Pseudo file '// trim(file_pseudo) // ' has been fixed on the fly.' &
// new_line('a') // 'To avoid this message in the future, permanently fix ' &
// new_line('a') // ' your pseudo files following these instructions: ' &
// 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
!
IF (ionode) ios = f_remove(TRIM(tmp_dir)//TRIM(file_pseudo) )
!
END IF
!
IF (isupf == -2 .OR. isupf == -1 .OR. isupf == 0) THEN
!
IF( printout_) THEN

83
Modules/upf.f90
View File

@ -20,7 +20,7 @@
!
IMPLICIT NONE
PRIVATE
PUBLIC :: read_upf, scan_begin, scan_end
PUBLIC :: read_upf, check_upf_file, scan_begin, scan_end
!
CONTAINS
@ -34,20 +34,15 @@ SUBROUTINE read_upf(upf, grid, ierr, unit, filename) !
!! 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
!! @Note last revision: 01-01-2019 PG - upf fix moved out from here
!! @Note last revision: 11-05-2018 PG - 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
USE FoX_DOM, ONLY: Node, domException, parseFile, getFirstChild, &
getExceptionCode, getTagName
IMPLICIT NONE
INTEGER,INTENT(IN), OPTIONAL :: unit
!! i/o unit:
@ -57,19 +52,22 @@ SUBROUTINE read_upf(upf, grid, ierr, unit, filename) !
!! 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
INTEGER,INTENT(INOUT) :: ierr
!! On input:
!! ierr=0: return if not a valid xml schema or UPF v.2 file
!! ierr=-81: continue if not a valid xml schema or UPF v.2 file
!! On output:
!! ierr=0: xml schema, ierr=-1: UPF v.1, ierr=-2: UPF v.2
!! ierr>0: error reading PP file
!! ierr=-81: error reading PP file, possibly UPF fix needed
!
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
ferr = ierr
ierr = 0
IF ( present ( unit ) ) THEN
REWIND (unit)
@ -81,32 +79,9 @@ SUBROUTINE read_upf(upf, grid, ierr, unit, filename) !
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=""
IF ( ferr == 0 .AND. ierr == 81 ) THEN
ierr = -81
RETURN
END IF
IF ( ierr == 0 ) THEN
u => getFirstChild(doc)
@ -139,6 +114,34 @@ SUBROUTINE read_upf(upf, grid, ierr, unit, filename) !
END IF
!
END SUBROUTINE read_upf
FUNCTION check_upf_file(filename, errcode) RESULT(ok)
!! checks whether the upf file filename is compliant with xml syntax
!! the error code returned by the checking routine may optionally be
!! written in the errorcode argument
USE FoX_dom, ONLY: Node, DOMException, parseFile, getExceptionCode
IMPLICIT NONE
CHARACTER(LEN=*),INTENT(IN) :: filename
!! name of the upf file being checked
INTEGER,OPTIONAL,INTENT(OUT) :: errcode
!! if present contains the error code returnd by the upf check
LOGICAL :: ok
!! if true the upf file is compliant to xml syntax
!
TYPE(Node),POINTER :: doc
TYPE(DOMException) :: dom_ex
INTEGER :: ierr
doc => parseFile(TRIM(filename), EX = dom_ex)
ierr = getExceptionCode(dom_ex)
IF (PRESENT(errcode)) errcode=ierr
IF (ierr /= 0 ) THEN
ok = .FALSE.
ELSE
ok =.TRUE.
ENDIF
!
END FUNCTION check_upf_file
!=----------------------------------------------------------------------------=!
END MODULE upf_module
!=----------------------------------------------------------------------------=!

5
upftools/fix_upf.f90
View File

@ -16,7 +16,8 @@ PROGRAM upf_fixer
!! of the filename preceding the .UPF extension
!
USE wrappers, ONLY: f_copy, f_remove
USE emend_upf_module, ONLY: make_emended_upf_copy, check_upf_file
USE emend_upf_module, ONLY: make_emended_upf_copy
USE upf_module, ONLY : check_upf_file
IMPLICIT NONE
CHARACTER(LEN=256) :: filein, fileout, line
INTEGER :: ios, argc, prefix_len, iarg
@ -72,7 +73,7 @@ PROGRAM upf_fixer
ENDIF
sano = check_upf_file(TRIM(filein))
IF (.NOT. sano ) THEN
CALL make_emended_upf_copy( filein, './temp.UPF', is_xml)
is_xml = make_emended_upf_copy( filein, './temp.UPF' )
IF ( .NOT. is_xml ) THEN
PRINT *, "This file is not in xml format !!!! Stopping"
STOP

5
upftools/make.depend
View File

@ -20,6 +20,7 @@ fhi2upf.o : ../Modules/mp_global.o
fhi2upf.o : ../Modules/pseudo_types.o
fhi2upf.o : ../Modules/write_upf.o
fix_upf.o : ../Modules/emend_upf.o
fix_upf.o : ../Modules/upf.o
fix_upf.o : ../Modules/wrappers.o
fpmd2upf.o : ../Modules/kind.o
fpmd2upf.o : ../Modules/parameters.o
@ -38,12 +39,14 @@ read_upf_tofile.o : ../Modules/radial_grids.o
read_upf_tofile.o : ../Modules/upf.o
rrkj2upf.o : ../Modules/constants.o
rrkj2upf.o : write_upf.o
upf2casino.o : ../Modules/emend_upf.o
upf2casino.o : ../Modules/environment.o
upf2casino.o : ../Modules/io_global.o
upf2casino.o : ../Modules/mp_global.o
upf2casino.o : ../Modules/pseudo_types.o
upf2casino.o : ../Modules/radial_grids.o
upf2casino.o : ../Modules/upf.o
upf2casino.o : ../Modules/wrappers.o
upf2casino.o : casino_pp.o
upf2upf2.o : ../Modules/pseudo_types.o
upf2upf2.o : ../Modules/radial_grids.o
@ -51,6 +54,7 @@ upf2upf2.o : ../Modules/read_upf_v1.o
upf2upf2.o : ../Modules/write_upf.o
vanderbilt.o : ../Modules/constants.o
vanderbilt.o : write_upf.o
virtual_v2.o : ../Modules/emend_upf.o
virtual_v2.o : ../Modules/environment.o
virtual_v2.o : ../Modules/funct.o
virtual_v2.o : ../Modules/io_global.o
@ -59,4 +63,5 @@ virtual_v2.o : ../Modules/pseudo_types.o
virtual_v2.o : ../Modules/radial_grids.o
virtual_v2.o : ../Modules/splinelib.o
virtual_v2.o : ../Modules/upf.o
virtual_v2.o : ../Modules/wrappers.o
virtual_v2.o : ../Modules/write_upf.o

14
upftools/upf2casino.f90
View File

@ -14,7 +14,8 @@ PROGRAM upf2casino
! Convert a pseudopotential written in UPF
! format to CASINO tabulated format
USE upf_module
USE emend_upf_module, ONLY: make_emended_upf_copy
USE wrappers, ONLY: f_remove
USE radial_grids, ONLY : radial_grid_type, deallocate_radial_grid, &
& nullify_radial_grid
USE pseudo_types, ONLY : pseudo_upf, nullify_pseudo_upf, deallocate_pseudo_upf
@ -29,6 +30,7 @@ PROGRAM upf2casino
TYPE(pseudo_upf) :: upf_in
CHARACTER(LEN=256) :: filein, fileout
TYPE(radial_grid_type) :: grid
LOGICAL :: is_xml
CALL nullify_pseudo_upf ( upf_in )
CALL nullify_radial_grid ( grid )
@ -42,7 +44,7 @@ PROGRAM upf2casino
WRITE(0,*) 'output printed in pp.out'
WRITE(0,*) 'All pseudopotential files generated should be &
&thoroughly checked.'
WRITE(0,*) 'In paticular make sure the local channel chosen&
WRITE(0,*) 'In particular make sure the local channel chosen&
& in the CASINO pp file is what you expected.'
CALL get_file ( filein )
@ -55,7 +57,13 @@ PROGRAM upf2casino
ENDIF
fileout = filein(1:prefix_len) //'out'
CALL read_upf( upf_in, IERR = ios, GRID = grid, FILENAME = TRIM(filein) )
CALL read_upf( upf_in, IERR = ios, GRID = grid, FILENAME = TRIM(filein) )
IF (ios ==-81 ) THEN
IF (ionode) is_xml = make_emended_upf_copy( TRIM(filein), 'tmp.upf' )
CALL read_upf(upf_in, IERR = ios, GRID = grid, FILENAME = 'tmp.upf' )
IF (ionode) ios = f_remove('tmp.upf' )
END IF
IF (upf_in%typ /= 'NC') THEN
WRITE(0,*) ''
WRITE(0,*) 'WRONG PSEUDOPOTENTIAL!'

27
upftools/virtual_v2.f90
View File

@ -29,13 +29,14 @@ PROGRAM virtual_test
USE pseudo_types, ONLY : pseudo_upf, nullify_pseudo_upf, &
deallocate_pseudo_upf
USE upf_module, ONLY : read_upf
USE emend_upf_module, ONLY: make_emended_upf_copy
USE wrappers, ONLY: f_remove
USE write_upf_module, ONLY : write_upf
USE radial_grids, ONLY : radial_grid_type, nullify_radial_grid
USE environment, ONLY: environment_start, environment_end
USE mp_global, ONLY: mp_startup, mp_global_end
USE io_global, ONLY: ionode, stdout
!
IMPLICIT NONE
!
@ -48,6 +49,7 @@ PROGRAM virtual_test
INTEGER :: ios
TYPE (pseudo_upf) :: upf(2), upf_vca
TYPE (radial_grid_type) :: grid(2)
LOGICAL :: is_xml
#if defined(__MPI)
CALL mp_startup()
#endif
@ -65,18 +67,19 @@ PROGRAM virtual_test
DO is=1,2
PRINT '('' Input PP file # '',i2,'' in UPF format > '',$)', is
READ (5, '(a)', end = 20, err = 20) filein(is)
! nullify objects as soon as they are instantiated
READ (5, '(a)', end = 20, err = 20) filein(is)
! nullify objects as soon as they are instantiated
CALL nullify_pseudo_upf(upf(is))
CALL nullify_radial_grid(grid(is))
CALL read_upf(upf(is), GRID = grid(is), IERR = ierr,FILENAME = TRIM(filein(is)))
!
CALL nullify_radial_grid(grid(is))
CALL read_upf(upf(is), GRID = grid(is), IERR = ierr, FILENAME = TRIM(filein(is)))
IF (ierr ==-81 ) THEN
IF (ionode) is_xml = make_emended_upf_copy( TRIM(filein(is)), 'tmp.upf' )
CALL read_upf(upf(is), GRID = grid(is), IERR = ierr, FILENAME = 'tmp.upf' )
IF (ionode) ios = f_remove('tmp.upf' )
END IF
IF (ierr/=0 .AND. ierr/=-1) THEN
print *, ierr
CALL errore('virtual_test', 'reading pseudo upf', ierr)