TABLE OF CONTENTS
ABINIT/outwant [ Functions ]
NAME
outwant
FUNCTION
This routine creates an output file containing all the
information needed to run WanT as a post-processing program
The resulting file is 'launch.dat'.
The routine writes to the disk (unformatted file unitwnt) the following informations:
alat - lattice parameter
rprim - primitive translation vectors
ntypat - nr of atom types in elementary cell
tpat - nr of types of atoms in the elementary cell
xcart - cartesian coordinates of the atoms in the elem. cell
ecut - energy cut-off
mband - # of bands taken in calculation (same for each K-pt)
nk(3) - # of k-pts for each direction (uniform grid in the WHOLE BZ)
s0(3) - the origin of the K-space
kg_tmp(3,mpw*mkmem ) - reduced planewave coordinates
imax - Maximum index of a G vector among all k points (see explanation bellow)
nkpt - total no of K-pts
nsppol - nr of spin polarisations (1 or 2)
eig(mband, nkp_tot) - eigenvalues/band/K_point
ngfft(3) - nr of points used for FFT in each direction
wfc(i)- cmplx(cg(1,i),cg(2,i)) - wavefunction
COPYRIGHT
Copyright (C) 2005-2017 ABINIT group (CMorari) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt . For the initials of contributors, see ~abinit/doc/developers/contributors.txt.
INPUTS
dtset <type(dataset_type)>=all input variables for this dataset eig(mband*nkpt*nsppol) = array for holding eigenvalues (Hartree) cg(2,mcg) = planewave coefficients of wavefunction kg(3, mpw*mkmem) = reduced planewave coordinates npwarr(nkpt) = number of planewaves in basis at this k-point mband = maximum number of bands mcg=size of wave-functions array (cg) =mpw*nspinor*mband*mkmem*nsppol nkpt = number of k - points nsppol = 1 for unpolarized, 2 for spin polarized nspinor = number of spinorial components of the wavefunction (on current proc) mkmem = number of k points treated by this node. mpw = maximum dimensioned size of npw prtwant = if set to 1, print 0 in S0 output
OUTPUT
(only writing)
NOTES
PARENTS
outscfcv
CHILDREN
matr3inv,wrtout
SOURCE
64 #if defined HAVE_CONFIG_H 65 #include "config.h" 66 #endif 67 68 #include "abi_common.h" 69 70 subroutine outwant(dtset,eig,cg,kg,npwarr,mband,mcg,nkpt,nsppol,mkmem,mpw,prtwant) 71 72 use defs_basis 73 use defs_abitypes 74 use m_errors 75 use m_profiling_abi 76 use m_hdr 77 78 use m_io_tools, only : open_file 79 80 !This section has been created automatically by the script Abilint (TD). 81 !Do not modify the following lines by hand. 82 #undef ABI_FUNC 83 #define ABI_FUNC 'outwant' 84 use interfaces_14_hidewrite 85 use interfaces_32_util 86 !End of the abilint section 87 88 implicit none 89 90 !Arguments ------------------------------------ 91 !scalars 92 integer :: mband,mcg,mkmem,mpw,nkpt,nsppol,prtwant 93 type(dataset_type),intent(in) :: dtset 94 !arrays 95 integer :: kg(3,mpw*mkmem),npwarr(nkpt) 96 real(dp) :: cg(2,mcg),eig(mband*nkpt*nsppol) 97 98 !Local variables------------------------------- 99 ! the following variables are not used; they are written to 'launch.dat' 100 ! in order to be compatible with the WANT format 101 !scalars 102 integer :: bandtot,i,icount,ifind,ig,ii,iij,ik,ik_,imax 103 integer :: index,index1,ispin_,iunit,iwf,iwf_k,j,k 104 integer :: maxat,ngm,ngw_,nk_,nkp,nspin_ 105 integer :: unitwnt 106 real(dp) :: alat,scal,scal_,tt 107 logical :: twrite=.true. 108 character(len=20) :: section_name 109 character(len=3) :: nameat 110 character(len=500) :: message 111 character(len=fnlen) :: filewnt 112 !arrays 113 integer :: ikg(3),nk(3) 114 integer,allocatable :: iwfi(:,:),kg_tmp(:,:),tpat(:) 115 real(dp) :: drprim(3,3),gmat(3,3),gmod(3),s0(3),t1(3),t2(3) 116 real(dp),allocatable :: xcoord(:,:,:) 117 complex,allocatable :: wfc(:) 118 119 ! *************************************************************************** 120 121 !WARNING: not tested for nsppol,nspinor >1 122 ! 123 !Initialisations 124 nameat = ' ' 125 bandtot=mband*nkpt*nsppol*dtset%nspinor 126 filewnt='launch.dat' 127 128 write(message,'(3a)')ch10,' Opening file for WanT input: ',trim(filewnt) 129 call wrtout(std_out,message,'COLL') 130 131 !Open the file 132 if (open_file(filewnt,message,newunit=unitwnt,form='unformatted', status='unknown') /=0) then 133 MSG_ERROR(message) 134 end if 135 136 !Comments 137 if(prtwant>1) then 138 write(std_out,*) 'Wrong value for prtwant. Reseting to 1' 139 prtwant=1 140 elseif(prtwant==1) then 141 do i=1,3 142 s0(i)=0._dp 143 end do 144 end if 145 146 !Discussion of 'alat' ABINIT/ WanT 147 if(dtset%acell_orig(1,1)==dtset%acell_orig(2,1).and.& 148 dtset%acell_orig(1,1)==dtset%acell_orig(3,1)) then 149 alat=dtset%acell_orig(1,1) 150 do i=1,3 151 do j=1,3 152 drprim( i, j) = dtset%rprim_orig( i, j, 1 ) 153 end do 154 end do 155 else 156 ! Redefining the drprim( i, j) 157 alat=dtset%acell_orig(1,1) 158 do i=1,3 159 do j=1,3 160 drprim( i, j) = dtset%rprim_orig( i, j, 1 )*dtset%acell_orig(j, 1)/alat 161 end do 162 end do 163 end if 164 165 !Now finding the no of k-pt for each direction PARALEL with the 166 !generators of the first B.Z. 167 !First decide if we have the Gamma point in the list; its index in the list is ... index 168 nk(:)=1 169 ifind=0 170 icount=2 171 do i=1,nkpt 172 index1=0 173 do j=1,3 174 if(dtset%kptns(j,i)<tol8) index1=index1+1 175 end do 176 if(index1==3) then 177 index=i 178 ifind=1 179 cycle 180 end if 181 end do 182 if(ifind==0) then 183 write(std_out,*) 'GAMMA POINT NOT IN THE LIST OF KPTS?' 184 do ii=1,nkpt 185 write(std_out,*) (dtset%kptns(j,ii),j=1,3) 186 end do 187 MSG_ERROR("fatal error") 188 end if 189 190 call matr3inv(drprim,gmat) 191 192 !Modules for each vector in recip. space; nb: g(index coord, index point) 193 do j=1,3 194 gmod(j)=0.D0 195 do i=1,3 196 gmod(j)=gmod(j)+gmat(i,j)**2 197 end do 198 gmod(j)=sqrt(gmod(j)) 199 end do 200 if(nkpt==2) then 201 do j=1,3 202 do ii=1,3 203 t1(ii)=dtset%kptns(ii,1)-dtset%kptns(ii,2) 204 end do 205 tt=0._dp 206 do iij=1,3 207 t2(iij)=0._dp 208 do ii=1,3 209 t2(iij)=t2(iij)+t1(ii)*gmat(ii,iij) 210 end do 211 tt=tt + t2(iij)**2 212 end do 213 tt=sqrt(tt) 214 scal=0._dp 215 do ii=1,3 216 scal=scal+t2(ii)*gmat(j,ii) 217 end do 218 scal=abs(scal) 219 ! Compare scal(tt,gmat) with simple product of modules -> paralel or not 220 if(abs(scal-tt*gmod(j))<tol8) nk(j)=2 221 end do 222 223 elseif(nkpt>2) then 224 225 do i=1,nkpt 226 if(i.ne.index) then 227 do ii=1,3 228 t1(ii)=dtset%kptns(ii,index)-dtset%kptns(ii,i) 229 end do 230 tt=0._dp 231 do iij=1,3 232 t2(iij)=0._dp 233 do ii=1,3 234 t2(iij)=t2(iij)+t1(ii)*gmat(ii,iij) 235 end do 236 tt=tt + t2(iij)**2 237 end do 238 tt=sqrt(tt) 239 ! check for each direction in the BZ 240 do j=1,3 241 scal=0._dp 242 do ii=1,3 243 scal=scal+t2(ii)*gmat(j,ii) 244 end do 245 scal=abs(scal) 246 ! Compare scal(t1,gmat) with simple product of modules -> paralel or not 247 if(abs(scal-tt*gmod(j))<tol8) nk(j)=nk(j)+1 248 end do 249 end if 250 end do 251 end if 252 index=1 253 do i=1,3 254 index=index*nk(i) 255 end do 256 257 if(index.ne.nkpt) then 258 write(message,'(a,2i0)')' OutwanT: Wrong assignemt of kpts', index,nkpt 259 MSG_ERROR(message) 260 end if 261 262 !End counting/assigning no of kpts/direction 263 !Reordering the coordinates of all atoms - xcoord array 264 ABI_ALLOCATE(tpat,(dtset%ntypat)) 265 tpat(:)=zero 266 do i=1,dtset%natom 267 do j=1,dtset%ntypat 268 if(dtset%typat(i)==j) tpat(j)=tpat(j)+1 269 end do 270 end do 271 maxat=maxval(tpat(:)) 272 ABI_ALLOCATE(xcoord,(3,maxat,dtset%ntypat)) 273 index=1 274 do i=1, dtset%ntypat 275 do k=1,tpat(i) 276 do j=1,3 277 xcoord(j,k,i)=dtset%xred_orig(j,index,1) 278 end do 279 index=index+1 280 end do 281 end do 282 ! 283 !Defining the kg_tmp list 284 !Preparing the output of reduced coords., in a single list (kg_tmp(3,imax)) 285 !We start with kg_tmp(:,i)=kg(:,i=1,npwarr(1)) then the new coordinates are added 286 !ONLY if they are not allready in the list. An index is associated 287 !for each kg_tmp which allow us to recover kg(3,mpw*nkpt) from 288 !the smaller list kg_tmp(3, imax) 289 ABI_ALLOCATE(kg_tmp,(3,mpw*nkpt)) 290 ABI_ALLOCATE(iwfi,(nkpt,mpw)) 291 kg_tmp(:,:)=zero 292 iwfi(:,:)=zero 293 imax=npwarr(1) 294 index=0 295 296 do i=1, nkpt 297 if(i>1) then 298 index=index+npwarr(i-1) 299 end if 300 do j=1, npwarr(i) 301 if(i.eq.1) then 302 iwfi(i,j)=j 303 if(mkmem>0) kg_tmp(:,j)=kg(:,j) 304 else 305 ifind=0 306 if(mkmem>0) ikg(:)=kg(:,index+j) 307 308 do k=1,imax 309 if(ikg(1)==kg_tmp(1,k)) then 310 if(ikg(2)==kg_tmp(2,k)) then 311 if(ikg(3)==kg_tmp(3,k)) then 312 ifind=1 313 iwfi(i,j)=k 314 end if 315 end if 316 end if 317 end do 318 319 if(ifind==0) then 320 imax=imax+1 321 kg_tmp(:,imax)=ikg(:) 322 iwfi(i,j)=imax 323 end if 324 end if 325 end do 326 end do 327 ngm=imax 328 329 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 330 !PART ONE: writing the header 331 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 332 write(unitwnt) alat 333 write(unitwnt) ( drprim( i, 1 ), i = 1, 3 ) ! save A1 334 write(unitwnt) ( drprim( i, 2 ), i = 1, 3 ) ! save A2 335 write(unitwnt) ( drprim( i, 3 ), i = 1, 3 ) ! save A3 336 !write(std_out,* ) ( drprim( i, 1 ), i = 1, 3 ) ! save A1 337 !write(std_out,* ) ( drprim( i, 2 ), i = 1, 3 ) ! save A2 338 !write(std_out,* ) ( drprim( i, 3 ), i = 1, 3 ) ! save A3 339 340 write(unitwnt) dtset%ntypat 341 !write(std_out,*) dtset%ntypat, 'NTYPAT', tpat 342 343 do i = 1, dtset%ntypat 344 write(unitwnt) tpat(i), nameat 345 write(unitwnt) ((xcoord(j,k,i),j=1,3), k=1, tpat(i)) 346 ! write(std_out,*) tpat(i), nameat 347 ! write(std_out,*) ((xcoord(j,k,i),j=1,3),k=1,tpat(i)), 'XCART' 348 end do 349 ABI_DEALLOCATE(tpat) 350 ABI_DEALLOCATE(xcoord) 351 352 !energy cut-off in Rydberg (WANT option) 353 write (unitwnt) 2._dp*dtset%ecut, mband 354 !write(std_out,*) 2._dp*dtset%ecut, mband 355 write (unitwnt) ( nk(i), i = 1, 3 ), ( s0(j), j = 1, 3 ),ngm 356 !write(std_out,*) ( nk(i), i = 1, 3 ), ( s0(j), j = 1, 3 ),imax 357 write (unitwnt) ( kg_tmp( 1, i ), kg_tmp( 2, i ), kg_tmp( 3, i ), i = 1, ngm ) 358 write (unitwnt) mpw, mband, dtset%nkpt/dtset%nsppol 359 !write(std_out,*) mpw, mband, dtset%nkpt/dtset%nsppol 360 361 do i=1, nkpt 362 write(unitwnt) (iwfi(i,j), j=1,mpw) 363 end do 364 ABI_DEALLOCATE(kg_tmp) 365 366 !Eigenvalues in HARTREE 367 write (unitwnt) ( eig( i ), i = 1, bandtot) 368 write (unitwnt) ( npwarr( ik ), ik = 1, nkpt ) 369 write (unitwnt) ( mband, ik = 1, nkpt ) 370 write (unitwnt) (dtset%ngfft(i),i=1,3), imax, imax 371 !write(std_out,*) ( eig( i ), i = 1, bandtot ) 372 !write(std_out,*) ( npwarr( ik ), ik = 1, nkpt ) 373 !write(std_out,*) ( mband, ik = 1, nkpt ) 374 !write(std_out,*) (dtset%ngfft(i),i=1,3), imax ,imax 375 !a list with the band structure; usefull for 'windows' and 'disentangle' programs 376 !from WanT distribution 377 378 if (open_file('band.gpl',message,newunit=iunit,status='unknown') /=0) then 379 MSG_ERROR(message) 380 end if 381 382 index=1 383 do i=1,mband 384 index=1 385 do j=1,nkpt 386 write(iunit,*) index, Ha_eV*eig(i+(j-1)*mband), eig(i+(j-1)*mband) 387 index=index+1 388 end do 389 write(iunit,*) 390 end do 391 392 close(iunit) 393 394 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 395 !PART TWO: Writing the wavefunction 396 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 397 !not used 398 ngw_=0 399 ik_=0 400 nk_=0 401 ispin_=0 402 nspin_=0 403 scal_=1._dp 404 !!!!!!!!!!!!!!!!!!!!!!!!!! 405 iwf = 1 406 iwf_k=1 407 ABI_ALLOCATE(wfc,(imax)) 408 409 !Loop over k-pt 410 do nkp=1,nkpt 411 ! Not relevant 412 write(unitwnt) twrite, ik_, section_name 413 ! Only 'mband' is relevant here 414 write(unitwnt) ngw_, mband, ik_, nk_, nk_,ispin_, nspin_, scal_ 415 write(unitwnt) imax 416 ! Not relevant 417 write(unitwnt) twrite 418 ! Loop over bands 419 420 ! Preparing WF 421 do k=1,mband 422 if(mkmem >0) then 423 wfc(:)=zero 424 ! From cg to wf: 425 do i=iwf, iwf+npwarr(nkp)-1 426 index=i-iwf+1 427 wfc(iwfi(nkp,index))=cmplx(cg(1,i), cg(2,i), kind(0._dp)) 428 end do 429 iwf=iwf+npwarr(nkp) 430 else 431 message = 'Wrong mkmem in outwant' 432 MSG_ERROR(message) 433 end if 434 write(unitwnt) (wfc(ig), ig=1,imax) 435 ! End loop over bands 436 end do 437 438 ! Not relevant 439 write(unitwnt) twrite 440 ! Not relevant 441 do i=1,mband 442 write(unitwnt) i 443 end do 444 445 ! End loop over k-pts 446 end do 447 448 ABI_DEALLOCATE(iwfi) 449 ABI_DEALLOCATE(wfc) 450 451 call wrtout(std_out,'Closing file','COLL') 452 close(unit=unitwnt) 453 454 end subroutine outwant