1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
! Copyright (C) 2017 Quantum ESPRESSO Foundation
! 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 emend_upf_module
!=----------------------------------------------------------------------------=!
!! author: Pietro Delugas
!! Contains utility to make the old UPF format readable by FoX
#if defined (__use_fox)
PRIVATE
PUBLIC make_emended_upf_copy
CONTAINS
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 :: xml_check
!
INTEGER :: iun_source, iun_dest, ierr
LOGICAL :: icopy = .FALSE.
CHARACTER(LEN=1024) :: line
!
OPEN (NEWUNIT = iun_source, FILE = TRIM(filename), STATUS = 'old', &
ACTION = 'read', FORM='formatted', iostat=ierr)
IF ( ierr /= 0 ) CALL upf_error ("make_emended_upf", &
"error opening file " // TRIM (filename),abs(ierr))
READ ( iun_source, "(a)", IOSTAT = ierr ) line
IF ( ierr < 0 ) CALL upf_error ("make_emended_upf", &
TRIM (filename) // " is empty",abs(ierr))
IF (INDEX(line, '<?xml') == 0 .AND. INDEX(line,'<UPF') == 0) THEN
xml_check = .FALSE.
CLOSE ( iun_source )
RETURN
ELSE
xml_check = .TRUE.
REWIND( iun_source )
END IF
OPEN (NEWUNIT = iun_dest, FILE = TRIM(tempname), STATUS = 'unknown', &
ACTION = 'write', FORM = 'formatted')
copy_loop: DO
!
READ(iun_source, "(a)", IOSTAT = ierr ) line
IF (ierr < 0 ) EXIT copy_loop
!
IF ( INDEX(line,"<UPF") /= 0 ) icopy = .TRUE.
IF ( .NOT. icopy ) CYCLE copy_loop
!
WRITE ( iun_dest,"(a)") TRIM(check( line ))
!
IF ( INDEX( line, "</UPF") /= 0 ) EXIT copy_loop
END DO copy_loop
!
CLOSE ( iun_source)
CLOSE ( iun_dest )
!
END FUNCTION make_emended_upf_copy
!
FUNCTION check(in) RESULT (out)
CHARACTER (LEN = *) :: in
#if defined(__PGI)
INTEGER, PARAMETER :: length = 1024
CHARACTER(LEN=length ) :: out
#else
CHARACTER(LEN = LEN(in) ) :: out
#endif
INTEGER :: i, o, disp
!
disp = 0
DO i = 1, LEN(in)
o = i + disp
IF ( o > LEN (in) ) EXIT
IF (in(i:i) == '&') THEN
out(o:o+4) = '&'
disp = disp+4
ELSE
out(o:o) = in (i:i)
END IF
END DO
IF (o > len(in)) CALL upf_error('emend_upf/check', &
'BEWARE !!! Possible out of bounds while fixing pseudo', -1 )
END FUNCTION check
#endif
END MODULE emend_upf_module
|
