-
Notifications
You must be signed in to change notification settings - Fork 0
/
rdVec.f90
244 lines (207 loc) · 6.29 KB
/
rdVec.f90
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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
SUBROUTINE fopen(fhp, filename, nkp, nsymop, norbitals)
INTEGER, intent(in) :: fhp
CHARACTER*100, intent(in) :: filename
INTEGER, intent(out) :: nkp, nsymop, norbitals
open(fhp, file=filename, status='old', form='unformatted')
READ(fhp) nkp, nsymop, norbitals
END SUBROUTINE fopen
SUBROUTINE fclose(fhp)
INTEGER, intent(in) :: fhp
close(fhp)
END SUBROUTINE fclose
SUBROUTINE Read1(fhp, norbitals, nindo)
INTEGER, intent(in) :: fhp, norbitals
INTEGER, intent(out) :: nindo(norbitals)
INTEGER :: iorb
READ(fhp) (nindo(iorb), iorb=1,norbitals)
!print *, nindo
END SUBROUTINE Read1
SUBROUTINE Read2(fhp, iikp, nbands, tmaxdim2, tnorbitals, nemin)
INTEGER, intent(in) :: fhp
INTEGER, intent(out) :: iikp, nbands, tmaxdim2, tnorbitals, nemin
READ(fhp) iikp, nbands, tmaxdim2, tnorbitals, nemin
END SUBROUTINE Read2
SUBROUTINE Read3(fhp, iisym)
INTEGER, intent(in) :: fhp
INTEGER, intent(out) :: iisym
READ(fhp) iisym
END SUBROUTINE Read3
SUBROUTINE Read4(fhp, nbands, DMFTU)
INTEGER, intent(in) :: fhp, nbands
COMPLEX*16, intent(out) :: DMFTU(nbands)
!locals
INTEGER :: i
READ(fhp) (DMFTU(i),i=1,nbands)
END SUBROUTINE Read4
SUBROUTINE fEopen(fh, filename, nat, parseline1, parseline2)
IMPLICIT NONE
INTEGER, intent(in) :: fh, nat
CHARACTER*100, intent(in) :: filename
CHARACTER*400, intent(out) :: parseline1(nat), parseline2(nat)
! locals
INTEGER :: i
open(fh,FILE=filename,STATUS='old',form='formatted')
DO I=1,NAT
READ(fh,'(a)') parseline1(i)
READ(fh,'(a)') parseline2(i)
ENDDO
END SUBROUTINE fEopen
SUBROUTINE fEclose(fh)
IMPLICIT NONE
INTEGER, intent(in) :: fh
close(fh)
END SUBROUTINE fEclose
SUBROUTINE fERead1(fh, K, KNAME, wgh, ios, n0, nen)
IMPLICIT NONE
INTEGER, intent(in) :: fh
REAL*8, intent(out) :: K(3), wgh
CHARACTER*10, intent(out) :: KNAME
INTEGER, intent(out):: ios, n0, nen
!
READ(fh,'(3e19.12,a10,2i6,f5.2)',IOSTAT=ios) K(1),K(2),K(3),KNAME,n0,nen,wgh
END SUBROUTINE fERead1
SUBROUTINE fERead2(fh, nen, Ek)
INTEGER, intent(in):: fh, nen
REAL*8, intent(out):: Ek(nen)
INTEGER :: ii
DO ii=1,nen
READ(fh,*) NUM, Ek(ii)
ENDDO
END SUBROUTINE fERead2
SUBROUTINE fWEopen(fh, filename, nat, parseline1, parseline2)
IMPLICIT NONE
INTEGER, intent(in) :: fh, nat
CHARACTER*100, intent(in) :: filename
CHARACTER*400, intent(in) :: parseline1(nat), parseline2(nat)
! locals
INTEGER :: i
open(fh,FILE=filename,STATUS='replace',form='formatted')
DO I=1,NAT
WRITE(fh,'(a)') parseline1(i)
WRITE(fh,'(a)') parseline2(i)
ENDDO
END SUBROUTINE fWEopen
SUBROUTINE fEWrite1(fh, K, KNAME, wgh, ios, n0, nen)
IMPLICIT NONE
INTEGER, intent(in) :: fh, n0, nen
REAL*8, intent(in) :: K(3), wgh
CHARACTER*10, intent(in) :: KNAME
INTEGER, intent(out):: ios
!
WRITE(fh,'(3e19.12,a10,2i6,f5.2)',IOSTAT=ios) K(1),K(2),K(3),KNAME,n0,nen,wgh
END SUBROUTINE fEWrite1
SUBROUTINE fEWrite2(fh, nen, Ek)
INTEGER, intent(in):: fh
INTEGER, intent(in):: nen
REAL*8, intent(in):: Ek(nen)
INTEGER :: ii
DO ii=1,nen
WRITE(fh,*) ii, Ek(ii)
ENDDO
END SUBROUTINE fEWrite2
SUBROUTINE fVopen(Elapw, Elo, fh, filename, nat, lmaxp1, lomaxp1, nloat)
IMPLICIT NONE
REAL*8, intent(out) :: Elapw(nat,lmaxp1), Elo(nat,lomaxp1,nloat+1)
INTEGER, intent(in) :: fh, nat, lmaxp1, lomaxp1, nloat
CHARACTER*100, intent(in) :: filename
! locals
INTEGER :: i,j,k
!print *, filename
open(fh,FILE=filename,STATUS='old',FORM='unformatted')
Elo=0
DO I=1,NAT
READ(fh) (Elapw(i,j),j=1,lmaxp1)
READ(fh) ((Elo(i,j,k),j=1,lomaxp1),k=1,nloat)
!READ(fh) Elinear(1) ! linearization energy
!READ(fh) Elinear(2) ! linearization energy for lo
ENDDO
END SUBROUTINE fVopen
SUBROUTINE fVclose(fh)
IMPLICIT NONE
INTEGER, intent(in) :: fh
! locals
close(fh)
END SUBROUTINE fVclose
SUBROUTINE fVRead1(fh, K, KNAME, wgh, ios, n0, ne)
INTEGER, intent(in) :: fh
REAL*8, intent(out) :: K(3), wgh
CHARACTER*10, intent(out) :: KNAME
INTEGER, intent(out):: ios, n0,ne
READ(fh,IOSTAT=ios) K(1),K(2),K(3),KNAME,n0,ne,wgh
END SUBROUTINE fVRead1
SUBROUTINE fVRead2(fh, n0, GS)
INTEGER, intent(in) :: fh, n0
INTEGER, intent(out) :: GS(3,n0)
INTEGER :: i, ios
READ(fh,IOSTAT=ios) (GS(1,i),GS(2,i),GS(3,i),i=1,n0)
END SUBROUTINE fVRead2
SUBROUTINE fVRead3(fh, n0, NUM, ek, A)
INTEGER, intent(in) :: fh, n0
INTEGER, intent(out) :: NUM
REAL*8, intent(out) :: ek
REAL*8, intent(out) :: A(n0)
INTEGER :: i, ios
READ(fh,IOSTAT=ios) NUM,ek
READ(fh,IOSTAT=ios) (A(i),i=1,n0)
END SUBROUTINE fVRead3
SUBROUTINE fVRead3c(fh, n0, NUM, ek, A)
INTEGER, intent(in) :: fh, n0
INTEGER, intent(out) :: NUM
REAL*8, intent(out) :: ek
COMPLEX*16, intent(out) :: A(n0)
INTEGER :: i, ios
READ(fh,IOSTAT=ios) NUM,ek
READ(fh,IOSTAT=ios) (A(i),i=1,n0)
END SUBROUTINE fVRead3c
!------------------
SUBROUTINE fWopen(fh, filename, nat,Elinear)
IMPLICIT NONE
INTEGER, intent(in) :: fh, nat
CHARACTER*100, intent(in) :: filename
REAL*8, intent(in) :: Elinear(2)
! locals
INTEGER :: i
open(fh,FILE=filename,STATUS='replace',FORM='unformatted')
DO I=1,NAT
WRITE(fh) Elinear(1) ! linearization energy
WRITE(fh) Elinear(2) ! linearization energy for lo
ENDDO
END SUBROUTINE fWopen
SUBROUTINE fWclose(fh)
IMPLICIT NONE
INTEGER, intent(in) :: fh
! locals
close(fh)
END SUBROUTINE fWclose
SUBROUTINE fVWrite1(fh, K, KNAME, wgh, n0, ne, ios)
INTEGER, intent(in) :: fh
REAL*8, intent(in) :: K(3), wgh
CHARACTER*10, intent(in) :: KNAME
INTEGER, intent(in):: n0,ne
INTEGER, intent(out):: ios
WRITE(fh,IOSTAT=ios) K(1),K(2),K(3),KNAME,n0,ne,wgh
END SUBROUTINE fVWrite1
SUBROUTINE fVWrite2(fh, n0, GS)
INTEGER, intent(in) :: fh, n0
INTEGER, intent(in) :: GS(3,n0)
INTEGER :: i, ios
WRITE(fh,IOSTAT=ios) (GS(1,i),GS(2,i),GS(3,i),i=1,n0)
END SUBROUTINE fVWrite2
SUBROUTINE fVWrite3(fh, n0, NUM, ek, A)
INTEGER, intent(in) :: fh, n0
INTEGER, intent(in) :: NUM
REAL*8, intent(in) :: ek
REAL*8, intent(in) :: A(n0)
INTEGER :: i, ios
WRITE(fh,IOSTAT=ios) NUM,ek
WRITE(fh,IOSTAT=ios) (A(i),i=1,n0)
END SUBROUTINE fVWrite3
SUBROUTINE fVWrite3c(fh, n0, NUM, ek, A)
INTEGER, intent(in) :: fh, n0
INTEGER, intent(in) :: NUM
REAL*8, intent(in) :: ek
COMPLEX*16, intent(in) :: A(n0)
INTEGER :: i, ios
WRITE(fh,IOSTAT=ios) NUM,ek
WRITE(fh,IOSTAT=ios) (A(i),i=1,n0)
END SUBROUTINE fVWrite3c