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