quantum-espresso/upflib/read_ps.f90

124 lines
4.1 KiB
Fortran

!
! 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_new ( psfile, upf, printout, ierr )
!
!! Read PP file "psfile" into structure "upf"
!! Print some information if "printout" is 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)
!! ierr = -7 Goedecker-Teter-Hutter NCPP
!! Should be executed on a single processor
!
USE upf_io, ONLY: stdout
USE pseudo_types, ONLY: pseudo_upf, reset_upf
USE read_upf_v1_module, ONLY: read_upf_v1
USE read_upf_new_module,ONLY: read_upf_new
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) :: printout
TYPE(pseudo_upf), INTENT(out) :: upf
INTEGER, INTENT(out) :: ierr
!
INTEGER :: iunps, l, lm3, lm4, lm5
!
!
CALL reset_upf( upf )
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, '("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 ) ierr = -1
END IF
!
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)
lm3 = max(l-3,1)
lm4 = max(l-4,1)
lm5 = max(l-5,1)
!! 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 IF (psfile (lm3:l) =='.gth' .OR. psfile(lm3:l) == '.GTH' ) THEN
!! FIXME: should be done in the same way as for the other cases
CLOSE (iunps)
ierr = -7
ELSE
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)
RETURN
END IF
END IF
!
!!! CALL set_upf_q (upf)
!! reconstruct Q(r) if needed
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(-7)
WRITE( stdout, "('file format is GTH (Goedecker-Teter-Hutter)')")
CASE DEFAULT
WRITE( stdout, "('file format could not be determined')")
END SELECT
!
END IF
!
END SUBROUTINE read_ps_new