1*
2* $Id$
3*
4
5*     ***********************************
6*     *             			*
7*     *           psi_get_ne		*
8*     *             			*
9*     ***********************************
10
11      subroutine psi_get_ne(ispin,ne)
12      implicit none
13      integer ispin,ne(2)
14
15#include	"stdio.fh"
16#include	"util.fh"
17
18*    *** local variables ***
19      logical oprint
20      integer version,l
21      integer nfft(3)
22      real*8  unita(3,3)
23      character*50 filename
24      character*255 full_filename
25
26      integer MASTER,taskid
27      parameter(MASTER=0)
28      integer msglen
29
30
31*     ***** local functions ****
32      logical      control_print
33      external     control_print
34      character*50 control_input_psi
35      external     control_input_psi
36      double precision control_unita
37      external         control_unita
38      integer  control_ngrid
39      external control_ngrid
40
41      call Parallel_taskid(taskid)
42      oprint = ((taskid.eq.MASTER).and.control_print(print_medium))
43
44*     **** open ELCIN binary file ****
45      if (taskid.eq.MASTER) then
46         filename = control_input_psi()
47         call util_file_name_noprefix(filename,.false.,
48     >                                .false.,
49     >                       full_filename)
50         l = index(full_filename,' ') -1
51         call openfile(4,full_filename,l,'r',l)
52         call iread(4,version,1)
53         call iread(4,nfft,3)
54         call dread(4,unita,9)
55         call iread(4,ispin,1)
56         call iread(4,ne,2)
57         call closefile(4)
58      end if
59
60c     **** send header to all nodes ****
61      msglen = 1
62      call Parallel_Brdcst_ivalues(MASTER,msglen,version)
63      msglen = 3
64      call Parallel_Brdcst_ivalues(MASTER,msglen,nfft)
65      msglen = 9
66      call Parallel_Brdcst_values(MASTER,msglen,unita)
67      msglen = 1
68      call Parallel_Brdcst_ivalues(MASTER,msglen,ispin)
69      msglen = 2
70      call Parallel_Brdcst_ivalues(MASTER,msglen,ne)
71
72
73*     ***** Error checking ****
74      if ( (nfft(1).ne.control_ngrid(1)) .or.
75     >     (nfft(2).ne.control_ngrid(2)) .or.
76     >     (nfft(3).ne.control_ngrid(3)) ) then
77         if (oprint) then
78            write(luout,*) "Error reading psi - bad grid"
79            write(luout,*) "nfft :",nfft
80            write(luout,*) "ngrid:",control_ngrid(1),
81     >                              control_ngrid(2),
82     >                              control_ngrid(3)
83
84         end if
85      end if
86
87      if ( (unita(1,1).ne.control_unita(1,1)) .or.
88     >     (unita(2,1).ne.control_unita(2,1)) .or.
89     >     (unita(3,1).ne.control_unita(3,1)) .or.
90     >     (unita(1,2).ne.control_unita(1,2)) .or.
91     >     (unita(2,2).ne.control_unita(2,2)) .or.
92     >     (unita(3,2).ne.control_unita(3,2)) .or.
93     >     (unita(1,3).ne.control_unita(1,3)) .or.
94     >     (unita(2,3).ne.control_unita(2,3)) .or.
95     >     (unita(3,3).ne.control_unita(3,3)) ) then
96         if (oprint) then
97          write(luout,*) "Error reading psi - bad unitcell"
98          write(luout,*) " - Ignored if the following  parameter is set"
99          write(luout,*) " - set nwpw:psi_nolattice .true."
100         end if
101
102      end if
103
104
105      return
106      end
107
108*     ***********************************
109*     *             			*
110*     *        psi_get_ne_excited	*
111*     *             			*
112*     ***********************************
113
114      subroutine psi_get_ne_excited(ispin,ne)
115      implicit none
116      integer ispin,ne(2)
117
118#include	"stdio.fh"
119#include	"util.fh"
120
121*    *** local variables ***
122      logical oprint
123      integer version,l
124      integer nfft(3)
125      real*8  unita(3,3)
126      character*50 filename
127      character*255 full_filename
128
129      integer MASTER,taskid
130      parameter(MASTER=0)
131      integer msglen
132
133
134*     ***** local functions ****
135      logical      control_print
136      external     control_print
137      character*50 control_input_epsi
138      external     control_input_epsi
139      double precision control_unita
140      external         control_unita
141      integer  control_ngrid
142      external control_ngrid
143
144      call Parallel_taskid(taskid)
145      oprint = ((taskid.eq.MASTER).and.control_print(print_medium))
146
147
148*     **** open ELCIN binary file ****
149      if (taskid.eq.MASTER) then
150         filename = control_input_epsi()
151         call util_file_name_noprefix(filename,.false.,
152     >                                .false.,
153     >                       full_filename)
154         l = index(full_filename,' ') -1
155         call openfile(4,full_filename,l,'r',l)
156         call iread(4,version,1)
157         call iread(4,nfft,3)
158         call dread(4,unita,9)
159         call iread(4,ispin,1)
160         call iread(4,ne,2)
161         call closefile(4)
162      end if
163
164c     **** send header to all nodes ****
165      msglen = 1
166      call Parallel_Brdcst_ivalues(MASTER,msglen,version)
167      msglen = 3
168      call Parallel_Brdcst_ivalues(MASTER,msglen,nfft)
169      msglen = 9
170      call Parallel_Brdcst_values(MASTER,msglen,unita)
171      msglen = 1
172      call Parallel_Brdcst_ivalues(MASTER,msglen,ispin)
173      msglen = 2
174      call Parallel_Brdcst_ivalues(MASTER,msglen,ne)
175
176
177*     ***** Error checking ****
178      if ( (nfft(1).ne.control_ngrid(1)) .or.
179     >     (nfft(2).ne.control_ngrid(2)) .or.
180     >     (nfft(3).ne.control_ngrid(3)) ) then
181         if (oprint) then
182            write(luout,*) "Error reading psi - bad grid"
183         end if
184      end if
185
186      if ( (unita(1,1).ne.control_unita(1,1)) .or.
187     >     (unita(2,1).ne.control_unita(2,1)) .or.
188     >     (unita(3,1).ne.control_unita(3,1)) .or.
189     >     (unita(1,2).ne.control_unita(1,2)) .or.
190     >     (unita(2,2).ne.control_unita(2,2)) .or.
191     >     (unita(3,2).ne.control_unita(3,2)) .or.
192     >     (unita(1,3).ne.control_unita(1,3)) .or.
193     >     (unita(2,3).ne.control_unita(2,3)) .or.
194     >     (unita(3,3).ne.control_unita(3,3)) ) then
195         if (oprint) then
196          write(luout,*) "Error reading psi - bad unitcell"
197          write(luout,*) " - Ignored if the following  parameter is set"
198          write(luout,*) " - set nwpw:psi_nolattice .true."
199         end if
200
201      end if
202
203
204      return
205      end
206
207
208*     ***********************************
209*     *             			*
210*     *       psi_get_ne_occupation	*
211*     *             			*
212*     ***********************************
213
214      subroutine psi_get_ne_occupation(ispin,ne,occupation)
215      implicit none
216      integer ispin,ne(2),occupation
217
218#include	"stdio.fh"
219#include	"util.fh"
220
221*    *** local variables ***
222      logical oprint
223      integer version,l
224      integer nfft(3),nbrill
225      real*8  unita(3,3)
226      character*50 filename
227      character*255 full_filename
228
229      integer MASTER,taskid
230      parameter(MASTER=0)
231      integer msglen
232
233
234*     ***** local functions ****
235      logical      control_print
236      external     control_print
237      character*50 control_input_psi
238      external     control_input_psi
239      double precision control_unita
240      external         control_unita
241      integer  control_ngrid
242      external control_ngrid
243
244      call Parallel_taskid(taskid)
245      oprint = ((taskid.eq.MASTER).and.control_print(print_medium))
246
247*     **** open ELCIN binary file ****
248      if (taskid.eq.MASTER) then
249         filename = control_input_psi()
250         call util_file_name_noprefix(filename,.false.,
251     >                                .false.,
252     >                       full_filename)
253
254         l = index(full_filename,' ') -1
255         call openfile(4,full_filename,l,'r',l)
256         call iread(4,version,1)
257         call iread(4,nfft,3)
258         call dread(4,unita,9)
259         call iread(4,ispin,1)
260         call iread(4,ne,2)
261         nbrill = 1
262         if (version.eq.5) call iread(4,nbrill,1)
263         call iread(4,occupation,1)
264         call closefile(4)
265      end if
266
267c     **** send header to all nodes ****
268      msglen = 1
269      call Parallel_Brdcst_ivalues(MASTER,msglen,version)
270      msglen = 3
271      call Parallel_Brdcst_ivalues(MASTER,msglen,nfft)
272      msglen = 9
273      call Parallel_Brdcst_values(MASTER,msglen,unita)
274      msglen = 1
275      call Parallel_Brdcst_ivalues(MASTER,msglen,ispin)
276      msglen = 2
277      call Parallel_Brdcst_ivalues(MASTER,msglen,ne)
278      msglen = 1
279      call Parallel_Brdcst_ivalues(MASTER,msglen,occupation)
280
281
282*     ***** Error checking ****
283      if ( (nfft(1).ne.control_ngrid(1)) .or.
284     >     (nfft(2).ne.control_ngrid(2)) .or.
285     >     (nfft(3).ne.control_ngrid(3)) ) then
286         if (oprint) then
287            write(luout,*) "Error reading psi - bad grid"
288         end if
289      end if
290
291      if ( (unita(1,1).ne.control_unita(1,1)) .or.
292     >     (unita(2,1).ne.control_unita(2,1)) .or.
293     >     (unita(3,1).ne.control_unita(3,1)) .or.
294     >     (unita(1,2).ne.control_unita(1,2)) .or.
295     >     (unita(2,2).ne.control_unita(2,2)) .or.
296     >     (unita(3,2).ne.control_unita(3,2)) .or.
297     >     (unita(1,3).ne.control_unita(1,3)) .or.
298     >     (unita(2,3).ne.control_unita(2,3)) .or.
299     >     (unita(3,3).ne.control_unita(3,3)) ) then
300         if (oprint) then
301          write(luout,*) "Error reading psi - bad unitcell"
302          write(luout,*) " - Ignored if the following  parameter is set"
303          write(luout,*) " - set nwpw:psi_nolattice .true."
304         end if
305
306      end if
307
308
309      return
310      end
311
312