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

[skip-CI] More upf cleanup, notably in pseudppotebtial reading. Now all formats 

are read on one processors and broadcast to all others. Temporarily, reading of
GTH pseudopotentials is disabled. May still need some further testing.
This commit is contained in:
Paolo Giannozzi 2023-04-25 10:21:18 +02:00
parent 815047d8b9
commit ef16fa242b
9 changed files with 173 additions and 209 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

100
Modules/read_pseudo.f90
View File

@ -69,14 +69,12 @@ SUBROUTINE readpp ( input_dft, printout, ecutwfc_pp, ecutrho_pp )
CHARACTER(len=512) :: file_pseudo
! file name complete with path
LOGICAL :: printout_ = .FALSE., exst
INTEGER :: iunps, isupf, ierr, nt, nb, ir, ios
INTEGER :: ierr, nt, nb, ir, ios
INTEGER :: iexch_, icorr_, igcx_, igcc_, inlc_
INTEGER :: iexch1, icorr1, igcx1, igcc1, inlc1
!
! ... initializations, allocations, etc
!
iunps = 4
!
IF( ALLOCATED( upf ) ) THEN
DO nt = 1, SIZE( upf )
CALL deallocate_pseudo_upf( upf( nt ) )
@ -88,9 +86,8 @@ SUBROUTINE readpp ( input_dft, printout, ecutwfc_pp, ecutrho_pp )
!
IF ( PRESENT(printout) ) THEN
printout_ = printout .AND. ionode
END IF
IF ( printout_) THEN
WRITE( stdout,"(//,3X,'Atomic Pseudopotentials Parameters',/, &
IF (printout_) &
& WRITE( stdout,"(//,3X,'Atomic Pseudopotentials Parameters',/, &
& 3X,'----------------------------------' )" )
END IF
!
@ -128,87 +125,20 @@ SUBROUTINE readpp ( input_dft, printout, ecutwfc_pp, ecutrho_pp )
END IF
!
IF ( ionode ) THEN
CALL read_upf_new( file_pseudo, upf(nt), ierr )
!
!! start reading - check first if files are readable as xml files,
!! then as UPF v.2, then as UPF v.1
!
IF ( ierr > 0 ) THEN
!! file is not xml or UPF v.2
CALL read_upf_v1 (file_pseudo, upf(nt), ierr )
!! try to read UPF v.1 file
IF ( ierr == 0 ) isupf = -1
ELSE
isupf = ierr
END IF
CALL read_ps_new( file_pseudo, upf(nt), ierr, printout )
!! Try to read first UPF or PSML format
!
END IF
!
CALL mp_bcast (isupf,ionode_id,intra_image_comm)
CALL mp_bcast (ierr,ionode_id,intra_image_comm)
!
IF (isupf == -2 .OR. isupf == -1 .OR. isupf == 0) THEN
!
CALL upf_bcast(upf(nt), ionode, ionode_id, intra_image_comm)
!! broadcast the pseudopotential to all processors
!
IF( printout_) THEN
IF ( isupf == 0 ) THEN
WRITE( stdout, "(3X,'file type is xml')")
ELSE
WRITE( stdout, "(3X,'file type is UPF v.',I1)") ABS(isupf)
END IF
END IF
!
ELSE
!
! FIXME: also for old PP, reading should be done by a single process
!
OPEN ( UNIT = iunps, FILE = file_pseudo, STATUS = 'old', FORM = 'formatted' )
!
! The type of the pseudopotential is determined by the file name:
! *.xml or *.XML UPF format with schema pp_format=0
! *.upf or *.UPF UPF format pp_format=1
! *.vdb or *.van Vanderbilt US pseudopotential code pp_format=2
! *.gth Goedecker-Teter-Hutter NC pseudo pp_format=3
! *.RRKJ3 Andrea's US new code pp_format=4
! none of the above: PWSCF norm-conserving format pp_format=5
!
IF ( upf_get_pp_format( psfile(nt) ) == 2 ) THEN
!
IF( printout_ ) &
WRITE( stdout, "(3X,'file type is Vanderbilt US PP')")
CALL readvan (iunps, upf(nt), ierr)
!
ELSE IF ( upf_get_pp_format( psfile(nt) ) == 3 ) THEN
!
IF( printout_ ) &
WRITE( stdout, "(3X,'file type is GTH (analytical)')")
CALL readgth (iunps, nt, upf(nt), ierr)
!
ELSE IF ( upf_get_pp_format( psfile(nt) ) == 4 ) THEN
!
IF( printout_ ) &
WRITE( stdout, "(3X,'file type is RRKJ3')")
CALL readrrkj (iunps, upf(nt), ierr)
!
ELSE IF ( upf_get_pp_format( psfile(nt) ) == 5 ) THEN
!
IF( printout_ ) &
WRITE( stdout, "(3X,'file type is old PWscf NC format')")
CALL read_ncpp (iunps, upf(nt), ierr)
!
ELSE
!
ierr = 1
!
ENDIF
!
IF (ierr /= 0) CALL errore('readpp', 'file '//TRIM(file_pseudo)//' not readable',1)
! end of reading
!
CLOSE (iunps)
!
ENDIF
IF ( ierr > 0 ) CALL errore('readpp', &
'file '//TRIM(file_pseudo)//' not readable',1)
!! Unrecoverable error
!
CALL upf_bcast(upf(nt), ionode, ionode_id, intra_image_comm)
!! Success: broadcast the pseudopotential to all processors
!
! reconstruct Q(r) if needed
!
@ -384,8 +314,10 @@ SUBROUTINE upf_bcast(upf, ionode, ionode_id, comm)
CALL mp_bcast (upf%r, ionode_id, comm )
CALL mp_bcast (upf%rab, ionode_id, comm )
!
IF ( .NOT. ionode) ALLOCATE( upf%rho_atc(upf%mesh) )
CALL mp_bcast (upf%rho_atc, ionode_id, comm )
IF ( upf%nlcc) THEN
IF ( .NOT. ionode) ALLOCATE( upf%rho_atc(upf%mesh) )
CALL mp_bcast (upf%rho_atc, ionode_id, comm )
END IF
!
IF(.not. upf%tcoulombp) THEN
IF ( .NOT. ionode) ALLOCATE( upf%vloc(upf%mesh) )

9
upflib/read_ncpp.f90
View File

@ -275,8 +275,13 @@ subroutine read_ncpp (iunps, upf, ierr)
upf%is_multiproj=.false.
!
! Set additional, not present, variables to dummy values
allocate(upf%els(upf%nwfc))
upf%els(:) = 'nX'
allocate(upf%els(upf%nwfc), upf%nchi(upf%nwfc), upf%epseu(upf%nwfc))
upf%els(:) = 'nX'
upf%nchi(:) = 0
upf%epseu(:)= 0._dp
allocate(upf%rcut_chi(upf%nwfc), upf%rcutus_chi(upf%nwfc))
upf%rcut_chi(:) = 0._dp
upf%rcutus_chi(:) = 0._dp
allocate(upf%els_beta(upf%nbeta))
upf%els_beta(:) = 'nX'
allocate(upf%rcut(upf%nbeta), upf%rcutus(upf%nbeta))

162
upflib/read_ps.f90
View File

@ -1,27 +1,38 @@
!
! Copyright (C) 2008-2021 Quantum ESPRESSO group
! Copyright (C) 2008-2023 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 .
!
SUBROUTINE read_ps ( psfile, upf, ierr )
SUBROUTINE read_ps_new ( psfile, upf, ierr, printout )
!
! stripped-down version of readpp in Modules/read_pseudo.f90
! for serial execution only and for usage in conversion codes
!! Read PP file "psfile" into structure "upf"
!! Print some information if "printout" is present and true
!! Return an error code in "ierr" as follows:
!! ierr = 81 file cannot be opened (not found or not accessible)
!! ierr > 0 error reading file
!! ierr <= 0 file successfully read, file format is:
!! ierr = 0 UPF xml (unstable, experimental)
!! ierr = -1 UPF v.1 (deprecated)
!! ierr = -2 UPF v.2 (default choice)
!! ierr = -3 psml (experimental, Norm-Conserving only)
!! ierr = -4 old Vanderbilt formatted USPP (deprecated)
!! ierr = -5 old RRKJ3 USPP format (deprecated)
!! ierr = -6 old PWscf NCPP format (deorecated)
!! Should be executed on a single processor
!
USE upf_io, ONLY: stdout
USE pseudo_types, ONLY: pseudo_upf
USE read_upf_v1_module, ONLY: read_upf_v1
USE read_upf_new_module,ONLY: read_upf_new
USE pseudo_types, ONLY: pseudo_upf
USE upf_io , ONLY: stdout
USE upf_to_internal, ONLY: set_upf_q
USE read_uspp_module, ONLY: readvan, readrrkj
USE cpmd_module, ONLY: read_cpmd
USE m_gth, ONLY: readgth
USE fhi, ONLY: readfhi
USE read_uspp_module, ONLY: readvan, readrrkj
USE read_psml_module, ONLY: read_psml
!USE upf_to_internal, ONLY: set_upf_q
!
IMPLICIT NONE
CHARACTER(LEN=256), INTENT(in) :: psfile
LOGICAL, INTENT(IN), OPTIONAL :: printout
TYPE(pseudo_upf), INTENT(out) :: upf
INTEGER, INTENT(out) :: ierr
!
@ -30,88 +41,79 @@ SUBROUTINE read_ps ( psfile, upf, ierr )
!
CALL read_upf_new( psfile, upf, ierr )
!
!! start reading - check first if file is readable as xml file
!! (ierr=0) or as UPF v.2 file (ierr=-2)
!
IF (ierr == 81 ) THEN
WRITE (stdout, '("readpp: file ",A1," not readable")') trim(psfile)
return
WRITE (stdout, '("read_ps_new: file ",A," could not be opened")') trim(psfile)
RETURN
ELSE IF (ierr > 0 ) THEN
!! file is not xml or UPF v.2
CALL read_upf_v1 ( psfile, upf, ierr )
!! try to read UPF v.1 file
IF ( ierr == 0 ) WRITE( stdout, "('file type is UPF v.1')")
ELSE IF ( ierr == 0 ) THEN
WRITE( stdout, "('file type is xml')")
ELSE IF ( ierr ==-2 ) THEN
ierr = 0
WRITE( stdout, "('file type is UPF v.2')")
IF ( ierr == 0 ) ierr = -1
END IF
!
IF ( ierr /= 0 ) THEN
IF ( ierr > 0 ) THEN
!! file is not in any UPF format, try other formats
OPEN ( NEWUNIT=iunps, FILE=psfile, STATUS = 'old', &
FORM = 'formatted', IOSTAT = ierr )
IF (ierr > 0 ) GO TO 10
!
l = LEN_TRIM (psfile)
l = len_trim(psfile)
lm3 = max(l-3,1)
lm4 = max(l-4,1)
lm5 = max(l-5,1)
!
! The type of the pseudopotential is determined by the file name
!
IF (psfile (lm4:l) =='.psml') THEN
!
! Unlike following cases, file must be opened with xml tools
!
WRITE( stdout, "('file type is PSML (experimental)')")
CALL read_psml (psfile, upf)
!
!! For unlikely short file names, avoid OOB error
IF (psfile (lm4:l) == '.psml') THEN
CALL read_psml (psfile, upf, ierr)
IF ( ierr == 0 ) ierr = -3
ELSE IF (psfile (lm3:l) =='.vdb' .OR. psfile (lm3:l) =='.van') THEN
CALL readvan (iunps, upf, ierr)
IF ( ierr == 0 ) ierr = -4
ELSE IF (psfile (lm5:l) =='.RRKJ3') THEN
CALL readrrkj (iunps, upf, ierr)
IF ( ierr == 0 ) ierr = -5
ELSE
!
OPEN ( NEWUNIT=iunps, FILE=psfile, STATUS = 'old', &
FORM = 'formatted', IOSTAT = ierr )
IF (ierr /= 0 ) RETURN
!
IF (psfile (lm3:l) =='.vdb' .OR. psfile (lm3:l) =='.van') THEN
!
WRITE( stdout, "('file type is Vanderbilt US PP')")
CALL readvan (iunps, upf, ierr)
!
ELSE IF (psfile (lm3:l) =='.gth') THEN
!
WRITE( stdout, "('file type is GTH (analytical)')")
CALL readgth (iunps, 1, upf, ierr)
!
ELSE IF (psfile (lm5:l) =='.RRKJ3') THEN
!
WRITE( stdout, "('file type is RRKJ3')")
CALL readrrkj (iunps, upf, ierr)
!
ELSE IF (psfile (lm3:l) =='.cpi' .OR. psfile (l-3:l) =='.fhi') THEN
!
WRITE( stdout, "('file type is FHI .cpi or .fhi format')")
CALL readfhi (iunps, upf)
ierr = 0
!
ELSE IF (psfile (lm4:l) =='.cpmd') THEN
!
WRITE( stdout, "('file type is CPMD NC format')")
CALL read_cpmd (iunps, upf, ierr)
!
ELSE
!
WRITE( stdout, "('file type is old PWscf NC format')")
CALL read_ncpp (iunps, upf, ierr)
!
ENDIF
!
! end of reading
CALL read_ncpp (iunps, upf, ierr)
IF ( ierr == 0 ) ierr = -6
END IF
!
10 IF ( ierr > 0 ) THEN
WRITE (stdout, '("readpp: file ",A," could not be read")') trim(psfile)
CLOSE (iunps)
! Error return
IF ( ierr /= 0 ) RETURN
RETURN
END IF
END IF
!
!!! CALL set_upf_q (upf)
!! reconstruct Q(r) if needed
IF (present(printout)) THEN
!
IF (printout) THEN
!
SELECT CASE(ierr)
CASE(0)
WRITE( stdout, "('file format is UPF xml (experimental)')")
CASE(-1)
WRITE( stdout, "('file format is UPF v.1')")
CASE(-2)
WRITE( stdout, "('file format is UPF v.2')")
CASE(-3)
WRITE( stdout, "('file format is PSML (experimental)')")
CASE(-4)
WRITE( stdout, "('file format is Vanderbilt US PP')")
CASE(-5)
WRITE( stdout, "('file format is RRKJ3')")
CASE(-6)
WRITE( stdout, "('file format is old PWscf NC format')")
CASE DEFAULT
WRITE( stdout, "('file format could not be determined')")
END SELECT
!
END IF
!
ENDIF
END IF
!
! reconstruct Q(r) if needed
!
CALL set_upf_q (upf)
! Normal return
ierr = 0
!
END SUBROUTINE read_ps
END SUBROUTINE read_ps_new

20
upflib/read_psml.f90
View File

@ -5,8 +5,15 @@
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!--------------------------------------------------------
subroutine read_psml ( filename, upf )
!---------------------------------------------------------------------
MODULE read_psml_module
!---------------------------------------------------------------------
!
PUBLIC :: read_psml
!
CONTAINS
!--------------------------------------------------------
subroutine read_psml ( filename, upf, ierr )
!-----------------------------------------------------
!! Read pseudopotential files in PSML format using "xmltools"
!! stores data into the "upf" structure. Note that:
@ -36,7 +43,7 @@ subroutine read_psml ( filename, upf )
!! input : name of file in psml format
TYPE(pseudo_upf), INTENT(OUT) :: upf
!! the derived type storing the pseudo data
INTEGER :: ierr
INTEGER, INTENT(OUT) :: ierr
!! error code (0 if correctly read)
CHARACTER(len=30) :: tag
!! tag where error (ierr != 0) was detected
@ -97,8 +104,10 @@ subroutine read_psml ( filename, upf )
tag = 'pseudo-wave-functions'
call read_psml_pseudo_wave_functions ( ierr )
IF ( ierr /= 0 ) THEN
!! optional tag, may or may not be present
print *, 'read_psml: tag ',trim(tag),' not present'
upf%nwfc = 0
ierr = 0
END IF
!
call xmlr_closetag ( ) ! psml
@ -131,7 +140,6 @@ CONTAINS
INTEGER :: n, nxc, ndum
INTEGER :: xc(6)
CHARACTER(len=3) :: cc
CHARACTER(len=25), external :: libxc_to_qe
!
upf%tvanp = .false.
@ -389,7 +397,7 @@ function libxc_to_qe (nxc, xc)
character(len=25) :: libxc_to_qe
!
libxc_to_qe = 'Not Recognized'
print *, 'nxc, nc = ', nxc,xc
! print *, 'nxc, nc = ', nxc,xc
if ( nxc < 2 ) return
if ( xc(1) == 1 .and. xc(2) == 9 ) then
libxc_to_qe = 'SLA-PZ' ! Perdew-Zunger
@ -402,3 +410,5 @@ function libxc_to_qe (nxc, xc)
end if
!
end function libxc_to_qe
END MODULE read_psml_module

2
upflib/read_upf_new.f90
View File

@ -38,7 +38,7 @@ CONTAINS
TYPE(pseudo_upf),INTENT(OUT) :: upf
!! the derived type storing the pseudo data
INTEGER, INTENT(OUT) :: ierr
!! ierr= -1 : UPF v.2
!! ierr= -2 : UPF v.2
!! ierr= 0 : xml schema
!! ierr=1-4 : error reading PP file
!! ierr= 81 : error opening PP file

58
upflib/read_upf_v1.f90
View File

@ -81,33 +81,33 @@ SUBROUTINE read_upf_v1 ( file_pseudo, upf, ierr )
exit header_loop
endif
enddo header_loop
if (ierr /= 0) GO TO 200
if (ierr > 0) GO TO 200
!
! this should be read from the PP_INFO section
!
upf%generated='Generated by new atomic code, or converted to UPF format'
call scan_end (iunps, "HEADER",ierr)
if (ierr /= 0) GO TO 200
if (ierr > 0) GO TO 200
! Compatibility with later formats:
upf%has_wfc = .false.
!-------->Search for mesh information
call scan_begin (iunps, "MESH", .true., ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
call read_pseudo_mesh (iunps, upf, ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
call scan_end (iunps, "MESH",ierr)
if (ierr /= 0) GO TO 200
if (ierr > 0) GO TO 200
!-------->If present, search for nlcc
if ( upf%nlcc ) then
call scan_begin (iunps, "NLCC", .true.,ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
call read_pseudo_nlcc (iunps, upf, ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
call scan_end (iunps, "NLCC",ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
else
ALLOCATE( upf%rho_atc( upf%mesh ) )
upf%rho_atc = 0.0_DP
@ -116,64 +116,64 @@ SUBROUTINE read_upf_v1 ( file_pseudo, upf, ierr )
if (.not. matches ("1/r", upf%typ) ) then
!-------->Search for Local potential
call scan_begin (iunps, "LOCAL", .true.,ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
call read_pseudo_local (iunps, upf, ierr)
if ( ierr /= 0 ) goto 200
if ( ierr > 0 ) goto 200
call scan_end (iunps, "LOCAL",ierr)
if ( ierr /= 0 ) goto 200
if ( ierr > 0 ) goto 200
!-------->Search for Nonlocal potential
call scan_begin (iunps, "NONLOCAL", .true., ierr)
if ( ierr /= 0 ) goto 200
if ( ierr > 0 ) goto 200
call read_pseudo_nl (iunps, upf, ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
call scan_end (iunps, "NONLOCAL", ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
!--------
else
call set_coulomb_nonlocal(upf)
end if
!-------->Search for atomic wavefunctions
call scan_begin (iunps, "PSWFC", .true.,ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
call read_pseudo_pswfc (iunps, upf, ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
call scan_end (iunps, "PSWFC",ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
!-------->Search for atomic charge
call scan_begin (iunps, "RHOATOM", .true.,ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
call read_pseudo_rhoatom (iunps, upf, ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
call scan_end (iunps, "RHOATOM",ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
!-------->Search for add_info
if (upf%has_so) then
call scan_begin (iunps, "ADDINFO", .true.,ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
call read_pseudo_addinfo (iunps, upf, ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
call scan_end (iunps, "ADDINFO",ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
endif
!-------->GIPAW data
IF ( upf%has_gipaw ) then
CALL scan_begin ( iunps, "GIPAW_RECONSTRUCTION_DATA", .false.,ierr )
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
CALL read_pseudo_gipaw ( iunps, upf, ierr )
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
CALL scan_end ( iunps, "GIPAW_RECONSTRUCTION_DATA",ierr )
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
END IF
!--- Try to get the core radius if not present. Needed by the
! atomic code for old pseudo files
IF (upf%nbeta>0) THEN ! rcutus may be unallocated if nbeta=0
IF(upf%rcutus(1)<1.e-9_DP) THEN
call scan_begin (iunps, "INFO", .true.,ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
call read_pseudo_ppinfo (iunps, upf, ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
call scan_end (iunps, "INFO",ierr)
if ( ierr /= 0 ) go to 200
if ( ierr > 0 ) go to 200
ENDIF
ENDIF

19
upflib/read_uspp.f90
View File

@ -188,13 +188,14 @@ CONTAINS
!
! info on pseudo eigenstates - energies are not used
!
ALLOCATE ( upf%oc(upf%nwfc), upf%lchi(upf%nwfc) )
ALLOCATE ( upf%oc(upf%nwfc), upf%lchi(upf%nwfc), upf%nchi(upf%nwfc) )
ALLOCATE ( nnlz(upf%nwfc), ee(upf%nwfc) )
read( iunps, '(i5,2f15.9)', err=100, iostat=ios ) &
( nnlz(iv), upf%oc(iv), ee(iv), iv=1,upf%nwfc )
do iv = 1, upf%nwfc
i = nnlz(iv) / 100
upf%lchi(iv) = nnlz(iv)/10 - i * 10
upf%nchi(iv) = i
enddo
read( iunps, '(2i5,f15.9)', err=100, iostat=ios ) &
keyps, ifpcor, rinner1
@ -355,8 +356,12 @@ CONTAINS
enddo
!
! Set additional, not present, variables to dummy values
ALLOCATE(upf%els(upf%nwfc))
ALLOCATE(upf%els(upf%nwfc), upf%epseu(upf%nwfc))
upf%els(:) = 'nX'
upf%epseu(:) = 0._dp
ALLOCATE(upf%rcut_chi(upf%nwfc), upf%rcutus_chi(upf%nwfc))
upf%rcut_chi(:) = 0._dp
upf%rcutus_chi(:) = 0._dp
ALLOCATE(upf%els_beta(upf%nbeta))
upf%els_beta(:) = 'nX'
ALLOCATE(upf%rcut(upf%nbeta), upf%rcutus(upf%nbeta))
@ -753,12 +758,14 @@ CONTAINS
read( iunps, '(1p4e19.11)', err=100, iostat=ios ) &
( rdum, nb=1,upf%nwfc )
!
ALLOCATE ( upf%oc(upf%nwfc), upf%lchi(upf%nwfc), upf%lll(upf%nwfc) )
ALLOCATE ( upf%oc(upf%nwfc), upf%lchi(upf%nwfc), upf%nchi(upf%nwfc) )
ALLOCATE ( upf%lll(upf%nwfc) )
!
do nb=1,upf%nwfc
read(iunps,'(a2,2i3,f6.2)',err=100,iostat=ios) &
adum, ndum, upf%lchi(nb), upf%oc(nb)
upf%lll(nb)=upf%lchi(nb)
upf%nchi(nb)=ndum
!
! oc < 0 distinguishes between bound states from unbound states
!
@ -859,8 +866,12 @@ CONTAINS
end if
!
! Set additional, not present, variables to dummy values
allocate(upf%els(upf%nwfc))
ALLOCATE(upf%els(upf%nwfc), upf%epseu(upf%nwfc))
upf%els(:) = 'nX'
upf%epseu(:) = 0._dp
ALLOCATE(upf%rcut_chi(upf%nwfc), upf%rcutus_chi(upf%nwfc))
upf%rcut_chi(:) = 0._dp
upf%rcutus_chi(:) = 0._dp
allocate(upf%els_beta(upf%nbeta))
upf%els_beta(:) = 'nX'
allocate(upf%rcut(upf%nbeta), upf%rcutus(upf%nbeta))

10
upflib/upfconv.f90
View File

@ -32,7 +32,7 @@ PROGRAM upfconv
!
IMPLICIT NONE
TYPE(pseudo_upf) :: upf
INTEGER :: prefix_len, nargs, i,j
INTEGER :: prefix_len, nargs, i,j, ierr
CHARACTER(LEN=256) :: filein, fileout
CHARACTER(LEN=2) :: conversion=' '
CHARACTER(LEN=5) :: schema='none'
@ -102,12 +102,16 @@ PROGRAM upfconv
STOP
END IF
IF ( prefix_len < 1 ) THEN
WRITE(*,*) 'Empty file name, stopping'
WRITE(*,*) 'Empty file, stopping'
STOP
END IF
WRITE(*,*) 'input file: ' // trim(filein), ', output file: ' // trim(fileout)
CALL read_ps ( filein, upf )
CALL read_ps_new ( filein, upf, ierr )
IF ( ierr > 0 ) THEN
WRITE(*,*) 'Cannot read file, stopping'
STOP
END IF
IF ( conversion == "-c" ) THEN
!

2
upflib/virtual_v2.f90
View File

@ -58,7 +58,7 @@ PROGRAM virtual_test
INQUIRE ( FILE = TRIM(filein(is)), EXIST = exst )
IF (.NOT. exst ) CALL upf_error ( 'virtual_v2.x: ', TRIM(filein(is)) // ' not found', 5)
CALL read_ps ( filein(is), upf(is) )
CALL read_ps_new ( filein(is), upf(is), ierr )
PRINT '('' '')'
IF ( TRIM(upf(is)%typ) == 'PAW') CALL upf_error('virtual_v2.x: ', &
'Use of PAW is not implemented', 1)