├── CRYSTAL_interface ├── LICENSE.txt ├── READ_ME.txt ├── fortran_source │ ├── bloch_overlap.f90 │ ├── crystal_nbo.f90 │ ├── makefile │ ├── old_make │ └── shared.f90 ├── gpl3.txt ├── read_crystal.py └── sample │ ├── Cu.d12 │ ├── Cu.d3 │ └── crys_2_nbo.sh ├── LICENSE.md ├── NBO ├── LICENSE.txt ├── Makefile ├── Makefile.template ├── READ_ME.txt ├── diag.f ├── gpl3.txt ├── matutil.f90 ├── matutil.mod ├── nao.f90 ├── nao.mod ├── nbo.f90 ├── nbo.mod ├── nbo_main.f90 ├── nbo_shared.f90 ├── nbo_shared.mod ├── periodic_matutil.f90 ├── periodic_matutil.mod ├── pre_nao.f90 ├── pre_nao.mod ├── sortutil.f90 ├── sortutil.mod ├── visual.f90 └── visual.mod ├── README.md └── projection_VASP ├── LICENSE.txt ├── Makefile ├── PAW.f90 ├── READ_ME.txt ├── VASP_patch ├── proj_VASP_4.patch ├── proj_VASP_5.3.patch ├── proj_VASP_5.4.patch └── projection_output.F ├── bloch_overlap.f90 ├── bloch_overlap.mod ├── gpl3.txt ├── paw.mod ├── projection_main.f90 ├── projection_shared.f90 ├── projection_shared.mod ├── rd_basis.f90 ├── rd_basis.mod ├── rd_wavefunction.f90 ├── rd_wavefunction.mod └── sample_systems ├── MgO ├── INCAR ├── KPOINTS ├── POSCAR └── basis.inp ├── Nickel ├── INCAR ├── KPOINTS ├── POSCAR └── basis.inp └── Silicon ├── INCAR ├── KPOINTS ├── POSCAR └── basis.inp /CRYSTAL_interface/LICENSE.txt: -------------------------------------------------------------------------------- 1 | Copyright 2012,2013 Benjamin Dunnington and J.R. Schmidt 2 | 3 | This program is free software: you can redistribute it and/or modify 4 | it under the terms of the GNU General Public License as published by 5 | the Free Software Foundation, either version 3 of the License, or 6 | at your option) any later version. 7 | 8 | This program is distributed in the hope that it will be useful, 9 | but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | GNU General Public License for more details. 12 | 13 | You should have received a copy of the GNU General Public License 14 | along with this program. If not, see . 15 | -------------------------------------------------------------------------------- /CRYSTAL_interface/READ_ME.txt: -------------------------------------------------------------------------------- 1 | ****************** 2 | Interface for CRYSTAL09 with Periodic NBO code of JRS and BDD 3 | 4 | 5/28/14 5 | 6 | ****************** 7 | 8 | The purpose of this code is to take the output of a CRYSTAL09 calculation and produce an input file for the periodic NBO code of BDD and JRS. 9 | Since, the density is already represented by an atom-centered basis in the CRYSTAL program, the main purpose of this code is simply to collect the necessary data from various CRYSTAL output files, and convert it to the appropriate format. 10 | 11 | ****************** 12 | Running Crystal Software 13 | ****************** 14 | 15 | No modification are necessary to the CRYSTAL source code to obtain all the necessary data, but you will have to run the associated program 'properties' to get all the data in a readable format. There are a few requirements for running the codes to produce all the required output. 16 | 17 | 1. Running CRYSTAL 18 | -Gamma centered k-point meshed must be used (odd number of k-points in each direction), but Brillouin Zone symmetry can be employed. 19 | -No printing statements must be made 20 | 2. Running PROPERTIES 21 | -Must be run after the CRYSTAL program has completed. 22 | -This will be used to generate the ${system name}_${system name}_dat.KRED file, which contains the coefficients of each basis function in all the bands. This is used to generate a density matrix and Fock matrix, for use in NBO calculations. 23 | -The input file is a *.d3 file. An example of which can be found in the sample/ folder. The parameters in that sample file are general to any system, except for the second line. The second line should contain the same k-point mesh description used in the *.d12 file used for the CRYSTAL calculation. 24 | 25 | ****************** 26 | Running Interface 27 | ****************** 28 | 29 | There are then two codes that must be run for the creation of the NBO.out file: read_crystal.py and process_crystal.exe. The second is from FORTRAN90 source code that must be compiled, for which a basic makefile is included. An example shell script (crys_2_nbo.sh) to run these is included in the sample/ directory. 30 | 31 | 1. read_crystal.py 32 | -This should be run first. It simply finds relevant information in the CRYSTAL *.out file and prints out the relevant information to the screen. Thus, the output should be forwarded to a file to be read by the process_crystal.exe program. 33 | -The name of the *.out file must be specified when the program is called. 34 | 35 | 2. process_crystal.exe 36 | -This should be run second. 37 | -In addition to taking in the formatted information provided by read_crystal.py, this will also read in the formatted information for the *_*_dat.KRED file produced by the properties program. 38 | -This also performs some additional data manipulation to get all the information needed for an NBO calculation. 39 | -Upon calling this code, the output of read_crytal.py and the *.KRED file must be given by name in order. 40 | -This will output a NBO.out file that can then be read by the periodic NBO executable. 41 | 42 | ****************** 43 | Sample Systems 44 | ****************** 45 | 46 | A sample bulk fcc Cu system is included, with both the crystal and properties input files. The basis set included is a customized bulk fcc Cu basis set. 47 | 48 | -------------------------------------------------------------------------------- /CRYSTAL_interface/fortran_source/makefile: -------------------------------------------------------------------------------- 1 | base=process_crystal.exe 2 | compiler=ifort 3 | MKROOT=/opt/intel/mkl/10.0.3.020 4 | 5 | crystal_nbo: crystal_nbo.f90 6 | $(compiler) shared.f90 bloch_overlap.f90 crystal_nbo.f90 -o $(base) -I$(MKLROOT)/lib/em64t -L$(MKLROOT)/lib/em64t -lmkl_lapack95 -lmkl_solver_lp64_sequential -Wl,--start-group -lmkl_intel_lp64 -lmkl_sequential -lmkl_core -Wl,--end-group -lpthread -lmkl_blas95 -openmp 7 | 8 | -------------------------------------------------------------------------------- /CRYSTAL_interface/fortran_source/old_make: -------------------------------------------------------------------------------- 1 | base=process_crystal.exe 2 | compiler=ifort 3 | MKROOT=/opt/intel/mkl/10.0.3.020 4 | 5 | crystal_nbo: crystal_nbo.f90 6 | $(compiler) shared.f90 bloch_overlap.f90 crystal_nbo.f90 -o $(base) -I$(MKLROOT)/lib/em64t -L$(MKLROOT)/lib/em64t -lmkl_lapack95 -lmkl_solver_lp64_sequential -Wl,--start-group -lmkl_intel_lp64 -lmkl_sequential -lmkl_core -Wl,--end-group -lpthread -lmkl_blas95 -openmp 7 | 8 | -------------------------------------------------------------------------------- /CRYSTAL_interface/fortran_source/shared.f90: -------------------------------------------------------------------------------- 1 | MODULE shared 2 | IMPLICIT NONE 3 | 4 | TYPE AO_function 5 | REAL*8, ALLOCATABLE, DIMENSION(:) :: norm, alpha, coeff 6 | INTEGER :: ngauss 7 | !INTEGER, DIMENSION(3) :: lmn 8 | INTEGER :: atom 9 | REAL*8, DIMENSION(3) :: pos 10 | INTEGER :: level !Keeps track of what basis functions share the same sets of exponents, on the same atom. 11 | INTEGER :: l,m !l- and m-quantum numbers of basis function. m actually runs from 0,2*l+1 and is onyl and index. 12 | 13 | INTEGER :: ncart 14 | INTEGER,ALLOCATABLE :: cart_mat(:,:) 15 | REAL*8,ALLOCATABLE :: cart_coeff(:) 16 | 17 | END TYPE AO_function 18 | 19 | REAL*8, PARAMETER :: bohr = 0.529177249d0 20 | REAL*8, PARAMETER :: hartree = 27.21138386d0 21 | 22 | !TYPE nbo_output 23 | ! INTEGER, DIMENSION(:), ALLOCATABLE :: iatnum 24 | ! CHARACTER(2), DIMENSION(:), ALLOCATABLE :: symbols 25 | ! INTEGER, DIMENSION(:), ALLOCATABLE :: ishellmap 26 | ! INTEGER, DIMENSION(:), ALLOCATABLE :: ibasismap 27 | ! INTEGER, DIMENSION(:), ALLOCATABLE :: ilmap 28 | !END TYPE nbo_output 29 | 30 | 31 | INTERFACE temp_read 32 | MODULE PROCEDURE temp_read_int 33 | MODULE PROCEDURE temp_read_real 34 | MODULE PROCEDURE temp_read_comp 35 | END INTERFACE 36 | 37 | 38 | 39 | 40 | CONTAINS 41 | 42 | 43 | !For a GTO with alphas=expon and cartesian powers=lmn, the norm is--> norm_vec 44 | !The following subroutine comes from: Clementi and Davis, Journal of Comp. Physics; 2,223-244(1967) 45 | SUBROUTINE norm_calc(expon, norm_vec, l) 46 | IMPLICIT NONE 47 | 48 | REAL*8, DIMENSION(:), INTENT(IN) :: expon 49 | REAL*8, DIMENSION(:), INTENT(OUT) :: norm_vec 50 | INTEGER, INTENT(IN) :: l 51 | 52 | REAL*8, PARAMETER :: pi=3.14159265358979323846264338d0 53 | 54 | 55 | norm_vec = ( expon**(2*l+3) * 2.d0**(4*l+3) / pi**3 )**(0.25d0) 56 | 57 | 58 | END SUBROUTINE norm_calc 59 | 60 | 61 | 62 | !Based on the l- and m- indices of the basis function 'AO' the approproate cartesian component is assigned 63 | !The number of cartesian components as well as each's coefficient and exponents are all assigned 64 | !There is not much fancy about this, just chucking the indices and assigning value from there 65 | !Wherever orbitals could be grouped together I have (same ncart's, same coeff's, etc.) 66 | SUBROUTINE interp_cart(AO) 67 | IMPLICIT NONE 68 | 69 | TYPE(AO_Function) :: AO 70 | 71 | IF( AO%l .LT. 2 )THEN !s, px, py, pz 72 | 73 | AO%ncart = 1 74 | ALLOCATE(AO%cart_mat(AO%ncart,3),AO%cart_coeff(AO%ncart)) 75 | AO%cart_coeff = 1.d0 76 | AO%cart_mat = 0 77 | AO%cart_mat(1,AO%m) = AO%l 78 | 79 | ELSEIF( AO%l .EQ. 2 )THEN !d-orbitals 80 | 81 | IF( AO%m .LE. 3 )THEN !yz, xz, xy 82 | AO%ncart = 1 83 | ALLOCATE(AO%cart_mat(AO%ncart,3),AO%cart_coeff(AO%ncart)) 84 | AO%cart_coeff = 1.d0 85 | AO%cart_mat = 1 86 | AO%cart_mat(1,AO%m) = 0 87 | ELSEIF( AO%m .LE. 5 )THEN 88 | 89 | IF( AO%m .EQ. 4 )THEN !x^2-y^2 90 | AO%ncart = 2 91 | ALLOCATE(AO%cart_mat(AO%ncart,3),AO%cart_coeff(AO%ncart)) 92 | AO%cart_coeff(1) = 0.5d0 93 | AO%cart_coeff(2) = -0.5d0 94 | ELSE ! z^2 95 | AO%ncart = 3 96 | ALLOCATE(AO%cart_mat(AO%ncart,3),AO%cart_coeff(AO%ncart)) 97 | AO%cart_coeff = -1.d0 / (2.d0 * SQRT(3.d0)) 98 | AO%cart_coeff(3) = 1.d0 / SQRT(3.d0) 99 | ENDIF 100 | 101 | AO%cart_mat = 0 102 | CALL fill_cart_mat(AO%cart_mat) 103 | 104 | ELSE 105 | STOP 'Improperly indexed d-orbital' 106 | ENDIF 107 | 108 | ELSEIF( AO%l .EQ. 3 )THEN !f-orbitals 109 | 110 | IF( AO%m .EQ. 1 )THEN !xyz orbital 111 | 112 | AO%ncart = 1 113 | ALLOCATE(AO%cart_mat(AO%ncart,3),AO%cart_coeff(AO%ncart)) 114 | AO%cart_coeff = 1.d0 115 | AO%cart_mat = 1 116 | 117 | ELSEIF( AO%m .LE. 4 )THEN 118 | 119 | AO%ncart = 2 120 | ALLOCATE(AO%cart_mat(AO%ncart,3),AO%cart_coeff(AO%ncart)) 121 | 122 | IF( AO%m .EQ. 2 )THEN !z(x^2-y^2) 123 | AO%cart_coeff(1) = 0.5d0 124 | AO%cart_coeff(2) = -0.5d0 125 | ELSEIF( AO%m .EQ. 3 )THEN !y(3x^2-y^2) 126 | AO%cart_coeff(1) = 0.5d0 * SQRT(1.5d0) 127 | AO%cart_coeff(2) = -0.5d0 / SQRT(6.d0) 128 | ELSE !x(x^2-3y^2) 129 | AO%cart_coeff(1) = 0.5d0 / SQRT(6.d0) 130 | AO%cart_coeff(2) = -0.5d0 * SQRT(1.5d0) 131 | ENDIF 132 | 133 | AO%cart_mat = 0 134 | AO%cart_mat(:,5-AO%m) = 1 135 | CALL fill_cart_mat(AO%cart_mat) 136 | 137 | ELSEIF( AO%m .LE. 7 )THEN 138 | 139 | AO%ncart = 3 140 | ALLOCATE(AO%cart_mat(AO%ncart,3),AO%cart_coeff(AO%ncart)) 141 | 142 | IF( AO%m .LE. 6 )THEN !xz^2 and yz^2 143 | AO%cart_coeff(3) = 2.d0 / SQRT(10.d0) 144 | AO%cart_coeff(1:2) = -0.5d0 / SQRT(10.d0) 145 | ELSE !z^3 146 | AO%cart_coeff(3) = 1.d0 / SQRT(15.d0) 147 | AO%cart_coeff(1:2) = -0.5d0 * SQRT(0.6d0) 148 | ENDIF 149 | 150 | AO%cart_mat = 0 151 | AO%cart_mat(:,AO%m-4) = 1 152 | CALL fill_cart_mat(AO%cart_mat) 153 | 154 | ELSE 155 | WRITE(6,*)'Improper m-index given to an f-orbital',AO%m 156 | STOP 157 | ENDIF 158 | 159 | ELSE 160 | STOP 'can only interpret up to d-type orbitals in interp_cart' 161 | ENDIF 162 | 163 | 164 | CONTAINS 165 | 166 | !For many orbitals the cartesian exponents have a squared factor across all components 167 | !This is an overly simple subroutine, but it greatly cleans up the assignments above. 168 | SUBROUTINE fill_cart_mat(cart_mat) 169 | IMPLICIT NONE 170 | INTEGER,INTENT(INOUT) :: cart_mat(:,:) 171 | INTEGER :: j 172 | 173 | DO j=1,SIZE(cart_mat,1) 174 | cart_mat(j,j) = cart_mat(j,j) + 2 175 | ENDDO 176 | 177 | END SUBROUTINE 178 | 179 | 180 | 181 | END SUBROUTINE 182 | 183 | 184 | !The following 3 subroutines are for reading in an array which has arbitrary formatting in a file 185 | !They are interfaced for each particular type of variable (integer, real, complex) 186 | !The general structure is to read all the necessary information in then assign that properly into the array. 187 | 188 | !First is for integer type data. 189 | SUBROUTINE temp_read_int(fn,array) 190 | IMPLICIT NONE 191 | 192 | INTEGER,INTENT(IN) :: fn 193 | INTEGER,DIMENSION(:,:),INTENT(OUT) :: array 194 | 195 | INTEGER,DIMENSION(:),ALLOCATABLE :: temp 196 | INTEGER :: i,j,k 197 | 198 | ALLOCATE(temp(SIZE(array,1)*SIZE(array,2))) 199 | 200 | READ(fn,*)temp 201 | 202 | k=0 203 | DO i=1,SIZE(array,1) 204 | DO j=1,SIZE(array,2) 205 | k=k+1 206 | array(i,j)=temp(k) 207 | ENDDO 208 | ENDDO 209 | 210 | END SUBROUTINE temp_read_int 211 | 212 | !Second is for real data 213 | SUBROUTINE temp_read_real(fn,array) 214 | IMPLICIT NONE 215 | 216 | INTEGER,INTENT(IN) :: fn 217 | REAL*8,DIMENSION(:,:),INTENT(OUT) :: array 218 | 219 | REAL*8,DIMENSION(:),ALLOCATABLE :: temp 220 | INTEGER :: i,j,k 221 | 222 | ALLOCATE(temp(SIZE(array,1)*SIZE(array,2))) 223 | 224 | READ(fn,*)temp 225 | 226 | k=0 227 | DO i=1,SIZE(array,1) 228 | DO j=1,SIZE(array,2) 229 | k=k+1 230 | array(i,j)=temp(k) 231 | ENDDO 232 | ENDDO 233 | 234 | 235 | 236 | END SUBROUTINE temp_read_real 237 | 238 | 239 | !Finally is for complex type data. 240 | !Note there is a third input, 'flag'. 241 | !This is to distinguish whether the imaginary components of array will be written. 242 | !So if the data structure 'array' is complex, but all its values are real, there will not in general be zeroes to be read in to 'temp.' 243 | SUBROUTINE temp_read_comp(fn,array,flag) 244 | IMPLICIT NONE 245 | 246 | INTEGER,INTENT(IN) :: fn 247 | COMPLEX*16,DIMENSION(:,:),INTENT(OUT) :: array 248 | INTEGER,INTENT(IN) :: flag !1-only readign in real comp;2-reading in both 249 | 250 | REAL*8,DIMENSION(:),ALLOCATABLE :: temp 251 | INTEGER :: i,j,k 252 | 253 | COMPLEX*16,PARAMETER :: imag_i = (0.d0,1.d0) 254 | 255 | ALLOCATE(temp(flag*SIZE(array,1)*SIZE(array,2))) 256 | 257 | READ(fn,*)temp 258 | k=0 259 | DO i=1,SIZE(array,1) 260 | DO j=1,SIZE(array,2) 261 | k=k+1 262 | array(i,j)=temp(k) 263 | IF( flag .EQ. 2)THEN 264 | k=k+1 265 | array(i,j)=array(i,j)+temp(k)*imag_i 266 | ENDIF 267 | ENDDO 268 | ENDDO 269 | 270 | END SUBROUTINE temp_read_comp 271 | 272 | 273 | 274 | !This subroutine performs a Bloch transform of 'real_mat' to 'bloch_mat' 275 | !The arrays 'l_index' and 'k-index' should coincide with 'real_mat' and 'bloch_mat' respectively, 276 | ! where the n-th vector in 'l_index(:,n)' describes the n-th matrix of 'real_mat(:,:,n)'. 277 | !This procedure can be performed using generalized Fourier Transform routines, but we have found this is already as fast as possible. 278 | !Additionally, using only those k-points of the PW calculation prevents unecessary calculations into many k-points, 279 | ! followed by extrapolation to the necessary ones. 280 | SUBROUTINE real_to_bloch(real_mat,bloch_mat,l_index,k_index) 281 | IMPLICIT NONE 282 | 283 | REAL*8,DIMENSION(:,:,:),INTENT(IN) :: real_mat 284 | COMPLEX*16,DIMENSION(:,:,:),INTENT(OUT) :: bloch_mat 285 | INTEGER,DIMENSION(:,:),INTENT(IN) :: l_index 286 | REAL*8,DIMENSION(:,:),INTENT(IN) :: k_index 287 | 288 | INTEGER :: l_half 289 | INTEGER :: nk,nl 290 | INTEGER :: ik,il 291 | 292 | COMPLEX*16 :: arg 293 | REAL*8, PARAMETER :: pi=3.141592653589793238462d0 294 | COMPLEX*16, PARAMETER :: sqrt_neg_one=(0.d0,1.d0) 295 | 296 | 297 | !Start by making sure all dimensionalities match 298 | !The size of each real_mat and bloch_mat component matrix must be the same size 299 | !There must be an l_vector for each real matrix and a k-vector for each bloch matrix 300 | IF( SIZE(real_mat,1) .NE. SIZE(bloch_mat,1) .OR. SIZE(real_mat,2) .NE. SIZE(bloch_mat,2) )STOP 'real_mat and bloch_mat passed to real_to_bloch are different sizes' 301 | IF( SIZE(real_mat,3) .NE. SIZE(l_index,2) )STOP 'real_mat and l_index passed to real_to_bloch do not match in dimension' 302 | WRITE(6,*)SIZE(bloch_mat,3),SIZE(k_index,2) 303 | IF( SIZE(bloch_mat,3) .NE. SIZE(k_index,2) )STOP 'bloch_mat and k_index passed to real_to_bloch do not match in dimension' 304 | 305 | nk = SIZE(bloch_mat,3) 306 | nl = SIZE(real_mat,3) 307 | l_half = (nl+1)/2 308 | 309 | !The symmetry of l_vectors is once again used arg(l_vector) = CONJG(arg(-l_vector)) 310 | !The k-points from the PW calculation are used, otherwise extrapolation to those points would be necessary. 311 | bloch_mat = 0.d0 312 | 313 | !!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(ik,il,arg) 314 | !!$OMP DO SCHEDULE(STATIC) 315 | DO ik=1,nk 316 | DO il=1,l_half 317 | arg = EXP(sqrt_neg_one*2.d0*pi*DOT_PRODUCT(k_index(:,ik),l_index(:,il))) 318 | bloch_mat(:,:,ik) = bloch_mat(:,:,ik) + real_mat(:,:,il)*arg 319 | IF( il /= l_half )THEN 320 | bloch_mat(:,:,ik) = bloch_mat(:,:,ik) + real_mat(:,:,(nl+1-il))*CONJG(arg) 321 | ENDIF 322 | ENDDO 323 | ENDDO 324 | !!$OMP END DO NOWAIT 325 | !!$OMP END PARALLEL 326 | 327 | 328 | 329 | END SUBROUTINE real_to_bloch 330 | 331 | !This subrotuine performs an Occupancy Weighted Symmetric Orthogonalization 332 | !This orthogonalizes the vectors represented in 'band_coeff' so that 'overlap_mat' becomes an identity matrix 333 | !This process DOES NOT orhtogonalize the atomic orbitals that make up the bands, simply the bands relative to each other 334 | !The bands are in the same original AO basis 335 | !The orhtogonalizing matrix is constructed as W(WSW)^-1/2, where S is the 'overlap_mat' and W is a diagonal matrix containing the occupancy of each band 336 | SUBROUTINE do_OWSO(overlap_mat,band_occ,band_coeff) 337 | USE BLAS95 338 | USE LAPACK95 339 | IMPLICIT NONE 340 | 341 | COMPLEX*16,DIMENSION(:,:),INTENT(IN) :: overlap_mat !Input overlap matrix, used to construct orthogonalizing matrix 342 | REAL*8,DIMENSION(:),INTENT(IN) :: band_occ !Occupancies of bands. OWSO preferentially preserves the character of occupied bands. 343 | COMPLEX*16,DIMENSION(:,:),INTENT(INOUT) :: band_coeff !On output represent the orhtogonalized bands in the AO basis 344 | 345 | COMPLEX*16,DIMENSION(SIZE(overlap_mat,1),SIZE(overlap_mat,1)) :: sym_weight !Used in OWSO equals (WSW), where W is weight_mat. Also used as dummy for BLAS 346 | REAL*8,DIMENSION(SIZE(overlap_mat,1)) :: weight_mat !Diagonal matrix of occupancies to weight orthogonalization. 347 | 348 | COMPLEX*16,DIMENSION(SIZE(overlap_mat,1),SIZE(overlap_mat,1)) :: eigvec !Eigenvectors used in matrix square root 349 | REAL*8,DIMENSION(SIZE(overlap_mat,1)) :: eigval !Eigenvalues used in matrix square root 350 | INTEGER :: INFO !Used to identify error on exit of LAPACK eigenvector subroutine 351 | 352 | COMPLEX*16,DIMENSION(SIZE(overlap_mat,1),SIZE(overlap_mat,1)) :: sqrt_inv !Inverse of the square root of the matrix (WSW) used in orthogonalization 353 | COMPLEX*16,DIMENSION(SIZE(band_coeff,1),SIZE(band_coeff,2)) :: coeff_dummy !Dummy matrix used in BLAS subroutine 354 | 355 | INTEGER :: nbands,iband !Number of bands and counter 356 | 357 | !Start by verifying dimensions of all matrices match 358 | IF( SIZE(overlap_mat,1) .NE. SIZE(overlap_mat,2) )STOP 'Input overlap matrix is not square in do_OWSO subroutine' 359 | nbands = SIZE(overlap_mat,1) 360 | IF( nbands .NE. SIZE(band_occ,1) )STOP 'Input overlap matrix and band occupancies are not the same dimension in do_OWSO subroutine' 361 | IF( nbands .NE. SIZE(band_coeff,2) )STOP 'Input overlap matrix and band coefficients are not the same dimension in do_OWSO subroutine' 362 | 363 | !Construct weight matrix. 364 | !Below some cutoff occupancy, 0.005 is used as the occupancy. 365 | !If real occupancies are used, the WSW matrix will become linear dependent. 366 | !This floor used is still far below full (1) so occupied and unoccupied will be differentiated 367 | DO iband=1,nbands 368 | IF( ABS(band_occ(iband)) > 5.d-3 )THEN 369 | weight_mat(iband) = ABS(band_occ(iband)) 370 | ELSE 371 | weight_mat(iband) = 5.d-3 372 | ENDIF 373 | ENDDO 374 | 375 | !sym_weight = MATMUL(weight_mat, MATMUL(r_mat(:,:,ik),weight_mat)) 376 | !Since weight_mat is a diagonal matrix, the matrix multiplications can be represented as a scaling of either the columns or rows. 377 | !Scaling columns is multiplication by a diagonal matrix from the right 378 | DO iband=1,nbands 379 | sym_weight(:,iband) = overlap_mat(:,iband) * weight_mat(iband) 380 | ENDDO 381 | !Scaling rows is multiplication by a diagonal matrix from the left 382 | DO iband=1,nbands 383 | sym_weight(iband,:) = weight_mat(iband) * sym_weight(iband,:) 384 | ENDDO 385 | 386 | !Now obtain the eigenvectors to obtain the square root matrix 387 | eigvec = sym_weight 388 | CALL HEEV(eigvec,eigval,'V','U',INFO) 389 | IF( INFO /= 0 )THEN 390 | WRITE(6,*)'The eigenvalues of the overlap matrix could not be computed' 391 | WRITE(6,*)'INFO on exit of ZHEEV',INFO 392 | STOP 393 | ENDIF 394 | 395 | !sqrt_inv = MATMUL(eigvec, MATMUL(diag,CONJG(TRANSPOSE(eigvec)))) 396 | !WRITE(6,*)'eigvalues of symm weight matrix' 397 | DO iband=1,nbands 398 | sym_weight(iband,:) = CONJG(eigvec(:,iband)) / SQRT(ABS(eigval(iband))) !Sym_weight is now just a dummy matrix for use in the BLAS routine 399 | !WRITE(6,*)eigval(iband) 400 | ENDDO 401 | !WRITE(6,*) 402 | CALL GEMM(eigvec,sym_weight,sqrt_inv,'N','N',(1.d0,0.d0),(0.d0,0.d0)) 403 | 404 | 405 | !To obtain the orthogonlaizing matrix an additional multiplication by the weight matrix must be applied from the left 406 | !sqrt_inv = MATMUL(weight_mat,sqr_rt_inv) 407 | DO iband=1,nbands 408 | sqrt_inv(iband,:) = weight_mat(iband) * sqrt_inv(iband,:) 409 | ENDDO 410 | 411 | !Now the bands can finally be orhtogonalized 412 | !Note that the original coefficients are lost. They are currently unused but this will have to be rewritten if they become necessary. 413 | coeff_dummy = band_coeff 414 | CALL GEMM(coeff_dummy,sqrt_inv,band_coeff,'N','N',(1.d0,0.d0),(0.d0,0.d0)) 415 | 416 | !WRITE(6,*)'orthogonalized band' 417 | !DO iband=1,nbands 418 | ! WRITE(6,'(28F6.3)')REAL(band_coeff(:,iband)) 419 | ! !WRITE(6,*) 420 | !ENDDO 421 | !WRITE(6,*) 422 | 423 | 424 | END SUBROUTINE do_OWSO 425 | 426 | 427 | 428 | 429 | !This subroutine writes out the contents of a Bloch space matrix 430 | !At each k-point, the matrices are Hermitian so only the lower triangular part is written out. 431 | !An unformatted output file is used for memory considerations. 432 | SUBROUTINE write_sym_matrices(fn,matrix) 433 | IMPLICIT NONE 434 | 435 | INTEGER, INTENT(IN) :: fn !File number index of file that needs to be written to 436 | COMPLEX*16, INTENT(IN) :: matrix(:,:,:) !periodic matrix to write out 437 | INTEGER :: nk !Total number of k vectors to write out a matrix for 438 | INTEGER :: ndim !Dimension of matrices 439 | INTEGER :: i,j,ik 440 | 441 | 442 | IF( SIZE(matrix,1) .NE. SIZE(matrix,2) )STOP 'A non-square matrix has been passed to write_sym_matrices' 443 | ndim = SIZE(matrix,1) 444 | 445 | nk = SIZE(matrix,3) 446 | 447 | DO ik=1,nk 448 | DO i=1,ndim 449 | WRITE(fn)matrix(i,1:i,ik) 450 | ENDDO 451 | ENDDO 452 | 453 | END SUBROUTINE write_sym_matrices 454 | 455 | 456 | 457 | 458 | 459 | !============================================== 460 | !Utility Math Functions 461 | !============================================== 462 | 463 | 464 | !Simple double factorial function. Using an array serves only as a minimal speed up so I will just keep the function form. 465 | INTEGER FUNCTION dble_factor(x) 466 | 467 | INTEGER :: x,n 468 | 469 | IF(x .LT. -1)THEN 470 | WRITE(6,*)'Can not campute the double factorial of a negative number, below -1' 471 | STOP 472 | ENDIF 473 | 474 | dble_factor = 1 475 | n=x 476 | 477 | DO 478 | IF( n .LE. 1 )EXIT 479 | dble_factor = dble_factor * n 480 | n = n - 2 481 | ENDDO 482 | 483 | 484 | END FUNCTION dble_factor 485 | 486 | 487 | !Binomial coefficient function 488 | INTEGER FUNCTION binom_coeff(n,m) !'Selecting m from n' 489 | 490 | INTEGER :: n,m 491 | 492 | IF( m > n )THEN 493 | WRITE(6,*)'impossible to take this binomial coefficient, second entry can not be greater than first' 494 | STOP 495 | ENDIF 496 | 497 | binom_coeff = factor(n) / (factor(m) * factor(n-m)) 498 | 499 | 500 | END FUNCTION binom_coeff 501 | 502 | !Simple factorial function. Using an array serves only as a minimal speed up so I will just keep the function form. 503 | INTEGER FUNCTION factor(x) 504 | 505 | INTEGER :: x,n 506 | 507 | IF(x .LT. 0 ) STOP 'Can not campute the factorial of a negative number' 508 | 509 | factor = 1 510 | n=x 511 | 512 | DO 513 | IF( n .LE. 1 )EXIT 514 | factor = factor * n 515 | n = n - 1 516 | ENDDO 517 | 518 | 519 | END FUNCTION factor 520 | 521 | 522 | 523 | 524 | 525 | END MODULE shared 526 | -------------------------------------------------------------------------------- /CRYSTAL_interface/read_crystal.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/python 2 | import sys 3 | import commands 4 | 5 | ################ 6 | # 7 | #This is a code to interpret the output from a CRYSTAL09 calculation into a usable format to interface with the NBO code of BDD 8 | #The output of this will still have to be processed by a FORTRAN code in order to make it compatible with NBO 9 | #That code is called process_crystal.exe (source=crystal_nbo.f90) 10 | # 11 | ####BDD 6/22/12# 12 | 13 | 14 | fn = sys.argv[1] 15 | 16 | 17 | ############################## 18 | #This function is meant to take a single integer from a file 19 | #First it grabs the line on which 'keyword' is located. 20 | #Then shift is how many 'words' from the end the paramter is on the line. Shift=1 corresponds to the last element. 21 | def get_param(file_name,keyword,shift): 22 | call = "grep '" + keyword + "' " + file_name #prepare the grep call for 'keyword' 23 | line = commands.getoutput( call ) 24 | words = line.split() #break the line into words (by spaces) so that only the value can be obtained 25 | return int(words[len(words)-shift]) #Convert the word to an integer 26 | ############################## 27 | 28 | 29 | ############Start by finding out some general information about the system############### 30 | natom = get_param(fn, 'ATOMS IN THE UNIT CELL', 1) #Number of atoms in the unit cell 31 | nkpts = get_param(fn, 'K POINTS IN THE IBZ', 1) #Number of k-points used 32 | nbasis = get_param(fn, 'NUMBER OF AO', 7) #Numer of basis functions 33 | 34 | #Output all dem parameters 35 | print nkpts, ' #nkpts' 36 | print natom, ' #natom' 37 | print nbasis, ' #nbasis' 38 | print 39 | 40 | 41 | ############################### 42 | #This functions will look for a keyword 'test' in a file and then collect 'dim' number of lines into 'arr' after skipping 'shift' lines 43 | def parse(file_name,test,shift,dim,arr): 44 | file_name.seek(0) #Start by shifting the cursor in the file to the beginning, this way guaranteed to find the keyword 45 | j=0 #Counter that will be used to know when to start looking at lines 46 | for line in file_name: 47 | if test in line: 48 | j=dim+shift #When the keyword has been found, set up the counter to know when to start and how many lines to print 49 | elif j > 0: #Start iterating counter 50 | if j <= dim: #if the shift interpreting lines from the file 51 | arr[dim-j]=line.split() #Lines are read in as split into words, greatly easing manipluation outside of the parse functions 52 | j = j-1 53 | ############################### 54 | 55 | 56 | ######Now we will begin parsing out information besides systems parameters####### 57 | 58 | #Begin by casting the CRYSTAL output file as a file type 59 | fn = file( sys.argv[1], 'r') 60 | 61 | 62 | ##First thing to find is the lattice vectors## 63 | lattice=range(3) 64 | parse(fn,'CARTESIAN COMPONENTS',1,3,lattice) 65 | #print 'lattice vectors in ang, each line is new vector, colums are cartesian dimension' 66 | #for i in range(3): #Write out the lattice vectors to the screen 67 | # for j in range(3): 68 | # print lattice[i][j], 69 | # print 70 | #print 71 | 72 | 73 | ##Now find some information on the atoms of the system## 74 | temp=range(natom) #The line has various useful information so this array will be further interpreted 75 | parse(fn,'CARTESIAN COORDINATES',3,natom,temp) 76 | 77 | #Set up the arrays to store all the different information in coord_temp 78 | atom_number = range(natom) #array for atomic numbers 79 | atom_sym = range(natom) #array for atomic symbold 80 | atom_coord = range(natom) #array for atomic numbers 81 | 82 | #Actually get the information out of coord_temp 83 | for x in range(natom): 84 | #print x, coord_temp[x][1] 85 | atom_number[x] = temp[x][1] 86 | atom_sym[x] = temp[x][2] 87 | atom_coord[x] = temp[x][3:6] 88 | 89 | 90 | ##Get information about the basis set## 91 | fn.seek(0) 92 | 93 | for line in fn: 94 | if 'END' in line: #made it to beginning of basis set block 95 | break 96 | temp=range(0) #This will hold all basis set information 97 | for line in fn: 98 | if 'END' in line: 99 | break 100 | else: 101 | temp.append(line.split()) 102 | 103 | #print 'processed basis input' 104 | #print temp 105 | #print 106 | 107 | x = 0 108 | itype = 0 109 | 110 | shells = range(itype) 111 | dim = range(itype) 112 | index = range(itype) 113 | orb_types = range(itype) 114 | num_gauss = range(itype) 115 | 116 | shift = 0 117 | 118 | while x < 1: 119 | 120 | index.append(int(temp[shift][0])) 121 | shells.append(int(temp[shift][1])) 122 | dim.append(0) 123 | 124 | orb_types.append(range(shells[itype])) 125 | num_gauss.append(range(shells[itype])) 126 | 127 | #print 'itype '+str(itype)+':',index[itype],shells[itype] #,dim[itype] 128 | 129 | for j in range(shells[itype]): 130 | shift = shift + 1 131 | 132 | orb_types[itype][j] = int(temp[shift][1]) #Type of basis function 133 | 134 | if orb_types[itype][j] == 0: 135 | dim[itype] = dim[itype] + 1 #s type 136 | elif orb_types[itype][j] == 1: 137 | dim[itype] = dim[itype] + 4 #sp type 138 | elif orb_types[itype][j] == 2: 139 | dim[itype] = dim[itype] + 3 #p type 140 | elif orb_types[itype][j] == 3: 141 | dim[itype] = dim[itype] + 5 #d type 142 | else: 143 | sys.exit('Unrecognized orbital index in basis set input '+orb_types[itype][1]) 144 | 145 | num_gauss[itype][j] = int(temp[shift][2]) 146 | for k in range(num_gauss[itype][j]): 147 | shift = shift + 1 148 | 149 | shift = shift + 1 #move to next potential type 150 | 151 | if temp[shift][0] == '99' and temp[shift][1] == '0': #This is must be at the end of the CRYSTAL basis set entry, is always last line 152 | x = 1 #the while loop is now exited 153 | else: 154 | itype = itype + 1 155 | 156 | #print 157 | 158 | ntype = len(index) 159 | 160 | #print 'index ',index 161 | #print 'shells ',shells 162 | #print 'orb_type ',orb_types 163 | #print 'num_gauss ',num_gauss 164 | #print 'ntype ',ntype 165 | #print 'dim ',dim 166 | #print 167 | 168 | 169 | #Should have everything I need out of the file by here so close it 170 | fn.close() 171 | #print fn.closed 172 | 173 | ########################### 174 | def clean_str(ls): 175 | """Create a string of all the elements in a list, without commas or brackets""" 176 | cln = '' 177 | for x in range(len(ls)): 178 | if x < len(ls)-1: 179 | cln = cln + str(ls[x]) + ' ' 180 | else: 181 | cln = cln + str(ls[x]) #Avoid a trailing space at the end of the string 182 | return cln 183 | ########################### 184 | 185 | 186 | 187 | #Now take the exponen and coeff out of temp, into a controlled array 188 | basis_output = range(ntype) 189 | shift = 0 190 | for i in range(ntype): 191 | basis_output[i] = range(shells[i]) 192 | for j in range(shells[i]): 193 | shift = shift + 1 194 | basis_output[i][j] = range(num_gauss[i][j]) 195 | for k in range(num_gauss[i][j]): 196 | shift = shift + 1 197 | basis_output[i][j][k] = temp[shift] 198 | #print 199 | shift = shift + 1 200 | 201 | 202 | 203 | #Different basis functions can be used for atoms of the same element type in CRYSTAL 204 | #This code assumes that is not the case and this loop will exit the code if that is so 205 | if ntype > 1: 206 | for i in range(ntype): 207 | for j in range(i+1,ntype): 208 | if index[i]%100 == index[j]%100: 209 | sys.exit('code is not set up to support different basis sets for same element type') 210 | 211 | 212 | #Make sure the indices calculated here cover all of the atomic numbers gathered above 213 | atom_types=range(natom) 214 | dim_test = 0 215 | for i in range(natom): 216 | for j in range(ntype): 217 | if index[j] == int(atom_number[i]): 218 | atom_types[i]=j 219 | dim_test = dim_test + dim[j] 220 | break 221 | else: 222 | sys.exit('For atom '+str(i)+' there is no corresponding basis set '+atom_number[i]) 223 | 224 | 225 | #Make sure the same number of basis functions was calcualted out as was taken from output file 226 | if dim_test != nbasis: 227 | sys.exit('The total numer of basis functions '+str(dim_test)+' is not the same as that taken from file '+str(nbasis)) 228 | 229 | 230 | #Make sure all atom types in basis set are represented in the system. 231 | for j in range(ntype): 232 | for i in range(natom): 233 | if index[j] == int(atom_number[i]): 234 | break 235 | else: 236 | sys.exit('Type '+str(j)+' in the basis set does not correspond to any atom.') 237 | 238 | 239 | 240 | ibasismap=range(0) 241 | shift=1 242 | 243 | ishell = 0 244 | ishellmap=range(0) 245 | 246 | for i in range(natom): 247 | itype = atom_types[i] 248 | ibasismap.append(shift) 249 | for j in range(shells[itype]): 250 | 251 | ishell = ishell + 1 252 | 253 | sp = 0 254 | 255 | if orb_types[itype][j] == 0: #s-type 256 | l = 0 257 | shell_num = 1 258 | elif orb_types[itype][j] == 1: #sp-type 259 | 260 | print num_gauss[itype][j],' num gauss' 261 | for x in range(num_gauss[itype][j]): 262 | print basis_output[itype][j][x][0],' ', 263 | print ' alphas' 264 | for x in range(num_gauss[itype][j]): 265 | print basis_output[itype][j][x][1],' ', 266 | print ' coeffs' 267 | print clean_str(atom_coord[i]), ' position' 268 | print i+1, ' atom' 269 | print 0, 1, ' #l and m' 270 | print 271 | 272 | l = 1 273 | sp = 1 274 | shell_num = 4 275 | elif orb_types[itype][j] == 2: #p-type 276 | l = 1 277 | shell_num = 3 278 | elif orb_types[itype][j] == 3: #d-type 279 | l = 2 280 | shell_num = 5 281 | for m in range(2*l + 1): 282 | 283 | print num_gauss[itype][j],' num gauss' 284 | for x in range(num_gauss[itype][j]): 285 | print basis_output[itype][j][x][0],' ', 286 | print ' alphas' 287 | for x in range(num_gauss[itype][j]): 288 | print basis_output[itype][j][x][1+sp],' ', 289 | print ' coeffs' 290 | print clean_str(atom_coord[i]),' position' 291 | print i+1, ' atom' 292 | print l, m+1, ' #l and m' 293 | print 294 | 295 | 296 | shift = shift + shell_num 297 | for x in range(shell_num): 298 | ishellmap.append(ishell) 299 | 300 | print 301 | 302 | ibasismap.append(shift) 303 | 304 | 305 | 306 | #Write out the atomic information to the screen 307 | print clean_str(atom_number),' #iatnum' 308 | print clean_str(atom_sym),' #symbols' 309 | print clean_str(ibasismap),' #ibasismap' 310 | print clean_str(ishellmap),' #ishellmap' 311 | print 312 | 313 | #print 'lattice vectors in ang, each line is new vector, colums are cartesian dimension' 314 | for i in range(3): #Write out the lattice vectors to the screen 315 | print clean_str(lattice[i]) 316 | #for j in range(3): 317 | # print lattice[i][j], 318 | #print 319 | print 320 | 321 | 322 | for x in range(natom): 323 | print clean_str(atom_coord[x]) 324 | #for y in range(3): 325 | # print atom_coord[x][y], 326 | #print 327 | print 328 | 329 | 330 | -------------------------------------------------------------------------------- /CRYSTAL_interface/sample/Cu.d12: -------------------------------------------------------------------------------- 1 | Copper bulk 2 | CRYSTAL 3 | 0 0 0 4 | 225 5 | 3.632806 6 | 1 7 | 29 0.0 0.0 0.0 8 | END 9 | 29 6 10 | 0 0 6 2.0 1.00 11 | 76794.3800000 1.748161E-03 12 | 11530.7000000 1.339602E-02 13 | 2626.5750000 6.610885E-02 14 | 740.4903000 2.298265E-01 15 | 237.3528000 4.787675E-01 16 | 81.1581800 3.530739E-01 17 | 0 1 6 8.0 1.00 18 | 1610.8140000 2.364055E-03 3.963307E-03 19 | 383.6367000 3.153635E-02 3.110223E-02 20 | 124.1733000 1.269452E-01 1.361350E-01 21 | 46.7467800 -2.262840E-02 3.492914E-01 22 | 19.0656900 -6.192080E-01 4.624780E-01 23 | 7.8715670 -4.585393E-01 2.020102E-01 24 | 0 1 6 8.0 1.00 25 | 64.4573200 -4.331075E-03 -7.523725E-03 26 | 21.8521200 7.412307E-02 -2.975687E-02 27 | 9.4053430 2.542108E-01 6.849654E-02 28 | 3.9991680 -2.874843E-01 4.027141E-01 29 | 1.6702970 -7.291436E-01 4.908490E-01 30 | 0.6596270 -2.113951E-01 1.759268E-01 31 | 0 1 1 1.0 1.00 32 | 0.101 1.0000 1.0000 33 | 0 3 3 10.0 1.00 34 | 30.8534100 9.199905E-02 35 | 8.2649850 3.985021E-01 36 | 2.4953320 6.917897E-01 37 | 0 3 1 0.0 1.00 38 | 0.601 1.0000000 39 | 99 0 40 | END 41 | NOBIPOLA 42 | TOLINTEG 43 | 10 10 10 10 20 44 | POLEORDR 45 | 6 46 | DFT 47 | EXCHANGE 48 | PBE 49 | CORRELAT 50 | PBE 51 | END 52 | SHRINK 53 | 15 30 54 | MAXCYCLE 55 | 70 56 | SMEAR 57 | 0.001 58 | FMIXING 59 | 70 60 | ANDERSON 61 | END 62 | -------------------------------------------------------------------------------- /CRYSTAL_interface/sample/Cu.d3: -------------------------------------------------------------------------------- 1 | NEWK 2 | 15 30 3 | 1 2 4 | 66 -800 67 -800 5 | CRYAPI_OUT 6 | SETPRINT 7 | 2 8 | 55 1 54 1 9 | END 10 | -------------------------------------------------------------------------------- /CRYSTAL_interface/sample/crys_2_nbo.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | #PBS -l nodes=1:ppn=1,mem=1800mb 3 | 4 | 5 | export OMP_NUM_THREADS=1 6 | export OMP_STACKSIZE=800m 7 | 8 | 9 | 10 | 11 | NAME=Cu 12 | 13 | #Parse the relevant information from teh crystal output into a readable format 14 | ./read_crystal.py $NAME.out > cry2nbo.out 15 | 16 | #Then execute fortran processing to generate NBO.out file 17 | ./process_crystal.exe cry2nbo.out ${NAME}_${NAME}_dat.KRED 18 | 19 | 20 | 21 | 22 | 23 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright 2012,2013 Benjamin Dunnington and J.R. Schmidt 2 | 3 | This program is free software: you can redistribute it and/or modify 4 | it under the terms of the GNU General Public License as published by 5 | the Free Software Foundation, either version 3 of the License, or 6 | at your option) any later version. 7 | 8 | This program is distributed in the hope that it will be useful, 9 | but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | GNU General Public License for more details. 12 | 13 | You should have received a copy of the GNU General Public License 14 | along with this program. If not, see . 15 | -------------------------------------------------------------------------------- /NBO/LICENSE.txt: -------------------------------------------------------------------------------- 1 | Copyright 2012,2013 Benjamin Dunnington and J.R. Schmidt 2 | 3 | This program is free software: you can redistribute it and/or modify 4 | it under the terms of the GNU General Public License as published by 5 | the Free Software Foundation, either version 3 of the License, or 6 | at your option) any later version. 7 | 8 | This program is distributed in the hope that it will be useful, 9 | but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | GNU General Public License for more details. 12 | 13 | You should have received a copy of the GNU General Public License 14 | along with this program. If not, see . 15 | -------------------------------------------------------------------------------- /NBO/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile created by mkmf $Id: mkmf,v 13.0 2006/04/10 21:20:01 fms Exp $ 2 | 3 | include Makefile.template 4 | 5 | 6 | .DEFAULT: 7 | -touch $@ 8 | all: nbo.exe 9 | matutil.o: ./matutil.f90 10 | $(FC) $(FFLAGS) -c ./matutil.f90 11 | periodic_matutil.o: ./periodic_matutil.f90 matutil.o 12 | $(FC) $(FFLAGS) -c ./periodic_matutil.f90 13 | nbo.o: ./nbo.f90 matutil.o nbo_shared.o 14 | $(FC) $(FFLAGS) -c ./nbo.f90 15 | nao.o: ./nao.f90 matutil.o nbo_shared.o sortutil.o 16 | $(FC) $(FFLAGS) -c ./nao.f90 17 | nbo_shared.o: ./nbo_shared.f90 matutil.o 18 | $(FC) $(FFLAGS) -c ./nbo_shared.f90 19 | pre_nao.o: ./pre_nao.f90 matutil.o periodic_matutil.o nbo_shared.o sortutil.o 20 | $(FC) $(FFLAGS) -c ./pre_nao.f90 21 | sortutil.o: ./sortutil.f90 22 | $(FC) $(FFLAGS) -c ./sortutil.f90 23 | diag.o: ./diag.f 24 | $(FC) $(FFLAGS) -c ./diag.f 25 | visual.o: ./visual.f90 nbo_shared.o 26 | $(FC) $(FFLAGS) -c ./visual.f90 27 | nbo_main.o: ./nbo_main.f90 periodic_matutil.o nbo_shared.o pre_nao.o nao.o nbo.o visual.o 28 | $(FC) $(FFLAGS) -c ./nbo_main.f90 29 | SRC = ./matutil.f90 ./periodic_matutil.f90 ./nbo.f90 ./nao.f90 ./nbo_shared.f90 ./pre_nao.f90 ./sortutil.f90 ./diag.f ./visual.f90 ./nbo_main.f90 30 | OBJ = matutil.o periodic_matutil.o nbo.o nao.o nbo_shared.o pre_nao.o sortutil.o diag.o visual.o nbo_main.o 31 | clean: neat 32 | -rm -f .cppdefs $(OBJ) nbo.exe 33 | neat: 34 | -rm -f $(TMPFILES) 35 | TAGS: $(SRC) 36 | etags $(SRC) 37 | tags: $(SRC) 38 | ctags $(SRC) 39 | nbo.exe: $(OBJ) 40 | $(LD) $(OBJ) -o nbo.exe $(LDFLAGS) 41 | -------------------------------------------------------------------------------- /NBO/Makefile.template: -------------------------------------------------------------------------------- 1 | #use: mkmf -t Makefile.template -p nbo.exe 2 | #to generate a proper makefile 3 | 4 | MODULE_PATH=/opt/intel/compilers_and_libraries_2019.3.199/mac/mkl/lib 5 | 6 | FC=ifort 7 | LD=ifort 8 | #FFLAGS=-check all -check noarg_temp_created -g -traceback -warn unused -I $(MODULE_PATH) 9 | FFLAGS= -qopenmp -I/opt/intel/compilers_and_libraries_2019.3.199/mac/mkl/include/intel64/lp64 -heap-arrays 64 10 | LDFLAGS=-L$(MODULE_PATH) -lmkl_core -lmkl_intel_lp64 -lmkl_sequential -lmkl_blas95_lp64 -lmkl_lapack95_lp64 -qopenmp 11 | -------------------------------------------------------------------------------- /NBO/READ_ME.txt: -------------------------------------------------------------------------------- 1 | ************************************************* 2 | ************************************************* 3 | 4 | Periodic NBO instructions and guidelines 5 | by BDD 2/26/15 6 | 7 | A description of the algorithm can be found in: 8 | Dunnington and Schmidt, JCTC; 8, 1902-1911 (2012) 9 | ************************************************* 10 | ************************************************* 11 | 12 | This code will calculate the complete set of Natural Bond Orbitals for a periodic 13 | system. 14 | 15 | 16 | ************************************* 17 | ************************************* 18 | ************BASIC RECIPE************* 19 | ************************************* 20 | ************************************* 21 | 22 | 23 | 1. Run an interface code to get NBO.out and NBO_mat.out 24 | 25 | 2. Command to run NBO analysis with optional arguements in brackets 26 | ./nbo.exe NBO.out [nbo.chk] 27 | 28 | 3. Control calculation parameters via nbo.config file. 29 | 30 | 31 | ************************************* 32 | ************************************* 33 | ***********COMMON PROBLEMS*********** 34 | ************************************* 35 | ************************************* 36 | 37 | 38 | If the code crashes and prints "Segmentation fault." you need to increase 39 | OMP_STACKSIZE. 40 | 41 | Diffuse AO-basis functions are not compatible with NPA and NBO analysis. The 42 | definition of 'too diffuse' is more restrictive for bulk systems due to the 43 | increased density and number of nearest neighbors. 44 | 45 | If you are planning to write a checkpoint file, the name you supply must not match 46 | that of an existing file in the working directory. Otherwise, the code will try to 47 | read the already existing file as a checkpoint. 48 | 49 | 50 | ************************************* 51 | ************************************* 52 | ********Compiling Periodic NBO******* 53 | ************************************* 54 | ************************************* 55 | 56 | 57 | The makefile contained with this file will produce an executable called 58 | 'nbo.exe'. 59 | The code uses algorithms from BLAS and LAPACK. We have used the MKL versions. 60 | Modifications to both linking and the subroutine calls will need to be modified 61 | if the MKL libraries are not available. 62 | 63 | 64 | ************************************* 65 | ************************************* 66 | ********Running Periodic NBO********* 67 | ************************************* 68 | ************************************* 69 | 70 | 71 | The executable, 'nbo.exe,' runs with two inputs. 72 | They are listed below in order they will be read in by the program, along with 73 | sample values. 74 | 75 | 1. System parameters file 'NBO.out' 76 | This is a mandatory input and should be the name of the file containing all the 77 | necessary information for NBO analysis. 78 | This file is produced from the projection code or CRYSTAL interface. 79 | The code assumes a specific format and ordering of information in the file. 80 | This file does not contain any matrices, which should be stored in a separate 81 | unformatted file. The name of the unformatted file should be included here. 82 | 83 | 2. Checkpoint file 'nbo.chk' 84 | The second input is optional and is the name of a checkpoint file. 85 | Since performing the transformation into the NAO basis is the rate limiting step 86 | of the calculation, the density matrix in this basis can be stored in a 87 | checkpoint file so that this step need only be performed once. 88 | The code will check to see if the name given matches an existing file in the 89 | working directory. 90 | If a file with that name does not exist, the code will run the calculation to 91 | obtain the NAO basis, then write a checkpoint file with the given name. 92 | If a file with that name does exist, the code will try to read it as a checkpoint 93 | file instead of calculating the NAO basis. 94 | 95 | 96 | ************************************* 97 | ************************************* 98 | ***************Output**************** 99 | ************************************* 100 | ************************************* 101 | 102 | 103 | Most code output is sent to the screen. This includes: 104 | 105 | Natural Population Analysis 106 | Natural Atomic Orbital list for all atoms, with occupancy 107 | Natural Bond Orbitals 108 | -Lone Pairs 109 | -Bonds & Anti-Bonds 110 | -Rydberg Orbitals w/ Occupancy above 10^-3 111 | 112 | For each NBO, the following information is given: 113 | 114 | Occupancy 115 | Hybridization 116 | Coefficients of Natural Hybrid Orbitals in NAO basis. The order is the same as 117 | in NAO occupancy listing. 118 | 119 | The only output file is nbo_vis.out that contains information that can be used to 120 | generate .cube files of each NBO obtained in the analysis. 121 | The program capable of 122 | 123 | 124 | 125 | ************************************* 126 | ************************************* 127 | *********Configuration File********** 128 | ************************************* 129 | ************************************* 130 | 131 | 132 | The nbo.config file is the primary method for controlling parameters in of the 133 | calculation. Upon execution of the program, it will look to see if if such a file 134 | exists. 135 | If the nbo.config file does not exist, default parameters will be used and a 136 | new nbo.config file will be produced. 137 | If the nbo.config file does exist, parameters will be read in. A given 138 | format/ordering of parameters is expected by the code, so modification of an 139 | automatically generated nbo.config file is the safest method of creation. 140 | 141 | As of now this file controls two things: 142 | 1. Occupancy cutoffs used in the NBO search algorithm. 143 | The code is setup to perform an NBO search with a hard occupancy cutoff. 144 | Different cutoffs can be set for lone pairs and bonds. 145 | Use of a checkpoint file is encouraged if you will be varying these cutoffs. 146 | 2. Visualization output of NBOs 147 | The code can output .cube files containing gridded representations of any 148 | desired NBOs. 149 | Default is to output nothing, and it is recommended to identify relevant NBOs 150 | before creating any .cube files. 151 | Visualization will be explained more in its own section. 152 | 153 | ************************************* 154 | ************************************* 155 | ********Visualization Output********* 156 | ************************************* 157 | ************************************* 158 | 159 | 160 | If visualization of the NBOs is desired, the code can generate .cube files of the 161 | gridded electron density, or wavefunction of each orbital. 162 | Due to periodic boundary conditions the volume of a given orbital need not reside 163 | solely in the central unit cell and thus any grid must extend beyond the central 164 | unit cell. However an explicit representation of the central unit cell is useful 165 | for visualization purpose. TO address this, two types of files are created 166 | 167 | 1. lattice_vec.cube - This is a cube file containing only atoms, where the a,b,c 168 | vectors are the same as the central unit cell. The idea is to have a set of 169 | vectors for a single unit cell, but include some atoms from neighboring unit 170 | cells. 171 | 172 | 2. nbo_xxx.cube - This contains an isosurface of the xxxth nbo. The a,b,c vectors 173 | used here are defined by the user and may be larger than a standard unit cell 174 | and the 'origin' is shifted off of the unit cell's. 175 | The ordering of the NBO's is: 176 | i. Lone pairs in the order they were printed to the screen. 177 | ii. Paired bonds and antibonds in the order they were printed to the screen. 178 | Bonds are first. 179 | iii. Rydberg orbitals in order of increasing occupancy by atom. 180 | The ones printed to the screen had the highest occupancy and are therefore 181 | last in a given atom's list. 182 | 183 | In addition to whether or not to visualize, a variety of parameters are controlled 184 | in the nbo.config file. In order they are: 185 | 1. density - [T or F] Whether to grid out the density or the wavefunction. 186 | 2. vis_start vis_end - [Two integers] The beginning and end of the range of NBO's 187 | to plot. 188 | 3. mesh - [Three integers] Resolution of grid point along each lattice direction. 189 | Note this is of the larger box. 190 | 4. box_int - [Three integers] How many total lattice cell vector lengths to 191 | include along each side of the large box for orbital visualization. 192 | 5. origin_fact - [One real] How to shift the origin of the large box with respect to the 193 | central unit cell origin. 194 | 195 | Some useful values for box size: 196 | -To include the central unit cell along with half of each surrounding unit cell 197 | for orbital visualization: 198 | bulk_int = 2 2 2 199 | origin_fact = -0.5 200 | -To only incloud the central unit cell for orbital visualization (useful for 201 | VASP supercells): 202 | bulk_int = 1 1 1 203 | origin_fact = 0.0 204 | 205 | 206 | 207 | 208 | -------------------------------------------------------------------------------- /NBO/diag.f: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Chengcheng-Xiao/Periodic_NBO/fc14e3069bb9fa755194d6f655a3352a3802c4c8/NBO/diag.f -------------------------------------------------------------------------------- /NBO/matutil.f90: -------------------------------------------------------------------------------- 1 | MODULE matutil 2 | ! Some routines require diag and ludcmp 3 | ! Some of these routines (but not ALL) have been convereted over to use 4 | ! LAPACK via the MKL LAPACK95 wrappers. The rest should probably be 5 | ! converted for efficiency and consistancy. 6 | ! 7 | ! Compile flags: -I $(PATH_TO_MKL) -L $(PATH_TO_MKL) -lmkl_core -lmkl_intel_lp64 -lmkl_sequential -lmkl_blas95 -lmkl_lapack95 8 | 9 | INTERFACE mattrace 10 | MODULE PROCEDURE mattrace_real 11 | MODULE PROCEDURE mattrace_complex 12 | END INTERFACE 13 | 14 | INTERFACE matdiag 15 | MODULE PROCEDURE matdiag_real 16 | MODULE PROCEDURE matdiag_complex 17 | END INTERFACE 18 | 19 | INTERFACE matinv 20 | MODULE PROCEDURE matinv_real 21 | MODULE PROCEDURE matinv_complex 22 | END INTERFACE 23 | 24 | INTERFACE matsqrt 25 | MODULE PROCEDURE matsqrt_real 26 | MODULE PROCEDURE matsqrt_complex 27 | END INTERFACE 28 | 29 | INTERFACE matinvsqrt 30 | MODULE PROCEDURE matinvsqrt_real 31 | MODULE PROCEDURE matinvsqrt_complex 32 | END INTERFACE 33 | 34 | INTERFACE matunitary_trans 35 | MODULE PROCEDURE matunitary_trans_real 36 | MODULE PROCEDURE matunitary_trans_complex 37 | MODULE PROCEDURE matunitary_trans_complex2 38 | END INTERFACE 39 | 40 | CONTAINS 41 | 42 | REAL*8 FUNCTION mattrace_real(dmat) 43 | IMPLICIT NONE 44 | REAL*8 , DIMENSION(:,:) :: dmat 45 | INTEGER :: n1, n2, i 46 | 47 | n1 = SIZE(dmat,1) 48 | n2 = SIZE(dmat,2) 49 | IF (n1.NE.n2) STOP 'Attempting to trace a non-square matrix' 50 | 51 | mattrace_real=0.d0 52 | DO i=1, n1 53 | mattrace_real=mattrace_real+dmat(i,i) 54 | ENDDO 55 | 56 | RETURN 57 | END FUNCTION mattrace_real 58 | 59 | COMPLEX*16 FUNCTION mattrace_complex(cmat) 60 | IMPLICIT NONE 61 | COMPLEX*16 , DIMENSION(:,:) :: cmat 62 | INTEGER :: n1, n2, i 63 | 64 | n1 = SIZE(cmat,1) 65 | n2 = SIZE(cmat,2) 66 | IF (n1.NE.n2) STOP 'Attempting to trace a non-square matrix' 67 | 68 | mattrace_complex=0.d0 69 | DO i=1, n1 70 | mattrace_complex=mattrace_complex+cmat(i,i) 71 | ENDDO 72 | 73 | RETURN 74 | END FUNCTION mattrace_complex 75 | 76 | REAL*8 FUNCTION matdet(dmat) 77 | IMPLICIT NONE 78 | REAL*8 , DIMENSION(:,:) :: dmat 79 | REAL*8 , DIMENSION(SIZE(dmat,1),SIZE(dmat,2)) :: tmp 80 | INTEGER , DIMENSION(SIZE(dmat,1)) :: index 81 | INTEGER :: n1, n2, i 82 | 83 | n1 = SIZE(dmat,1) 84 | n2 = SIZE(dmat,2) 85 | IF (n1.NE.n2) STOP 'Attempting to take determinant of a non-square matrix' 86 | 87 | tmp = dmat 88 | CALL ludcmp(tmp,n1,n1,index,matdet) 89 | DO i = 1, n1 90 | matdet=matdet*tmp(i,i) 91 | ENDDO 92 | 93 | END FUNCTION matdet 94 | 95 | FUNCTION matsqrt_real(dmat) 96 | USE BLAS95 97 | IMPLICIT NONE 98 | REAL*8 , DIMENSION(:,:) :: dmat 99 | REAL*8 , DIMENSION(SIZE(dmat,1),SIZE(dmat,2)) :: matsqrt_real, vecs 100 | REAL*8 , DIMENSION(SIZE(dmat,1)) :: vals 101 | REAL*8 , DIMENSION(SIZE(dmat,1),SIZE(dmat,2)) :: dummy 102 | INTEGER :: n1, n2, i 103 | 104 | n1 = SIZE(dmat,1) 105 | n2 = SIZE(dmat,2) 106 | IF (n1.NE.n2) STOP 'Attempting to square root a non-square matrix' 107 | 108 | matsqrt_real = dmat 109 | CALL matdiag_real(matsqrt_real, vals, vecs) 110 | 111 | !WRITE(6,'(A,10F8.5)')' Eigenvalues in mat_sqrt',vals 112 | !WRITE(6,*) 113 | 114 | matsqrt_real=0.d0 115 | FORALL (i=1:n1) matsqrt_real(i,i) = SQRT(abs(vals(i))) 116 | !matsqrt_real = MATMUL(vecs, MATMUL(matsqrt_real, TRANSPOSE(vecs))) 117 | 118 | CALL GEMM(vecs,matsqrt_real,dummy,'N','N',1.d0,0.d0) 119 | CALL GEMM(dummy,vecs,matsqrt_real,'N','T',1.d0,0.d0) 120 | 121 | 122 | END FUNCTION matsqrt_real 123 | 124 | FUNCTION matsqrt_complex(cmat) 125 | USE BLAS95 126 | IMPLICIT NONE 127 | COMPLEX*16 , DIMENSION(:,:) :: cmat 128 | COMPLEX*16 , DIMENSION(SIZE(cmat,1),SIZE(cmat,2)) :: matsqrt_complex, vecs 129 | COMPLEX*16 , DIMENSION(SIZE(cmat,1),SIZE(cmat,2)) :: dummy 130 | REAL*8 , DIMENSION(SIZE(cmat,1)) :: vals 131 | INTEGER :: n1, n2, i 132 | 133 | n1 = SIZE(cmat,1) 134 | n2 = SIZE(cmat,2) 135 | IF (n1.NE.n2) STOP 'Attempting to square root a non-square matrix' 136 | 137 | matsqrt_complex = cmat 138 | CALL matdiag_complex(matsqrt_complex, vals, vecs) 139 | matsqrt_complex=0.d0 140 | FORALL (i=1:n1) matsqrt_complex(i,i) = SQRT(abs(vals(i))) 141 | !matsqrt_complex = MATMUL(vecs, MATMUL(matsqrt_complex, TRANSPOSE(CONJG(vecs)))) 142 | 143 | CALL GEMM(vecs,matsqrt_complex,dummy,'N','N',(1.d0,0.d0),(0.d0,0.d0)) 144 | CALL GEMM(dummy,vecs,matsqrt_complex,'N','C',(1.d0,0.d0),(0.d0,0.d0)) 145 | 146 | END FUNCTION matsqrt_complex 147 | 148 | FUNCTION matinvsqrt_real(dmat) 149 | USE BLAS95 150 | IMPLICIT NONE 151 | REAL*8 , DIMENSION(:,:) :: dmat 152 | REAL*8 , DIMENSION(SIZE(dmat,1),SIZE(dmat,2)) :: matinvsqrt_real, vecs 153 | REAL*8 , DIMENSION(SIZE(dmat,1),SIZE(dmat,2)) :: dummy 154 | REAL*8 , DIMENSION(SIZE(dmat,1)) :: vals 155 | INTEGER :: n1, n2, i 156 | 157 | n1 = SIZE(dmat,1) 158 | n2 = SIZE(dmat,2) 159 | IF (n1.NE.n2) STOP 'Attempting to square root a non-square matrix' 160 | 161 | matinvsqrt_real = dmat 162 | CALL matdiag_real(matinvsqrt_real, vals, vecs) 163 | matinvsqrt_real=0.d0 164 | FORALL (i=1:n1) matinvsqrt_real(i,i) = 1.d0/SQRT(abs(vals(i))) 165 | !matinvsqrt_real = MATMUL(vecs, MATMUL(matinvsqrt_real, TRANSPOSE(vecs))) 166 | 167 | CALL GEMM(vecs,matinvsqrt_real,dummy,'N','N',1.d0,0.d0) 168 | CALL GEMM(dummy,vecs,matinvsqrt_real,'N','T',1.d0,0.d0) 169 | 170 | END FUNCTION matinvsqrt_real 171 | 172 | FUNCTION matinvsqrt_complex(cmat) 173 | USE BLAS95 174 | IMPLICIT NONE 175 | COMPLEX*16 , DIMENSION(:,:) :: cmat 176 | COMPLEX*16 , DIMENSION(SIZE(cmat,1),SIZE(cmat,2)) :: matinvsqrt_complex, vecs 177 | COMPLEX*16 , DIMENSION(SIZE(cmat,1),SIZE(cmat,2)) :: dummy 178 | REAL*8 , DIMENSION(SIZE(cmat,1)) :: vals 179 | INTEGER :: n1, n2, i 180 | 181 | n1 = SIZE(cmat,1) 182 | n2 = SIZE(cmat,2) 183 | IF (n1.NE.n2) STOP 'Attempting to square root a non-square matrix' 184 | 185 | matinvsqrt_complex = cmat 186 | CALL matdiag_complex(matinvsqrt_complex, vals, vecs) 187 | 188 | 189 | matinvsqrt_complex=0.d0 190 | FORALL (i=1:n1) matinvsqrt_complex(i,i) = 1.d0/SQRT(abs(vals(i))) 191 | 192 | !DO i=1,n1 193 | ! IF( vals(i) >= 1.d-4 )THEN 194 | ! matinvsqrt_complex(i,i) = 1.d0/SQRT(abs(vals(i))) 195 | ! ELSE 196 | ! matinvsqrt_complex(i,i) = 0.d0 197 | ! ENDIF 198 | !ENDDO 199 | 200 | !matinvsqrt_complex = MATMUL(vecs, MATMUL(matinvsqrt_complex, TRANSPOSE(CONJG(vecs)))) 201 | 202 | CALL GEMM(vecs,matinvsqrt_complex,dummy,'N','N',(1.d0,0.d0),(0.d0,0.d0)) 203 | CALL GEMM(dummy,vecs,matinvsqrt_complex,'N','C',(1.d0,0.d0),(0.d0,0.d0)) 204 | 205 | END FUNCTION matinvsqrt_complex 206 | 207 | FUNCTION matexp(dmat) 208 | USE BLAS95 209 | IMPLICIT NONE 210 | REAL*8 , DIMENSION(:,:) :: dmat 211 | REAL*8 , DIMENSION(SIZE(dmat,1),SIZE(dmat,2)) :: matexp, vecs 212 | REAL*8 , DIMENSION(SIZE(dmat,1)) :: vals 213 | REAL*8 , DIMENSION(SIZE(dmat,1),SIZE(dmat,2)) :: dummy 214 | INTEGER :: n1, n2, i 215 | 216 | n1 = SIZE(dmat,1) 217 | n2 = SIZE(dmat,2) 218 | IF (n1.NE.n2) STOP 'Attempting to exponentiate a non-square matrix' 219 | 220 | matexp = dmat 221 | CALL diag(matexp, n1, n1, vals, vecs) 222 | matexp = 0.d0 223 | FORALL (i=1:n1) matexp(i,i) = EXP(vals(i)) 224 | !matexp = MATMUL(vecs, MATMUL(matexp, TRANSPOSE(vecs))) 225 | CALL GEMM(vecs,matexp,dummy,'N','N',1.d0,0.d0) 226 | CALL GEMM(dummy,vecs,matexp,'N','T',1.d0,0.d0) 227 | 228 | END FUNCTION matexp 229 | 230 | ! returns the minor of the matrix, removing row i and column j 231 | FUNCTION matminor(dmat,i,j) 232 | IMPLICIT NONE 233 | REAL*8 , DIMENSION(:,:) :: dmat 234 | REAL*8 , DIMENSION(SIZE(dmat,1)-1,SIZE(dmat,2)-1) :: matminor 235 | INTEGER :: n1, n2, i, j 236 | 237 | n1 = SIZE(dmat,1) 238 | n2 = SIZE(dmat,2) 239 | 240 | matminor(1:i-1,1:j-1)=dmat(1:i-1,1:j-1) 241 | matminor(1:i-1,j:n2-1)=dmat(1:i-1,j+1:n2) 242 | matminor(i:n1-1,1:j-1)=dmat(i+1:n1,1:j-1) 243 | matminor(i:n1-1,j:n2-1)=dmat(i+1:n1,j+1:n2) 244 | 245 | END FUNCTION matminor 246 | 247 | ! solves the generalized eigenvalue equations D c=S c*lambda 248 | SUBROUTINE diag_general(dmat,smat,dvals,dvecs) 249 | USE BLAS95 250 | USE LAPACK95 251 | IMPLICIT NONE 252 | REAL*8 , DIMENSION(:,:) :: dmat, smat, dvecs 253 | REAL*8 , DIMENSION(:) :: dvals 254 | REAL*8 , DIMENSION(SIZE(dmat,1),SIZE(dmat,2)) :: shalf, shalfi 255 | REAL*8 , DIMENSION(SIZE(dmat,1),SIZE(dmat,2)) :: dummy 256 | INTEGER n1,n2,nrot 257 | 258 | INTEGER :: j 259 | 260 | n1 = SIZE(dmat,1) 261 | n2 = SIZE(dmat,2) 262 | 263 | IF (n1.NE.n2) STOP 'Attempting to diagonalize a non-square matrix' 264 | 265 | ! calculate the square root of S, and its inverse 266 | shalf = matsqrt(smat) 267 | shalfi = matinv(shalf) 268 | !call gaussj(shalfi,n1,n1,0,0,0) 269 | 270 | 271 | dummy = MATMUL(shalfi,MATMUL(smat,shalfi)) 272 | !WRITE(6,*)'inverse square root test' 273 | !DO j=1,n1 274 | ! WRITE(6,'(10F10.5)')dummy(j,:) 275 | !ENDDO 276 | !WRITE(6,*) 277 | 278 | ! transform to the coordinates of the normal eigensystem 279 | !dmat = MATMUL(TRANSPOSE(shalfi),MATMUL(dmat,shalfi)) 280 | CALL GEMM(shalfi,dmat,dummy,'T','N',1.d0,0.d0) 281 | CALL GEMM(dummy,shalfi,dmat,'N','N',1.d0,0.d0) 282 | ! get the normal eigenvalues and vectors 283 | call jacobi(dmat,n1,n1,dvals,dvecs,nrot) 284 | ! transform the eigenvectors BACK to the original coordinate system 285 | !dvecs = MATMUL(shalfi, dvecs) 286 | dummy = dvecs 287 | CALL GEMM(shalfi,dummy,dvecs,'N','N',1.d0,0.d0) 288 | CALL eigsrt(dvals,dvecs,n1,n1) 289 | 290 | !WRITE(6,*)'Eigenvalues' 291 | !WRITE(6,'(5F10.5)')dvals 292 | !WRITE(6,*) 293 | 294 | END SUBROUTINE diag_general 295 | 296 | FUNCTION matinv_real(dmat) 297 | USE LAPACK95 298 | IMPLICIT NONE 299 | REAL*8 , DIMENSION(:,:) :: dmat 300 | REAL*8 , DIMENSION(SIZE(dmat,1),SIZE(dmat,2)) :: matinv_real 301 | INTEGER, DIMENSION(SIZE(dmat,1)) :: ipiv 302 | INTEGER :: n1, n2, info 303 | 304 | n1 = SIZE(dmat,1) 305 | n2 = SIZE(dmat,2) 306 | IF (n1.NE.n2) STOP 'Attempting to invert a non-square matrix' 307 | 308 | matinv_real=dmat 309 | CALL GETRF(matinv_real,ipiv,info) 310 | CALL GETRI(matinv_real,ipiv,info) 311 | END FUNCTION matinv_real 312 | 313 | FUNCTION matinv_complex(cmat) 314 | USE LAPACK95 315 | IMPLICIT NONE 316 | COMPLEX*16 , DIMENSION(:,:) :: cmat 317 | COMPLEX*16 , DIMENSION(SIZE(cmat,1),SIZE(cmat,2)) :: matinv_complex 318 | INTEGER, DIMENSION(SIZE(cmat,1)) :: ipiv 319 | INTEGER :: n1, n2, info 320 | 321 | COMPLEX*16 , DIMENSION(SIZE(cmat,1),SIZE(cmat,2)) :: evecs 322 | REAL*8 , DIMENSION(SIZE(cmat,1)) :: evals 323 | 324 | 325 | n1 = SIZE(cmat,1) 326 | n2 = SIZE(cmat,2) 327 | IF (n1.NE.n2) STOP 'Attempting to invert a non-square matrix' 328 | 329 | 330 | !evecs = cmat 331 | !CALL ZHEEV_MKL95(evecs,evals,'V','U',INFO) 332 | !DO info=1,SIZE(evals,1) 333 | ! WRITE(6,'(F10.5)')evals(info) 334 | !ENDDO 335 | !WRITE(6,*) 336 | 337 | 338 | 339 | matinv_complex=cmat 340 | CALL GETRF(matinv_complex,ipiv,info) 341 | CALL GETRI(matinv_complex,ipiv,info) 342 | END FUNCTION matinv_complex 343 | 344 | FUNCTION outer_product(x,y) 345 | IMPLICIT NONE 346 | REAL*8 , DIMENSION(:):: x, y 347 | REAL*8 :: outer_product(SIZE(x),SIZE(y)) 348 | 349 | outer_product=SPREAD(x,2,SIZE(x))*SPREAD(y,1,SIZE(y)) 350 | END FUNCTION outer_product 351 | 352 | !Fortran 90 wrappers for diag routines 353 | SUBROUTINE matdiag_real(dmat,evals,evecs) 354 | USE LAPACK95 355 | IMPLICIT NONE 356 | REAL*8 , DIMENSION(:,:) :: dmat 357 | REAL*8 , DIMENSION(SIZE(dmat,1)) :: evals 358 | REAL*8 , DIMENSION(SIZE(dmat,1),SIZE(dmat,2)) :: evecs 359 | INTEGER :: n1, n2, info 360 | 361 | n1 = SIZE(dmat,1) 362 | n2 = SIZE(dmat,2) 363 | IF (n1.NE.n2) STOP 'Attempting to diagonalize a non-square matrix' 364 | 365 | evecs=dmat 366 | !CALL dsyev_mkl95(evecs,evals,'V','U',info) 367 | CALL diag(dmat,n1,n1,evals,evecs) 368 | 369 | !WRITE(6,*)'using real symmetrizing routine' 370 | 371 | !IF (info.NE.0) STOP 'Error in matdiag_real' 372 | 373 | END SUBROUTINE matdiag_real 374 | 375 | SUBROUTINE matdiag_complex(cmat,evals,evecs) 376 | USE LAPACK95 377 | IMPLICIT NONE 378 | COMPLEX*16 , DIMENSION(:,:) :: cmat 379 | REAL*8 , DIMENSION(SIZE(cmat,1)) :: evals 380 | COMPLEX*16 , DIMENSION(SIZE(cmat,1),SIZE(cmat,2)) :: evecs 381 | INTEGER :: info 382 | 383 | COMPLEX*16, DIMENSION(SIZE(cmat,1),SIZE(cmat,2)) :: u_matrix,v_matrix,dummy 384 | REAL*8, DIMENSION(SIZE(cmat,1)) :: sing_value 385 | 386 | INTEGER :: j 387 | 388 | IF (SIZE(cmat,1).NE.SIZE(cmat,2)) STOP 'Attempting to diagonalize a non-square matrix' 389 | 390 | evecs=cmat 391 | 392 | CALL heev(evecs,evals,'V','U',info) 393 | IF (info.NE.0) STOP 'Error in matdiag_complex' 394 | 395 | !dummy=cmat 396 | !CALL ZGESVD_MKL95(dummy,sing_value,u_matrix,v_matrix) 397 | 398 | 399 | !IF( evals(1) .LE. -1.d-13 )WRITE(6,*)'WHOOOOOOOOOAAAAAAAAAAAAAAA!!! Negative eigenvalues' 400 | 401 | !evecs=u_matrix 402 | !evals=sing_value 403 | 404 | !DO j=1,SIZE(cmat,1) 405 | ! !WRITE(6,*)'vector',j 406 | ! IF( ABS(sing_value(SIZE(cmat,1)+1-j) - evals(j)) .GT. 1.d-9 )THEN 407 | ! !WRITE(6,*)'eig and single value diff',j 408 | ! !WRITE(6,*)sing_value(SIZE(cmat,1)+1-j),evals(j) 409 | ! ENDIF 410 | ! !WRITE(6,*)'eigenvalue ',evals(j) 411 | !ENDDO 412 | !WRITE(6,*) 413 | 414 | !WRITE(6,'(A,2D13.5)')' Smallest eigennvalue found in diag for matinvsqrt',evals(1),sing_value(SIZE(cmat,1)) 415 | 416 | 417 | !WRITE(6,*)'compare eigenvec with u_vec of matching eigen values' 418 | !WRITE(6,'(10D13.5)')REAL(evecs(:,1)) 419 | !WRITE(6,*) 420 | !WRITE(6,'(10D13.5)')REAL(u_matrix(:,SIZE(cmat,1)+1-15)) 421 | !WRITE(6,*) 422 | 423 | 424 | 425 | END SUBROUTINE matdiag_complex 426 | 427 | FUNCTION matiden(n) 428 | IMPLICIT NONE 429 | INTEGER :: n,i 430 | REAL*8,DIMENSION(n,n) :: matiden 431 | 432 | matiden=0.d0 433 | DO i=1,n 434 | matiden(i,i)=1.d0 435 | ENDDO 436 | END FUNCTION matiden 437 | 438 | FUNCTION matunitary_trans_real(A,U) RESULT(Ap) 439 | USE BLAS95 440 | IMPLICIT NONE 441 | REAL*8,DIMENSION(:,:) :: A,U 442 | REAL*8,DIMENSION(SIZE(U,1),SIZE(U,1)) :: Ap 443 | REAL*8,DIMENSION(SIZE(A,1),SIZE(U,1)) :: dummy 444 | 445 | !Ap=MATMUL(U,MATMUL(A,TRANSPOSE(U))) 446 | CALL GEMM(A,U,dummy,'N','T',1.d0,0.d0) 447 | CALL GEMM(U,dummy,Ap,'N','N',1.d0,0.d0) 448 | END FUNCTION matunitary_trans_real 449 | 450 | FUNCTION matunitary_trans_complex(A,U) RESULT(Ap) 451 | USE BLAS95 452 | IMPLICIT NONE 453 | COMPLEX*16,DIMENSION(:,:) :: A,U 454 | COMPLEX*16,DIMENSION(SIZE(U,1),SIZE(U,1)) :: Ap 455 | COMPLEX*16,DIMENSION(SIZE(A,1),SIZE(U,1)) :: dummy 456 | 457 | !Ap=MATMUL(U,MATMUL(A,CONJG(TRANSPOSE(U)))) 458 | CALL GEMM(A,U,dummy,'N','C',(1.d0,0.d0),(0.d0,0.d0)) 459 | CALL GEMM(U,dummy,Ap,'N','N',(1.d0,0.d0),(0.d0,0.d0)) 460 | END FUNCTION matunitary_trans_complex 461 | 462 | FUNCTION matunitary_trans_complex2(A,U) RESULT(Ap) 463 | USE BLAS95 464 | IMPLICIT NONE 465 | COMPLEX*16,DIMENSION(:,:) :: A 466 | REAL*8,DIMENSION(:,:) :: U 467 | COMPLEX*16,DIMENSION(SIZE(U,1),SIZE(U,1)) :: Ap 468 | COMPLEX*16,DIMENSION(SIZE(U,1),SIZE(U,2)) :: U_comp 469 | COMPLEX*16,DIMENSION(SIZE(A,1),SIZE(U,1)) :: dummy 470 | 471 | U_comp = U 472 | !Ap=MATMUL(U,MATMUL(A,TRANSPOSE(U))) 473 | CALL GEMM(A,U_comp,dummy,'N','C',(1.d0,0.d0),(0.d0,0.d0)) 474 | CALL GEMM(U_comp,dummy,Ap,'N','N',(1.d0,0.d0),(0.d0,0.d0)) 475 | END FUNCTION matunitary_trans_complex2 476 | 477 | 478 | END MODULE 479 | -------------------------------------------------------------------------------- /NBO/matutil.mod: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Chengcheng-Xiao/Periodic_NBO/fc14e3069bb9fa755194d6f655a3352a3802c4c8/NBO/matutil.mod -------------------------------------------------------------------------------- /NBO/nao.f90: -------------------------------------------------------------------------------- 1 | MODULE nao 2 | PRIVATE 3 | PUBLIC :: do_nao !, do_core_projection 4 | 5 | CONTAINS 6 | 7 | ! 8 | !Actually carries out the NAO analysis and outputs the results 9 | ! 10 | SUBROUTINE do_nao(inp) 11 | USE matutil 12 | USE nbo_shared 13 | IMPLICIT NONE 14 | 15 | TYPE(nbo_input) :: inp 16 | 17 | REAL*8,DIMENSION(SIZE(inp%rho0,1),SIZE(inp%rho0,2)) :: rho_NAO 18 | 19 | INTEGER :: iatom,ifirst,ilast,ibasis,il,ispin 20 | INTEGER :: nl(0:lmax) 21 | CHARACTER*10 ::type 22 | CHARACTER*20 :: label 23 | REAL*8 :: occ 24 | 25 | 26 | 27 | rho_NAO=0.d0 28 | DO ispin=1,inp%nspins 29 | rho_NAO = rho_NAO + inp%rho0(:,:,1,ispin) 30 | ENDDO 31 | 32 | !CALL sort_nao(inp) 33 | 34 | PRINT *, '*****************************' 35 | PRINT *, '**** NATURAL POPULATIONS ****' 36 | PRINT *, '*****************************' 37 | PRINT * 38 | !Output the populations 39 | DO iatom=1,inp%natom 40 | ifirst=inp%ibasismap(iatom) 41 | ilast=inp%ibasismap(iatom+1)-1 42 | 43 | occ=mattrace(rho_NAO(ifirst:ilast,ifirst:ilast)) 44 | WRITE(6,'(A,A3,I3,A,F11.7,A,E)')' Atom: ', inp%symbols(iatom), iatom, ' occ:', SNGL(occ), ' charge:', SNGL(inp%iatval(iatom)-occ) 45 | ENDDO 46 | PRINT * 47 | 48 | PRINT *, '*********************************' 49 | PRINT *, '**** NATURAL ATOMIC ORBITALS ****' 50 | PRINT *, '*********************************' 51 | PRINT * 52 | 53 | DO iatom=1,inp%natom 54 | ifirst=inp%ibasismap(iatom) 55 | ilast=inp%ibasismap(iatom+1)-1 56 | !Initialize the count of the shells of each angular momentum type 57 | DO il=0,lmax 58 | nl(il)=il 59 | ENDDO 60 | 61 | DO ibasis=ifirst,ilast 62 | !Create the labels for this shell 63 | IF (inp%ilmap(ibasis).EQ.0) THEN 64 | type='s' 65 | nl(0)=nl(0)+1 66 | WRITE(label,*) nl(0),'S' !Write to a STRING, cool 67 | label=ADJUSTL(label) 68 | ELSEIF (inp%ilmap(ibasis).EQ.1) THEN 69 | IF (type.EQ.'px') THEN 70 | type='py' 71 | ELSEIF (type.EQ.'py') THEN 72 | type='pz' 73 | ELSE 74 | type='px' 75 | nl(1)=nl(1)+1 76 | WRITE(label,*) nl(1),'P' 77 | label=ADJUSTL(label) 78 | ENDIF 79 | ELSEIF (inp%ilmap(ibasis).EQ.2) THEN 80 | IF (type.EQ.'dyz') THEN 81 | type='dxz' 82 | ELSEIF (type.EQ.'dxz') THEN 83 | type='dxy' 84 | ELSEIF (type.EQ.'dxy') THEN 85 | type='dx2y2' 86 | ELSEIF (type.EQ.'dx2y2') THEN 87 | type='dz2' 88 | ELSE 89 | type='dyz' 90 | nl(2)=nl(2)+1 91 | WRITE(label,*) nl(2),'D' 92 | label=ADJUSTL(label) 93 | ENDIF 94 | ELSEIF (inp%ilmap(ibasis).EQ.3) THEN 95 | IF (type.EQ.'fxyz') THEN 96 | type='fz(x2-y2)' 97 | ELSEIF (type.EQ.'fz(x2-y2)') THEN 98 | type='fy(3x2-y2)' 99 | ELSEIF (type.EQ.'fy(3x2-y2)') THEN 100 | type='fx(x2-3y2)' 101 | ELSEIF (type.EQ.'fx(x2-3y2)') THEN 102 | type='fxz2' 103 | ELSEIF (type.EQ.'fxz2') THEN 104 | type='fyz2' 105 | ELSEIF (type.EQ.'fyz2') THEN 106 | type='fz3' 107 | ELSE 108 | type='fxyz' 109 | nl(3)=nl(3)+1 110 | WRITE(label,*) nl(3),'F' 111 | label=ADJUSTL(label) 112 | ENDIF 113 | 114 | ENDIF 115 | !Get the occupation (just the diagonal matrix element of the density matrix, 116 | !which is now block diagonal by atom and angular momentum) 117 | occ=rho_NAO(ibasis,ibasis) 118 | 119 | PRINT *, ibasis, inp%symbols(iatom), ' ', type, SNGL(occ), label 120 | ENDDO 121 | 122 | PRINT * 123 | ENDDO 124 | PRINT * 125 | 126 | END SUBROUTINE do_nao 127 | 128 | 129 | 130 | !!$ ! 131 | !!$ !Removes contributions from doubly occupied core orbitals from the density matrix 132 | !!$ ! 133 | !!$ SUBROUTINE do_core_projection(inp) 134 | !!$ USE nbo_shared 135 | !!$ USE matutil 136 | !!$ IMPLICIT NONE 137 | !!$ 138 | !!$ TYPE(nbo_input) :: inp 139 | !!$ INTEGER :: ibasis,ifirst,ilast,iatom 140 | !!$ INTEGER :: ncore 141 | !!$ 142 | !!$ REAL*8,DIMENSION(SIZE(inp%rho0,1),SIZE(inp%rho0,1)) :: P,Pi 143 | !!$ 144 | !!$ 145 | !!$ !project out any lone pairs from the density (eigenvalues ~ 2 in NAOs) 146 | !!$ P=matiden(SIZE(P,1)) 147 | !!$ DO iatom=1,inp%natom 148 | !!$ ifirst=inp%ibasismap(iatom) 149 | !!$ ilast=inp%ibasismap(iatom+1)-1 150 | !!$ ncore=0 151 | !!$ DO ibasis=ifirst,ilast 152 | !!$ IF (inp%rho0(ibasis,ibasis,1).GT.core_thresh) THEN 153 | !!$ !inp%rho0(ibasis,ibasis,1)=0.d0 154 | !!$ ncore=ncore+1 155 | !!$ Pi=matiden(SIZE(Pi,1)) 156 | !!$ Pi(ibasis,ibasis)=0.d0 157 | !!$ P=MATMUL(Pi,P) 158 | !!$ ENDIF 159 | !!$ ENDDO 160 | !!$ IF (ncore.GT.0) PRINT *, 'Removed', ncore, 'core orbitals from atom', iatom 161 | !!$ ENDDO 162 | !!$ PRINT * 163 | !!$ 164 | !!$ inp%rho0(:,:,1)=MATMUL(P,MATMUL(inp%rho0(:,:,1),P)) 165 | !!$ 166 | !!$ END SUBROUTINE do_core_projection 167 | !!$ 168 | !!$ 169 | ! 170 | !Sorts the NAO by increasing occupancy within a given atom / angular momentum sub block 171 | ! 172 | SUBROUTINE sort_nao(inp) 173 | USE sortutil 174 | USE matutil 175 | USE nbo_shared 176 | IMPLICIT NONE 177 | 178 | TYPE(nbo_input) :: inp 179 | REAL*8 :: occ(inp%nbasis) 180 | INTEGER :: iatom,ibasis,il,im,ispin 181 | INTEGER :: ibasisremap(inp%nbasis),isortremap(inp%nbasis) 182 | LOGICAL :: mask(inp%nbasis) 183 | INTEGER :: ig,ifirst,ilast,isize,nblock,ndum 184 | 185 | !Initialize the array of occupancies with the NEGATIVE of the occupancy, so we can easily 186 | !sort in order of decreasing occupancy 187 | occ = 0.d0 188 | DO ispin=1,inp%nspins 189 | DO ibasis=1,inp%nbasis 190 | occ(ibasis)=occ(ibasis)-inp%rho0(ibasis,ibasis,1,ispin) 191 | ENDDO 192 | ENDDO 193 | 194 | DO iatom=1,inp%natom 195 | ifirst=inp%ibasismap(iatom) 196 | ilast=inp%ibasismap(iatom+1)-1 197 | isize=ilast-ifirst+1 198 | DO il=0,lmax 199 | DO im=0,2*il 200 | !Group togoether all the bf of a given angular momentum on a given atom 201 | mask=.FALSE. 202 | mask(ifirst:ilast)=inp%ilmap(ifirst:ilast).EQ.il.AND.inp%immap(ifirst:ilast).EQ.im 203 | CALL partition_basis(mask,inp%nbasis,nblock,ndum,ibasisremap) 204 | occ=remap_vector(occ,ibasisremap,.FALSE.) 205 | DO ispin=1,inp%nspins 206 | DO ig=1,inp%ng 207 | inp%rho0(:,:,ig,ispin)=remap_matrix(inp%rho0(:,:,ig,ispin),ibasisremap,.FALSE.) 208 | !inp%transform(:,:,ig)=remap_matrix(inp%transform(:,:,ig),ibasisremap,.FALSE.) 209 | ENDDO 210 | ENDDO 211 | 212 | !Now sort those bf in order of decreasing occupancy 213 | DO ibasis=1,inp%nbasis 214 | isortremap(ibasis)=ibasis 215 | ENDDO 216 | CALL quick_sort(occ(1:nblock),isortremap) 217 | DO ispin=1,inp%nspins 218 | DO ig=1,inp%ng 219 | inp%rho0(:,:,ig,ispin)=remap_matrix(inp%rho0(:,:,ig,ispin),isortremap,.TRUE.) 220 | !inp%transform(:,:,ig)=remap_matrix(inp%transform(:,:,ig),isortremap,.TRUE.) 221 | ENDDO 222 | ENDDO 223 | 224 | !And re-separate the bf 225 | occ=remap_vector(occ,ibasisremap,.TRUE.) 226 | DO ispin=1,inp%nspins 227 | DO ig=1,inp%ng 228 | inp%rho0(:,:,ig,ispin)=remap_matrix(inp%rho0(:,:,ig,ispin),ibasisremap,.TRUE.) 229 | !inp%transform(:,:,ig)=remap_matrix(inp%transform(:,:,ig),ibasisremap,.TRUE.) 230 | ENDDO 231 | ENDDO 232 | ENDDO 233 | ENDDO 234 | ENDDO 235 | END SUBROUTINE sort_nao 236 | 237 | END MODULE nao 238 | -------------------------------------------------------------------------------- /NBO/nao.mod: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Chengcheng-Xiao/Periodic_NBO/fc14e3069bb9fa755194d6f655a3352a3802c4c8/NBO/nao.mod -------------------------------------------------------------------------------- /NBO/nbo.mod: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Chengcheng-Xiao/Periodic_NBO/fc14e3069bb9fa755194d6f655a3352a3802c4c8/NBO/nbo.mod -------------------------------------------------------------------------------- /NBO/nbo_shared.f90: -------------------------------------------------------------------------------- 1 | MODULE nbo_shared 2 | 3 | TYPE nbo_input 4 | INTEGER :: natom,nbasis,ng,nk,nspins 5 | !The mapping of the basis functions to atoms (i.e. first basis function for each atom) 6 | !as well as the angular momentum quantum number (l) for each basis function 7 | INTEGER,DIMENSION(:),POINTER :: ibasismap, ishellmap,ilmap,immap,iatnum 8 | REAL*8,DIMENSION(:),POINTER :: iatval 9 | !The mapping of the ng matrices into spatial cells 10 | INTEGER,DIMENSION(:,:),POINTER :: indexg 11 | !The k-points used, as coefficients of reciprocal lattice vectors 12 | REAL*8,DIMENSION(:,:),POINTER :: kpt 13 | !Weight of the k-point in the original PW calculation 14 | REAL*8,DIMENSION(:),POINTER :: kpt_wt 15 | !A listing of the symbol of each atom 16 | CHARACTER*2,DIMENSION(:),POINTER :: symbols 17 | !The real-space density and overlap matrices, rho^{0g}_{mu nu} 18 | REAL*8,DIMENSION(:,:,:,:),POINTER :: rho0, fock0 19 | REAL*8,DIMENSION(:,:,:),POINTER :: s0 20 | !Bloch-space matrices. Density and Fock matrices can have separate spin components 21 | COMPLEX*16,DIMENSION(:,:,:,:),POINTER :: rhok,fockk 22 | COMPLEX*16,DIMENSION(:,:,:),POINTER :: sk 23 | REAL*8,DIMENSION(:,:,:),POINTER :: transform !transformation matrix between AO and NAO basis 24 | END TYPE nbo_input 25 | 26 | !The maximum angular momentum 27 | INTEGER :: lmax 28 | PARAMETER (lmax=3) 29 | 30 | TYPE nbo_output_info 31 | REAL*8,ALLOCATABLE :: occ(:) 32 | REAL*8,ALLOCATABLE :: coeff(:,:,:) 33 | CHARACTER(128),ALLOCATABLE :: label(:) 34 | END TYPE 35 | 36 | 37 | !REAL*8,ALLOCATABLE :: bond_coeff(:,:,:),bond_occ(:) !Coefficients of NBO's in original basis 38 | !REAL*8,ALLOCATABLE :: lp_coeff(:,:,:),lp_occ(:) 39 | !REAL*8,ALLOCATABLE :: ryd_coeff(:,:,:),ryd_occ(:) 40 | !CHARACTER(128),ALLOCATABLE :: bond_lbl(:),lp_lbl(:),ryd_lbl(:) 41 | 42 | LOGICAL :: real_init 43 | INTEGER :: nkx,nky,nkz 44 | 45 | !Defined types that are used for visualization 46 | !Need to be in shared module since such variables are used in main program and visual subroutine 47 | 48 | TYPE AO_function 49 | REAL*8, ALLOCATABLE, DIMENSION(:) :: norm, alpha, coeff 50 | INTEGER :: num_gauss 51 | !INTEGER, DIMENSION(3) :: lmn 52 | INTEGER :: atom 53 | REAL*8, DIMENSION(3) :: pos 54 | INTEGER :: level !Keeps track of what basis functions share the same sets of exponents, on the same atom. 55 | INTEGER :: l,m !l- and m-quantum numbers of basis function. m actually runs from 0,2*l+1 and is onyl and index. 56 | 57 | INTEGER :: ncart 58 | INTEGER,ALLOCATABLE :: cart_mat(:,:) 59 | REAL*8,ALLOCATABLE :: cart_coeff(:) 60 | 61 | END TYPE AO_function 62 | 63 | TYPE vis_cont_struct 64 | INTEGER :: vis_start,vis_end 65 | INTEGER,DIMENSION(3) :: mesh 66 | INTEGER,DIMENSION(3) :: box_int 67 | REAL*8 :: origin_fact 68 | LOGICAL :: density 69 | END TYPE vis_cont_struct 70 | 71 | 72 | 73 | !Various thresholds and options used in the NBO analysis 74 | REAL*8 :: core_thresh,nbo_1c_thresh,nbo_2c_thresh,polarization_thresh 75 | !PARAMETER (core_thresh=0.995d0,nbo_1c_thresh=0.80d0,nbo_2c_thresh=0.925d0,polarization_thresh=0.99d0) 76 | PARAMETER (core_thresh=0.995d0,polarization_thresh=0.99d0) 77 | 78 | !The threshold for whether a located hybrid is unique enough, i.e. what fraction cannot be 79 | !expressed in terms of previously located hybrids 80 | REAL*8 :: prjexp_thresh 81 | PARAMETER (prjexp_thresh=0.2d0) 82 | !Whether or not to force orthogonalization of the hybrids -- this should be OFF for 83 | !hypervalent ionic-like structures 84 | LOGICAL :: orthogonalize_hybrids 85 | PARAMETER (orthogonalize_hybrids=.TRUE.) 86 | 87 | 88 | 89 | 90 | INTERFACE remap_matrix 91 | MODULE PROCEDURE remap_matrix_real 92 | MODULE PROCEDURE remap_matrix_complex 93 | END INTERFACE 94 | 95 | CONTAINS 96 | 97 | ! 98 | !Read an triangular matrix out of the file, and convert to a dense one 99 | ! 100 | SUBROUTINE read_bloch_triangular(unit,nbasis,matlow) 101 | IMPLICIT NONE 102 | INTEGER :: unit, nbasis 103 | COMPLEX*16 :: matlow(nbasis,nbasis) 104 | 105 | COMPLEX*16 :: temp(nbasis*(nbasis+1)/2) 106 | INTEGER :: i,j,k 107 | COMPLEX*16 :: sqrt_neg_one 108 | 109 | sqrt_neg_one = (0.d0,1.d0) 110 | 111 | !READ(unit) temp 112 | k=1 113 | DO i=1,nbasis 114 | READ(unit)matlow(i,1:i) 115 | DO j=1,i 116 | !matlow(i,j)=temp(k) 117 | matlow(j,i)=CONJG(matlow(i,j)) 118 | k=k+1 119 | ENDDO 120 | ENDDO 121 | END SUBROUTINE read_bloch_triangular 122 | 123 | 124 | SUBROUTINE read_real_triangular(unit,nbasis,matlow,mathigh) 125 | IMPLICIT NONE 126 | INTEGER :: unit,nbasis 127 | REAL*8 :: matlow(nbasis,nbasis),mathigh(nbasis,nbasis) 128 | 129 | REAL*8 :: temp(nbasis*(nbasis+1)/2) 130 | INTEGER :: i,j,k 131 | 132 | 133 | !WRITE(6,*)'Test with in read_real_tri' 134 | 135 | READ(unit,*) (temp(i),i=1,nbasis*(nbasis+1)/2) 136 | k=1 137 | DO i=1,nbasis 138 | DO j=1,i 139 | !WRITE(6,*)k,temp(k) 140 | matlow(i,j)=temp(k) 141 | mathigh(j,i)=temp(k) 142 | k=k+1 143 | ENDDO 144 | ENDDO 145 | END SUBROUTINE read_real_triangular 146 | 147 | 148 | 149 | 150 | ! 151 | !Calculates the number of electrons in the unit cell 152 | ! 153 | SUBROUTINE calc_nelec(inp,is_orthog) 154 | USE BLAS95 155 | USE matutil 156 | IMPLICIT NONE 157 | TYPE(nbo_input) :: inp 158 | LOGICAL :: is_orthog !true if we are already in an orthogonal NAO basis (i.e. we read the NAOs from a checkpoint file) 159 | 160 | COMPLEX*16,DIMENSION(SIZE(inp%rhok,1),SIZE(inp%rhok,1)) :: nelec_dummy 161 | INTEGER :: ik, nk, ispin 162 | REAL*8 :: nelec, nenergy 163 | 164 | nk=inp%nk 165 | nelec=0.d0 166 | nenergy=0.d0 167 | 168 | DO ispin=1,inp%nspins 169 | DO ik=1,nk 170 | CALL GEMM(inp%rhok(:,:,ik,ispin),inp%sk(:,:,ik),nelec_dummy,'N','C',(1.d0,0.d0),(0.d0,0.d0)) 171 | nelec=nelec+inp%kpt_wt(ik)*mattrace(nelec_dummy) 172 | CALL GEMM(inp%rhok(:,:,ik,ispin),inp%fockk(:,:,ik,ispin),nelec_dummy,'N','C',(1.d0,0.d0),(0.d0,0.d0)) 173 | nenergy=nenergy+inp%kpt_wt(ik)*mattrace(nelec_dummy) 174 | ENDDO 175 | ENDDO 176 | PRINT *, 'Total number of elec. from input Bloch space matrices: ', nelec 177 | PRINT *, 'Total energy average from input Bloch space matrices: ', nenergy 178 | PRINT * 179 | 180 | END SUBROUTINE calc_nelec 181 | 182 | ! 183 | !Gives a remapping of the matrices based on the given mask, first 184 | !those which satisfy the maks, then those that do not. 185 | ! 186 | SUBROUTINE partition_basis(mask,nbasis,ntrue,nfalse,ibasisremap) 187 | IMPLICIT NONE 188 | LOGICAL :: mask(:) 189 | INTEGER :: ntrue,nfalse,nbasis,ibasisremap(:),ibasis 190 | 191 | ntrue=0 192 | DO ibasis=1,nbasis 193 | IF (mask(ibasis)) THEN 194 | ntrue=ntrue+1 195 | ibasisremap(ibasis)=ntrue 196 | ENDIF 197 | ENDDO 198 | nfalse=0 199 | DO ibasis=1,nbasis 200 | IF (.NOT.mask(ibasis)) THEN 201 | nfalse=nfalse+1 202 | ibasisremap(ibasis)=ntrue+nfalse 203 | ENDIF 204 | ENDDO 205 | END SUBROUTINE partition_basis 206 | 207 | 208 | FUNCTION nmb_count(inp,iatom) RESULT (imbcount) 209 | IMPLICIT NONE 210 | TYPE(nbo_input) :: inp 211 | INTEGER :: iatom 212 | INTEGER :: iatnum, imbcount 213 | 214 | iatnum = inp%iatnum(iatom) 215 | 216 | IF (iatnum.GE.87) THEN 217 | STOP 'Principal quanutm number n > 6 to implemented' 218 | ELSEIF (iatnum.GE.55)THEN 219 | imbcount=43 220 | ELSEIF (iatnum.GE.37) THEN 221 | imbcount=27 222 | ELSEIF (iatnum.GE.19) THEN 223 | imbcount=18 224 | ELSEIF (iatnum.GE.11) THEN 225 | imbcount=9 226 | ELSEIF (iatnum.GE.3) THEN 227 | imbcount=5 228 | ELSE 229 | imbcount=1 230 | ENDIF 231 | 232 | !WRITE(6,*)imbcount 233 | imbcount = imbcount - (iatnum - inp%iatval(iatom))/2.d0 234 | !WRITE(6,*)(iatnum - inp%iatval(iatom))/2 235 | 236 | !WRITE(6,*)imbcount 237 | !WRITE(6,*) 238 | 239 | END FUNCTION NMB_COUNT 240 | 241 | !Reorder a given matrix / vector given a remapping vector; invertable via inv 242 | FUNCTION remap_matrix_complex(A,iremap,inv) RESULT (C) 243 | IMPLICIT NONE 244 | COMPLEX*16,DIMENSION(:,:) :: A 245 | INTEGER,DIMENSION(:) :: iremap 246 | LOGICAL :: inv 247 | COMPLEX*16,DIMENSION(SIZE(A,1),SIZE(A,2)) :: C 248 | INTEGER :: i,j,nbasis 249 | 250 | nbasis=SIZE(a,1) 251 | DO i=1,nbasis 252 | DO j=1,nbasis 253 | IF (inv) THEN 254 | C(i,j)=A(iremap(i),iremap(j)) 255 | ELSE 256 | C(iremap(i),iremap(j))=A(i,j) 257 | ENDIF 258 | ENDDO 259 | ENDDO 260 | END FUNCTION remap_matrix_complex 261 | 262 | FUNCTION remap_matrix_real(A,iremap,inv) RESULT (C) 263 | IMPLICIT NONE 264 | REAL*8,DIMENSION(:,:) :: A 265 | INTEGER,DIMENSION(:) :: iremap 266 | LOGICAL :: inv 267 | REAL*8,DIMENSION(SIZE(A,1),SIZE(A,2)) :: C 268 | INTEGER :: i,j,nbasis 269 | 270 | nbasis=SIZE(a,1) 271 | DO i=1,nbasis 272 | DO j=1,nbasis 273 | IF (inv) THEN 274 | C(i,j)=A(iremap(i),iremap(j)) 275 | ELSE 276 | C(iremap(i),iremap(j))=A(i,j) 277 | ENDIF 278 | ENDDO 279 | ENDDO 280 | END FUNCTION remap_matrix_real 281 | 282 | FUNCTION remap_vector(A,iremap,inv) RESULT (C) 283 | IMPLICIT NONE 284 | REAL*8,DIMENSION(:) :: A 285 | INTEGER,DIMENSION(:) :: iremap 286 | LOGICAL :: inv 287 | REAL*8,DIMENSION(SIZE(A,1)) :: C 288 | INTEGER :: i,nbasis 289 | 290 | nbasis=SIZE(a,1) 291 | DO i=1,nbasis 292 | IF (inv) THEN 293 | C(i)=A(iremap(i)) 294 | ELSE 295 | C(iremap(i))=A(i) 296 | ENDIF 297 | ENDDO 298 | END FUNCTION remap_vector 299 | 300 | 301 | !If a set of kpts and g vectors was read in from the input file, the forward and reverse bloch transform can be done more efficiently doing it manually. 302 | !This will be possible for any system that that was projected from VASP results by BDD code. 303 | !These subroutines can not be called for Gaussian results, since a set k-point grid is not a part of the results. 304 | 305 | !This subroutine transforms a bloch space matrix into a real space periodically resolved matrix 306 | SUBROUTINE bloch_to_real(inp,bloch_mat,real_mat,kpt,gvec) 307 | IMPLICIT NONE 308 | TYPE(nbo_input) :: inp 309 | COMPLEX*16,DIMENSION(:,:,:),INTENT(IN) :: bloch_mat 310 | REAL*8,DIMENSION(:,:,:),INTENT(OUT) :: real_mat 311 | REAL*8,DIMENSION(:,:),INTENT(IN) :: kpt 312 | INTEGER,DIMENSION(:,:),INTENT(IN) :: gvec 313 | 314 | COMPLEX*16 :: arg 315 | INTEGER :: ng, nk 316 | INTEGER :: ig, ik 317 | REAL*8,PARAMETER :: pi=4.d0*ATAN(1.d0) 318 | COMPLEX*16,PARAMETER :: sqrt_neg_one=(0.d0, 1.d0) 319 | 320 | IF( SIZE(bloch_mat,1) /= SIZE(real_mat,1) )STOP 'Improper matching of the sizes of real and bloch space matrices' 321 | 322 | nk = SIZE(bloch_mat,3) 323 | IF( nk /= SIZE(kpt,2) )STOP 'Improper matching of bloch_mat and kpt array in bloch_to_real sub' 324 | 325 | ng = SIZE(real_mat,3) 326 | IF( ng /= SIZE(gvec,2) )STOP 'Improper matching of real_mat and gvec array in bloch_to_real sub' 327 | 328 | real_mat = 0.d0 329 | !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(ik,ig,arg) 330 | !$OMP DO SCHEDULE(STATIC) 331 | DO ig=1,ng 332 | DO ik=1,nk 333 | arg = EXP(-sqrt_neg_one*2.d0*pi*DOT_PRODUCT(kpt(:,ik), gvec(:,ig))) 334 | real_mat(:,:,ig) = real_mat(:,:,ig) + bloch_mat(:,:,ik)*arg 335 | IF( inp%kpt_wt(ik) /= inp%kpt_wt(1) )THEN !For non gamma point matrices use inversion symmetry Rho(k) = Conjg{Rho(-k)} 336 | real_mat(:,:,ig) = real_mat(:,:,ig) + CONJG(bloch_mat(:,:,ik)*arg) 337 | ENDIF 338 | ENDDO 339 | ENDDO 340 | !$OMP END DO NOWAIT 341 | !$OMP END PARALLEL 342 | real_mat = real_mat * inp%kpt_wt(1) 343 | 344 | END SUBROUTINE bloch_to_real 345 | 346 | 347 | 348 | !This subroutine takes a real space periodic matrix and converts it to one in Bloch space at set k-points 349 | SUBROUTINE real_to_bloch(bloch_mat,real_mat,kpt,gvec) 350 | IMPLICIT NONE 351 | COMPLEX*16,DIMENSION(:,:,:),INTENT(OUT) :: bloch_mat 352 | REAL*8,DIMENSION(:,:,:),INTENT(IN) :: real_mat 353 | REAL*8,DIMENSION(:,:),INTENT(IN) :: kpt 354 | INTEGER,DIMENSION(:,:),INTENT(IN) :: gvec 355 | COMPLEX*16 :: arg 356 | INTEGER :: ng, nk 357 | INTEGER :: ig, ik 358 | REAL*8,PARAMETER :: pi=4.d0*ATAN(1.d0) 359 | COMPLEX*16,PARAMETER :: sqrt_neg_one=(0.d0, 1.d0) 360 | IF( SIZE(bloch_mat,1) /= SIZE(real_mat,1) )STOP 'Improper matching of the sizes of real and bloch space matrices' 361 | nk = SIZE(bloch_mat,3) 362 | IF( nk /= SIZE(kpt,2) )STOP 'Improper matching of bloch_mat and kpt array in bloch_to_real sub' 363 | ng = SIZE(real_mat,3) 364 | IF( ng /= SIZE(gvec,2) )STOP 'Improper matching of real_mat and gvec array in bloch_to_real sub' 365 | bloch_mat = 0.d0 366 | !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(ik,ig,arg) 367 | !$OMP DO SCHEDULE(STATIC) 368 | DO ik=1,nk 369 | DO ig=1,ng 370 | arg = EXP(sqrt_neg_one*2.d0*pi*DOT_PRODUCT(kpt(:,ik), gvec(:,ig))) 371 | bloch_mat(:,:,ik) = bloch_mat(:,:,ik) + real_mat(:,:,ig)*arg 372 | ENDDO 373 | ENDDO 374 | !$OMP END DO NOWAIT 375 | !$OMP END PARALLEL 376 | END SUBROUTINE real_to_bloch 377 | 378 | 379 | 380 | END MODULE nbo_shared 381 | -------------------------------------------------------------------------------- /NBO/nbo_shared.mod: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Chengcheng-Xiao/Periodic_NBO/fc14e3069bb9fa755194d6f655a3352a3802c4c8/NBO/nbo_shared.mod -------------------------------------------------------------------------------- /NBO/periodic_matutil.f90: -------------------------------------------------------------------------------- 1 | MODULE periodic_matutil 2 | IMPLICIT NONE 3 | 4 | PRIVATE ng, indexg, map_g 5 | 6 | !A module for manipulating "periodic" matrices, that those that can be represented as A_{mu nu}^{g g'}, i.e. block matrices. 7 | !To be periodic, we require that A_{mu nu}^{g g'} = A_{mu nu}^{0 g'-g}, that is they are translationally invarient. 8 | !Given this periodicity, we need only store A_{mu nu}^{0 g} for a finite number of g-vectors, assuming that the matrices fall 9 | !off with distance. 10 | 11 | !The number of blocks in our periodic matrix 12 | INTEGER :: ng 13 | !The mapping of the ng matrices into spatial cells [ i.e. (dx,dy,dz) for each of the ng blocks ] 14 | INTEGER,ALLOCATABLE :: indexg(:,:) 15 | 16 | CONTAINS 17 | 18 | !Initialize the periodic matrices 19 | SUBROUTINE periodic_matinit(the_ng,the_indexg) 20 | INTEGER :: the_ng 21 | INTEGER,DIMENSION(3,the_ng) :: the_indexg 22 | 23 | ng=the_ng 24 | IF (ALLOCATED(indexg)) DEALLOCATE(indexg) 25 | ALLOCATE(indexg(3,ng)) 26 | indexg=the_indexg 27 | END SUBROUTINE periodic_matinit 28 | 29 | FUNCTION periodic_matiden(n) RESULT(c) 30 | USE matutil 31 | IMPLICIT NONE 32 | REAL*8,DIMENSION(n,n,ng) :: c 33 | INTEGER :: n, ig 34 | 35 | DO ig=1,ng 36 | c(:,:,ig)=matiden(n) 37 | ENDDO 38 | END FUNCTION periodic_matiden 39 | 40 | 41 | !Multiples two periodic matrices. 42 | ! 43 | FUNCTION periodic_matmul(a,b) RESULT(c) 44 | USE BLAS95 45 | IMPLICIT NONE 46 | REAL*8,DIMENSION(:,:,:), INTENT(in) :: a,b 47 | REAL*8,DIMENSION(SIZE(a,1),SIZE(a,2),SIZE(a,3)) :: c 48 | 49 | INTEGER :: ig, igp, idg 50 | INTEGER :: idxg, idyg, idzg, idxgp, idygp, idzgp, idx, idy, idz 51 | INTEGER :: n 52 | 53 | REAL*8 norma(SIZE(a,3)), normb(SIZE(a,3)), normab,thresh 54 | PARAMETER (thresh=1d-16) 55 | 56 | LOGICAL :: debug 57 | PARAMETER (debug=.FALSE.) 58 | INTEGER :: imul, imultot 59 | 60 | n=SIZE(a,1) 61 | !IF (ng.NE.SIZE(a,3)) STOP 'Inconsistent periodic matrix dimensions in periodic_matmul; did you call periodic_matinit?' 62 | 63 | !Calculate the Frobenius norm of each matrix for screening the matrix products 64 | DO ig=1,ng 65 | norma(ig)=SQRT(SUM(a(:,:,ig)**2)) 66 | normb(ig)=SQRT(SUM(b(:,:,ig)**2)) 67 | ENDDO 68 | 69 | !(A*B)_{mu nu}^{0 g} = \sum_g'{ A^{0 g'} * B^{g' g} } 70 | c=0.d0 71 | imul=0 72 | imultot=0 73 | 74 | !loop over all subblocks 75 | !$OMP PARALLEL DEFAULT(PRIVATE) SHARED(imul,imultot,a,b,c,norma,normb,ng,indexg) 76 | !$OMP DO SCHEDULE(DYNAMIC,10) 77 | DO ig=1,ng 78 | idxg=indexg(1,ig) 79 | idyg=indexg(2,ig) 80 | idzg=indexg(3,ig) 81 | 82 | !loop over all possible g' vectors 83 | DO igp=1,ng 84 | idxgp=indexg(1,igp) 85 | idygp=indexg(2,igp) 86 | idzgp=indexg(3,igp) 87 | 88 | !get the index of the subblock corresponding to g - g' 89 | idx=idxg-idxgp 90 | idy=idyg-idygp 91 | idz=idzg-idzgp 92 | idg=find_g(idx,idy,idz) 93 | 94 | !Apply the Cauchy-Schwarz type inquality on the matrix norm to 95 | !screen for negligable contributions 96 | IF (idg.GT.0) THEN 97 | normab=norma(igp)*normb(idg) 98 | ENDIF 99 | !$OMP CRITICAL 100 | imultot=imultot+1 101 | !$OMP END CRITICAL 102 | IF (idg.GT.0.AND.normab.GT.thresh) THEN 103 | ! c(:,:,ig)=c(:,:,ig)+MATMUL(a(:,:,igp),b(:,:,idg)) 104 | CALL GEMM(a(:,:,igp),b(:,:,idg),c(:,:,ig),'N','N',1.d0,1.d0) 105 | !$OMP CRITICAL 106 | imul=imul+1 107 | !$OMP END CRITICAL 108 | ENDIF 109 | 110 | ENDDO 111 | 112 | ENDDO 113 | !$OMP END DO NOWAIT 114 | !$OMP END PARALLEL 115 | 116 | IF (debug) PRINT *, 'Total blocks multiplied: ', imul, 'of', imultot 117 | 118 | END FUNCTION periodic_matmul 119 | 120 | FUNCTION periodic_matvecmul(a,b) RESULT(c) 121 | USE BLAS95 122 | IMPLICIT NONE 123 | REAL*8,DIMENSION(:,:,:), INTENT(in) :: a 124 | REAL*8,DIMENSION(:,:), INTENT(IN) :: b 125 | REAL*8,DIMENSION(SIZE(b,1),SIZE(b,2)) :: c 126 | 127 | INTEGER :: ig, igp, idg 128 | INTEGER :: idxg, idyg, idzg, idxgp, idygp, idzgp, idx, idy, idz 129 | INTEGER :: n 130 | 131 | !REAL*8 norma(SIZE(a,3)), normb(SIZE(a,3)), normab,thresh 132 | !PARAMETER (thresh=1d-16) 133 | 134 | LOGICAL :: debug 135 | PARAMETER (debug=.FALSE.) 136 | INTEGER :: imul, imultot 137 | 138 | !(A*B)_{mu nu}^{0 g} = \sum_g'{ A^{0 g'} * B^{g' g} } 139 | c=0.d0 140 | imul=0 141 | imultot=0 142 | 143 | !loop over all subblocks 144 | DO ig=1,ng 145 | idxg=indexg(1,ig) 146 | idyg=indexg(2,ig) 147 | idzg=indexg(3,ig) 148 | 149 | !WRITE(6,*) 'output of vector',ig,indexg(:,ig) 150 | 151 | !loop over all possible g' vectors 152 | DO igp=1,ng 153 | !WRITE(6,*)'test index ',igp,indexg(:,igp) 154 | idxgp=indexg(1,igp) 155 | idygp=indexg(2,igp) 156 | idzgp=indexg(3,igp) 157 | 158 | !get the index of the subblock corresponding to g - g' 159 | idx=idxg-idxgp 160 | idy=idyg-idygp 161 | idz=idzg-idzgp 162 | idg=find_g(idx,idy,idz) 163 | 164 | imultot=imultot+1 165 | IF (idg.GT.0) THEN 166 | !WRITE(6,*)'non zero matrix',idg,indexg(:,idg) 167 | c(:,ig)=c(:,ig)+MATMUL(a(:,:,idg),b(:,igp)) 168 | !CALL DGEMM_MKL95(a(:,:,igp),b(:,:,idg),c(:,:,ig),'N','N',1.d0,1.d0) 169 | imul=imul+1 170 | ENDIF 171 | 172 | !WRITE(6,*) 173 | 174 | ENDDO 175 | 176 | ENDDO 177 | 178 | END FUNCTION periodic_matvecmul 179 | 180 | 181 | 182 | ! 183 | !Takes the transpose of a periodic matrix. 184 | FUNCTION periodic_transpose(a) RESULT(c) 185 | REAL*8,DIMENSION(:,:,:), INTENT(in) :: a 186 | REAL*8,DIMENSION(SIZE(a,1),SIZE(a,2),SIZE(a,3)) :: c 187 | INTEGER :: ig, igp 188 | 189 | IF (ng.NE.SIZE(a,3)) STOP 'Inconsistent periodic matrix dimensions in periodic_transpose; did you call periodic_matinit?' 190 | 191 | DO ig=1,ng 192 | igp=find_g(-indexg(1,ig),-indexg(2,ig),-indexg(3,ig)) 193 | IF (igp.LE.0) STOP 'Malformed periodic matrix in periodic_transpose' 194 | c(:,:,ig)=TRANSPOSE(a(:,:,igp)) 195 | ENDDO 196 | 197 | END FUNCTION periodic_transpose 198 | 199 | 200 | ! !Takes the square root of a periodic matrix. We accomplish this by: 201 | ! !1) First transforming to the Block basis. 202 | ! !2) In the Bloch basis, the matrix becomes block diagonal 203 | ! !3) Take the square root of each (finite) block 204 | ! !4) Transforming back from the Block basis 205 | ! FUNCTION periodic_matsqrt(a) RESULT(c) 206 | ! USE matutil 207 | ! IMPLICIT NONE 208 | ! REAL*8,DIMENSION(:,:,:), INTENT(in) :: a 209 | ! REAL*8 ,DIMENSION(SIZE(a,1),SIZE(a,2),SIZE(a,3)):: c 210 | ! COMPLEX*16 , ALLOCATABLE, DIMENSION(:,:,:):: ak 211 | ! INTEGER :: nkx, nky, nkz, nk, ik 212 | ! 213 | ! CALL get_nk(nkx,nky,nkz) 214 | ! nk=nkx*nky*nkz 215 | ! 216 | ! ALLOCATE(ak(SIZE(a,1),SIZE(a,2),nk)) 217 | ! 218 | ! Ak=periodic_matbloch(A,nkx,nky,nkz) 219 | ! 220 | ! !Now take the square root of each of the Sk 221 | ! !OpenMP causes problems here since the MKL LAPACK95 interface is not thread safe; I recompiled a thread safe version 222 | ! !by adding -openmp to the makefile 223 | ! 224 | !!$OMP PARALLEL DEFAULT(PRIVATE) SHARED(Ak,nk) 225 | !!$OMP DO SCHEDULE(DYNAMIC,10) 226 | ! DO ik=1,nk 227 | ! Ak(:,:,ik)=matsqrt(Ak(:,:,ik)) 228 | ! ENDDO 229 | !!$OMP END DO NOWAIT 230 | !!$OMP END PARALLEL 231 | ! 232 | ! C=periodic_matinvbloch(Ak,nkx,nky,nkz) 233 | ! 234 | ! END FUNCTION periodic_matsqrt 235 | ! 236 | ! 237 | ! FUNCTION periodic_matinvsqrt(a) RESULT(c) 238 | ! USE matutil 239 | ! IMPLICIT NONE 240 | ! REAL*8,DIMENSION(:,:,:), INTENT(in) :: a 241 | ! REAL*8 ,DIMENSION(SIZE(a,1),SIZE(a,2),SIZE(a,3)):: c 242 | ! COMPLEX*16 , ALLOCATABLE, DIMENSION(:,:,:):: ak 243 | ! INTEGER :: nkx, nky, nkz, nk, ik 244 | ! 245 | ! CALL get_nk(nkx,nky,nkz) 246 | ! nk=nkx*nky*nkz 247 | ! 248 | ! ALLOCATE(ak(SIZE(a,1),SIZE(a,2),nk)) 249 | ! 250 | ! Ak=periodic_matbloch(A,nkx,nky,nkz) 251 | ! 252 | ! !Now take the square root of each of the Sk 253 | ! !OpenMP causes problems here since the MKL LAPACK95 interface is not thread safe; I recompiled a thread safe version 254 | ! !by adding -openmp to the makefile 255 | ! 256 | !!$OMP PARALLEL DEFAULT(PRIVATE) SHARED(Ak,nk) 257 | !!$OMP DO SCHEDULE(DYNAMIC,10) 258 | ! DO ik=1,nk 259 | ! Ak(:,:,ik)=matinvsqrt(Ak(:,:,ik)) 260 | ! ENDDO 261 | !!$OMP END DO NOWAIT 262 | !!$OMP END PARALLEL 263 | ! 264 | ! C=periodic_matinvbloch(Ak,nkx,nky,nkz) 265 | ! 266 | ! END FUNCTION periodic_matinvsqrt 267 | 268 | ! 269 | !Executes a transformation between a periodic matrix A in a localized basis and the same matrix 270 | !in the corresponding Bloch basis 271 | !!$ FUNCTION periodic_matbloch(a,nkx,nky,nkz) RESULT(ak) 272 | !!$ IMPLICIT NONE 273 | !!$ REAL*8,DIMENSION(:,:,:), INTENT(in) :: a 274 | !!$ COMPLEX*16 ,DIMENSION(SIZE(a,1),SIZE(a,2),nkx*nky*nkz):: ak 275 | !!$ 276 | !!$ INTEGER :: nkx, nky, nkz, ikx, iky, ikz, ig, ik 277 | !!$ REAL*8 :: kx, ky, kz, pi, arg 278 | !!$ COMPLEX*16 :: sqrt_minus_one 279 | !!$ 280 | !!$ !nk=ng 281 | !!$ sqrt_minus_one=(0.d0, 1.d0) 282 | !!$ pi=4.d0*ATAN(1.d0) 283 | !!$ 284 | !!$ !Convert from A_{mu nu}^{0 g} to A_{mu _nu}^(k) via Fourier transform 285 | !!$ Ak=0.d0 286 | !!$ ik=0 287 | !!$ DO ikx=1,nkx 288 | !!$ kx=2.d0*pi*(ikx-1)/DBLE(nkx) 289 | !!$ DO iky=1,nky 290 | !!$ ky=2.d0*pi*(iky-1)/DBLE(nky) 291 | !!$ DO ikz=1,nkz 292 | !!$ kz=2.d0*pi*(ikz-1)/DBLE(nkz) 293 | !!$ ik=ik+1 294 | !!$ 295 | !!$ DO ig=1,ng 296 | !!$ arg=kx*indexg(1,ig)+ky*indexg(2,ig)+kz*indexg(3,ig) 297 | !!$ Ak(:,:,ik)=Ak(:,:,ik)+A(:,:,ig)*EXP(sqrt_minus_one*arg) 298 | !!$ ENDDO 299 | !!$ 300 | !!$ ENDDO 301 | !!$ ENDDO 302 | !!$ ENDDO 303 | !!$ 304 | !!$ END FUNCTION periodic_matbloch 305 | 306 | ! !aktemp and aktemp_3d really should be 'EQUIVALENCE'-ed to reduce memory 307 | ! !usage, but this is not allowed since they are automatic arrays. If 308 | ! !reducing memory usage is crucial, aktemp and aktemp_3d could be passed 309 | ! !in as dummy arguments, but pointing to the same array. This would require 310 | ! !a bit of work to not make use of 'SIZE' in the definition of aktemp. 311 | ! FUNCTION periodic_matbloch(a,nkx,nky,nkz) RESULT(ak) 312 | ! USE MKL_DFTI 313 | ! IMPLICIT NONE 314 | ! REAL*8,DIMENSION(:,:,:), INTENT(in) :: a 315 | ! COMPLEX*16, DIMENSION(nkx*nky*nkz*SIZE(a,1)*SIZE(a,2)) :: aktemp 316 | ! COMPLEX*16, DIMENSION(nkx,nky,nkz,SIZE(a,1),SIZE(a,2)) :: aktemp_3d 317 | ! COMPLEX*16 ,DIMENSION(SIZE(a,1),SIZE(a,2),nkx*nky*nkz) :: ak 318 | ! 319 | ! INTEGER :: nkx, nky, nkz, ig, igx, igy, igz 320 | ! TYPE(DFTI_DESCRIPTOR), POINTER :: dfti_desc 321 | ! INTEGER :: status, len(3) 322 | ! 323 | ! !Convert from A_{mu nu}^{0 g} to A_{mu _nu}^(k) via Fourier transform 324 | ! 325 | ! !Rearrange the data to make it conducive to a FFT 326 | ! Aktemp_3d=0.d0 327 | ! DO ig=1,ng 328 | ! CALL map_g(ig,nkx,nky,nkz,igx,igy,igz) 329 | ! Aktemp_3d(igx,igy,igz,:,:)=a(:,:,ig) 330 | ! ENDDO 331 | ! 332 | ! Aktemp=RESHAPE(Aktemp_3d, (/SIZE(a,1)*SIZE(a,2)*nkx*nky*nkz/) ) 333 | ! 334 | ! !Do nbasis**2 3D FFTs of the data to convert the matrix to its Bloch representation 335 | ! len=(/nkx,nky,nkz/) 336 | ! status=DftiCreateDescriptor(dfti_desc, DFTI_DOUBLE, DFTI_COMPLEX, 3, len) 337 | ! status=DftiSetValue(dfti_desc, DFTI_NUMBER_OF_TRANSFORMS, SIZE(a,1)*SIZE(a,2)) 338 | ! status=DftiSetValue(dfti_desc, DFTI_INPUT_DISTANCE, nkx*nky*nkz) 339 | ! status=DftiSetValue(dfti_desc, DFTI_OUTPUT_DISTANCE, nkx*nky*nkz) 340 | ! status=DftiCommitDescriptor(dfti_desc) 341 | ! status=DftiComputeForward(dfti_desc, Aktemp) 342 | ! status=DftiFreeDescriptor(dfti_desc) 343 | ! 344 | ! !Re-rearrange the data to put it pack in a reasonable format 345 | ! Ak=RESHAPE(Aktemp, (/SIZE(a,1), SIZE(a,2), nkx*nky*nkz/), ORDER=(/3,1,2/) ) 346 | ! 347 | ! END FUNCTION periodic_matbloch 348 | 349 | 350 | ! 351 | !Executes a transformation between a periodic matrix A in a Bloch basis and the same matrix 352 | !in the corresponding localized basis 353 | !!$ FUNCTION periodic_matinvbloch(ak,nkx,nky,nkz) RESULT(a) 354 | !!$ IMPLICIT NONE 355 | !!$ COMPLEX*16,DIMENSION(:,:,:), INTENT(in) :: ak 356 | !!$ REAL*8 ,DIMENSION(SIZE(ak,1),SIZE(ak,2),ng):: a 357 | !!$ 358 | !!$ INTEGER :: nkx, nky, nkz, ikx, iky, ikz, ig, ik 359 | !!$ REAL*8 :: kx, ky, kz, pi, arg 360 | !!$ COMPLEX*16 :: sqrt_minus_one 361 | !!$ 362 | !!$ sqrt_minus_one=(0.d0, 1.d0) 363 | !!$ pi=4.d0*ATAN(1.d0) 364 | !!$ 365 | !!$ !Convert from A_{mu nu}^{0 g} to A_{mu _nu}^(k) via Fourier transform 366 | !!$ A=0.d0 367 | !!$ ik=0 368 | !!$ DO ikx=1,nkx 369 | !!$ kx=2.d0*pi*(ikx-1)/DBLE(nkx) 370 | !!$ DO iky=1,nky 371 | !!$ ky=2.d0*pi*(iky-1)/DBLE(nky) 372 | !!$ DO ikz=1,nkz 373 | !!$ kz=2.d0*pi*(ikz-1)/DBLE(nkz) 374 | !!$ ik=ik+1 375 | !!$ 376 | !!$ DO ig=1,ng 377 | !!$ arg=kx*indexg(1,ig)+ky*indexg(2,ig)+kz*indexg(3,ig) 378 | !!$ A(:,:,ig)=A(:,:,ig)+Ak(:,:,ik)*EXP(-sqrt_minus_one*arg) 379 | !!$ ENDDO 380 | !!$ 381 | !!$ ENDDO 382 | !!$ ENDDO 383 | !!$ ENDDO 384 | !!$ A=A/(nkx*nky*nkz) 385 | !!$ 386 | !!$ END FUNCTION periodic_matinvbloch 387 | 388 | ! FUNCTION periodic_matinvbloch(ak,nkx,nky,nkz) RESULT(a) 389 | ! USE MKL_DFTI 390 | ! IMPLICIT NONE 391 | ! COMPLEX*16,DIMENSION(:,:,:), INTENT(in) :: ak 392 | ! COMPLEX*16, DIMENSION(nkx,nky,nkz,SIZE(ak,1),SIZE(ak,2)) :: atemp_3d 393 | ! COMPLEX*16, DIMENSION(nkx*nky*nkz*SIZE(ak,1)*SIZE(ak,2)) :: atemp 394 | ! REAL*8 ,DIMENSION(SIZE(ak,1),SIZE(ak,2),nkx*nky*nkz) :: a 395 | ! 396 | ! INTEGER :: nkx, nky, nkz, ig, igx, igy, igz 397 | ! TYPE(DFTI_DESCRIPTOR), POINTER :: dfti_desc 398 | ! INTEGER :: status, len(3) 399 | ! 400 | ! !Convert from A_{mu nu}^(k) to A_{mu _nu}^{o g} via inverse Fourier transform 401 | ! Atemp_3d=RESHAPE(ak, (/nkx,nky,nkz,SIZE(ak,1),SIZE(ak,2)/), ORDER=(/4,5,1,2,3/) ) 402 | ! Atemp=RESHAPE(Atemp_3d, (/nkx*nky*nkz*SIZE(ak,1)*SIZE(ak,2)/) ) 403 | ! 404 | ! !Do nbasis**2 3D FFTs of the data to convert the matrix to its Bloch representation 405 | ! len=(/nkx,nky,nkz/) 406 | ! status=DftiCreateDescriptor(dfti_desc, DFTI_DOUBLE, DFTI_COMPLEX, 3, len) 407 | ! status=DftiSetValue(dfti_desc, DFTI_NUMBER_OF_TRANSFORMS, SIZE(ak,1)*SIZE(ak,2)) 408 | ! status=DftiSetValue(dfti_desc, DFTI_INPUT_DISTANCE, nkx*nky*nkz) 409 | ! status=DftiSetValue(dfti_desc, DFTI_OUTPUT_DISTANCE, nkx*nky*nkz) 410 | ! status=DftiCommitDescriptor(dfti_desc) 411 | ! status=DftiComputeBackward(dfti_desc, Atemp) 412 | ! status=DftiFreeDescriptor(dfti_desc) 413 | ! 414 | ! !Re-rearrange the data to put it pack in a reasonable format 415 | ! Atemp_3d=RESHAPE(Atemp, (/nkx,nky,nkz,SIZE(a,1),SIZE(a,2)/) ) 416 | ! 417 | ! DO ig=1,ng 418 | ! CALL map_g(ig,nkx,nky,nkz,igx,igy,igz) 419 | ! a(:,:,ig)=Atemp_3d(igx,igy,igz,:,:) 420 | ! ENDDO 421 | ! 422 | ! a=a/(nkx*nky*nkz) 423 | ! 424 | ! END FUNCTION periodic_matinvbloch 425 | 426 | 427 | ! 428 | !Searches through the index to find the appropriate g vector 429 | INTEGER FUNCTION find_g(idx,idy,idz) 430 | IMPLICIT NONE 431 | INTEGER :: idx,idy,idz 432 | INTEGER :: j 433 | 434 | find_g = -1 435 | DO j=1,ng 436 | IF (idx.EQ.indexg(1,j).AND.idy.EQ.indexg(2,j).AND.idz.EQ.indexg(3,j)) find_g = j 437 | ENDDO 438 | END FUNCTION find_g 439 | 440 | ! 441 | !Maps a g-vector into a location appropriate for Fouier transform (i.e. negative g vectors wrap around) 442 | SUBROUTINE map_g(ig,nkx,nky,nkz,igx,igy,igz) 443 | IMPLICIT NONE 444 | INTEGER :: ig,igx,igy,igz,nkx,nky,nkz 445 | 446 | igx=indexg(1,ig) 447 | IF (igx.lt.0) igx=nkx+igx 448 | igx=igx+1 449 | 450 | igy=indexg(2,ig) 451 | IF (igy.lt.0) igy=nky+igy 452 | igy=igy+1 453 | 454 | igz=indexg(3,ig) 455 | IF (igz.lt.0) igz=nkz+igz 456 | igz=igz+1 457 | END SUBROUTINE map_g 458 | 459 | ! 460 | !Gets the appropiate k-space size for the periodic matrix at hand 461 | SUBROUTINE get_nk(nkx,nky,nkz) 462 | IMPLICIT NONE 463 | INTEGER :: nkx,nky,nkz 464 | nkx=MAXVAL(indexg(1,:))-MINVAL(indexg(1,:))+1 465 | nky=MAXVAL(indexg(2,:))-MINVAL(indexg(2,:))+1 466 | nkz=MAXVAL(indexg(3,:))-MINVAL(indexg(3,:))+1 467 | END SUBROUTINE get_nk 468 | 469 | 470 | END MODULE periodic_matutil 471 | -------------------------------------------------------------------------------- /NBO/periodic_matutil.mod: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Chengcheng-Xiao/Periodic_NBO/fc14e3069bb9fa755194d6f655a3352a3802c4c8/NBO/periodic_matutil.mod -------------------------------------------------------------------------------- /NBO/pre_nao.mod: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Chengcheng-Xiao/Periodic_NBO/fc14e3069bb9fa755194d6f655a3352a3802c4c8/NBO/pre_nao.mod -------------------------------------------------------------------------------- /NBO/sortutil.f90: -------------------------------------------------------------------------------- 1 | MODULE sortutil 2 | 3 | INTERFACE quick_sort 4 | MODULE PROCEDURE quick_sort1 5 | MODULE PROCEDURE quick_sort2 6 | END INTERFACE 7 | 8 | CONTAINS 9 | 10 | !In place heap sort, courtesty of NR (F77 version 11 | !ported to F90) 12 | SUBROUTINE heap_sort(ra) 13 | REAL*8 :: ra(:) 14 | INTEGER :: i,ir,j,l,n 15 | REAL*8 :: rra 16 | 17 | n=SIZE(ra,1) 18 | 19 | IF (n.LT.2) RETURN 20 | l=n/2+1 21 | ir=n 22 | 10 CONTINUE 23 | IF(l.GT.1)THEN 24 | l=l-1 25 | rra=ra(l) 26 | ELSE 27 | rra=ra(ir) 28 | ra(ir)=ra(1) 29 | ir=ir-1 30 | IF(ir.EQ.1)THEN 31 | ra(1)=rra 32 | RETURN 33 | ENDIF 34 | ENDIF 35 | i=l 36 | j=l+l 37 | 20 IF(j.LE.ir)THEN 38 | IF(j.LT.ir)THEN 39 | IF(ra(j).LT.ra(j+1))j=j+1 40 | ENDIF 41 | IF(rra.LT.ra(j))THEN 42 | ra(i)=ra(j) 43 | i=j 44 | j=j+j 45 | ELSE 46 | j=ir+1 47 | ENDIF 48 | GOTO 20 49 | ENDIF 50 | ra(i)=rra 51 | GOTO 10 52 | END SUBROUTINE heap_sort 53 | 54 | SUBROUTINE quick_sort1(arr) 55 | INTEGER :: N, M,NSTACK 56 | REAL*8 :: arr(:) 57 | PARAMETER (M=7,NSTACK=50) 58 | INTEGER :: i,ir,j,jstack,k,l,istack(NSTACK) 59 | REAL*8 a,temp 60 | 61 | N=SIZE(arr,1) 62 | jstack=0 63 | l=1 64 | ir=n 65 | 1 IF(ir-l.LT.M)THEN 66 | DO 12 j=l+1,ir 67 | a=arr(j) 68 | DO 11 i=j-1,l,-1 69 | IF(arr(i).LE.a)GOTO 2 70 | arr(i+1)=arr(i) 71 | 11 CONTINUE 72 | i=l-1 73 | 2 arr(i+1)=a 74 | 12 CONTINUE 75 | IF(jstack.EQ.0)RETURN 76 | ir=istack(jstack) 77 | l=istack(jstack-1) 78 | jstack=jstack-2 79 | ELSE 80 | k=(l+ir)/2 81 | temp=arr(k) 82 | arr(k)=arr(l+1) 83 | arr(l+1)=temp 84 | IF(arr(l).GT.arr(ir))THEN 85 | temp=arr(l) 86 | arr(l)=arr(ir) 87 | arr(ir)=temp 88 | ENDIF 89 | IF(arr(l+1).GT.arr(ir))THEN 90 | temp=arr(l+1) 91 | arr(l+1)=arr(ir) 92 | arr(ir)=temp 93 | ENDIF 94 | IF(arr(l).GT.arr(l+1))THEN 95 | temp=arr(l) 96 | arr(l)=arr(l+1) 97 | arr(l+1)=temp 98 | ENDIF 99 | i=l+1 100 | j=ir 101 | a=arr(l+1) 102 | 3 CONTINUE 103 | i=i+1 104 | IF(arr(i).LT.a)GOTO 3 105 | 4 CONTINUE 106 | j=j-1 107 | IF(arr(j).GT.a)GOTO 4 108 | IF(j.LT.i)GOTO 5 109 | temp=arr(i) 110 | arr(i)=arr(j) 111 | arr(j)=temp 112 | GOTO 3 113 | 5 arr(l+1)=arr(j) 114 | arr(j)=a 115 | jstack=jstack+2 116 | IF(jstack.GT.NSTACK)PAUSE 'NSTACK too small in sort' 117 | IF(ir-i+1.GE.j-l)THEN 118 | istack(jstack)=ir 119 | istack(jstack-1)=i 120 | ir=j-1 121 | ELSE 122 | istack(jstack)=j-1 123 | istack(jstack-1)=l 124 | l=i 125 | ENDIF 126 | ENDIF 127 | GOTO 1 128 | END SUBROUTINE quick_sort1 129 | 130 | ! 131 | !Quick sorts arr with corresponding arrangements in brr; 132 | !thus brr can be used to idenitfy the permutations 133 | SUBROUTINE quick_sort2(arr,brr) 134 | INTEGER :: n,M,NSTACK 135 | REAL*8 :: arr(:) 136 | INTEGER :: brr(:) 137 | PARAMETER (M=7,NSTACK=50) 138 | INTEGER :: i,ir,j,jstack,k,l,istack(NSTACK) 139 | REAL*8 :: a,b,temp 140 | 141 | N=SIZE(arr,1) 142 | jstack=0 143 | l=1 144 | ir=n 145 | 1 IF(ir-l.LT.M)THEN 146 | DO 12 j=l+1,ir 147 | a=arr(j) 148 | b=brr(j) 149 | DO 11 i=j-1,l,-1 150 | IF(arr(i).LE.a)GOTO 2 151 | arr(i+1)=arr(i) 152 | brr(i+1)=brr(i) 153 | 11 CONTINUE 154 | i=l-1 155 | 2 arr(i+1)=a 156 | brr(i+1)=b 157 | 12 CONTINUE 158 | IF(jstack.EQ.0)RETURN 159 | ir=istack(jstack) 160 | l=istack(jstack-1) 161 | jstack=jstack-2 162 | ELSE 163 | k=(l+ir)/2 164 | temp=arr(k) 165 | arr(k)=arr(l+1) 166 | arr(l+1)=temp 167 | temp=brr(k) 168 | brr(k)=brr(l+1) 169 | brr(l+1)=temp 170 | IF(arr(l).GT.arr(ir))THEN 171 | temp=arr(l) 172 | arr(l)=arr(ir) 173 | arr(ir)=temp 174 | temp=brr(l) 175 | brr(l)=brr(ir) 176 | brr(ir)=temp 177 | ENDIF 178 | IF(arr(l+1).GT.arr(ir))THEN 179 | temp=arr(l+1) 180 | arr(l+1)=arr(ir) 181 | arr(ir)=temp 182 | temp=brr(l+1) 183 | brr(l+1)=brr(ir) 184 | brr(ir)=temp 185 | ENDIF 186 | IF(arr(l).GT.arr(l+1))THEN 187 | temp=arr(l) 188 | arr(l)=arr(l+1) 189 | arr(l+1)=temp 190 | temp=brr(l) 191 | brr(l)=brr(l+1) 192 | brr(l+1)=temp 193 | ENDIF 194 | i=l+1 195 | j=ir 196 | a=arr(l+1) 197 | b=brr(l+1) 198 | 3 CONTINUE 199 | i=i+1 200 | IF(arr(i).LT.a)GOTO 3 201 | 4 CONTINUE 202 | j=j-1 203 | IF(arr(j).GT.a)GOTO 4 204 | IF(j.LT.i)GOTO 5 205 | temp=arr(i) 206 | arr(i)=arr(j) 207 | arr(j)=temp 208 | temp=brr(i) 209 | brr(i)=brr(j) 210 | brr(j)=temp 211 | GOTO 3 212 | 5 arr(l+1)=arr(j) 213 | arr(j)=a 214 | brr(l+1)=brr(j) 215 | brr(j)=b 216 | jstack=jstack+2 217 | IF(jstack.GT.NSTACK)PAUSE 'NSTACK too small in sort2' 218 | IF(ir-i+1.GE.j-l)THEN 219 | istack(jstack)=ir 220 | istack(jstack-1)=i 221 | ir=j-1 222 | ELSE 223 | istack(jstack)=j-1 224 | istack(jstack-1)=l 225 | l=i 226 | ENDIF 227 | ENDIF 228 | GOTO 1 229 | END SUBROUTINE quick_sort2 230 | 231 | END MODULE sortutil 232 | -------------------------------------------------------------------------------- /NBO/sortutil.mod: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Chengcheng-Xiao/Periodic_NBO/fc14e3069bb9fa755194d6f655a3352a3802c4c8/NBO/sortutil.mod -------------------------------------------------------------------------------- /NBO/visual.f90: -------------------------------------------------------------------------------- 1 | MODULE visual 2 | 3 | CONTAINS 4 | 5 | SUBROUTINE NBO_visualization(AO_basis,ao_coeff,atom_pos,indexg,a,atomic_number,vis_control) 6 | USE nbo_shared !Where the defined types are stored 7 | IMPLICIT NONE 8 | 9 | TYPE(AO_function),INTENT(IN) :: AO_basis(:) !Basis functions 10 | TYPE(vis_cont_struct),INTENT(IN) :: vis_control !Info from config file. Type limits the size of the this subroutine call. 11 | REAL*8,INTENT(IN) :: ao_coeff(:,:,:,:) !Coefficients for each NBO in AO basis 12 | REAL*8,INTENT(IN) :: atom_pos(:,:) !Positions of atoms in central unit cell 13 | INTEGER,INTENT(IN) :: indexg(:,:) !Indices of unit cells to use 14 | REAL*8,INTENT(IN) :: a(3,3) !Lattice vectors. First index is cartesian, second is lattice vector. 15 | INTEGER,INTENT(IN) :: atomic_number(:) !Atomic number. Makes the cube file more complete 16 | 17 | !System parameters 18 | INTEGER :: nbasis,nnbo,ng,nspin,natom 19 | 20 | !Used for constructing chunk of atoms from bulk to use 21 | REAL*8, DIMENSION(3) :: image_pos 22 | REAL*8, DIMENSION(3,2) :: image_screen 23 | INTEGER :: image_count, image_tot 24 | LOGICAL, ALLOCATABLE :: image_disp(:) 25 | 26 | 27 | !For standardized file names 28 | !I make all possible file names and create them only when the file is called 29 | CHARACTER(20),ALLOCATABLE :: file_names(:,:) 30 | INTEGER :: file_num 31 | 32 | 33 | !Parameters for gridding 34 | INTEGER, DIMENSION(3) :: mesh !mesh size to use 35 | REAL*8, DIMENSION(3,3) :: box !box size to grid 36 | REAL*8, DIMENSION(3) :: r,origin! !radius used in griding and origin for the cube file 37 | REAL*8 :: gridvol 38 | 39 | 40 | !For calculating AO values 41 | REAL*8 :: gaussian, gauss_coeff 42 | REAL*8 :: rsqr 43 | REAL*8 :: cartesian 44 | REAL*8,DIMENSION(3) :: r_pos 45 | REAL*8 :: screen 46 | 47 | 48 | !Values to plot and control for calculations 49 | REAL*8 :: density 50 | REAL*8 :: wave_funct 51 | INTEGER :: dens_exp 52 | 53 | 54 | !Counters 55 | INTEGER :: ig,inbo,nu,ispin 56 | INTEGER :: ix,iy,iz, i,j,k 57 | 58 | !Start by determining some system parameters from array dimensions 59 | natom = SIZE(atom_pos,2) 60 | nnbo = SIZE(ao_coeff,2) 61 | nbasis = SIZE(ao_coeff,1) 62 | IF( nbasis.NE.nnbo )STOP 'There are a different number of AOs and NBOs in visualization subroutine. Something is wrong' 63 | ng=SIZE(ao_coeff,3) 64 | nspin=SIZE(ao_coeff,4) 65 | 66 | !WRITE(6,*)'Range of NBOs to visualize' 67 | !WRITE(6,*)vis_control%vis_start,vis_control%vis_end 68 | !WRITE(6,*) 69 | 70 | !The density is potentaily desired outside of the central unit cell, for instance a bond that spans unit cells 71 | !Thus, we will numerically integrate a grid over the volume 'box' which will contain the central unit cell and surrounding space. 72 | !The value of box is the absolute value of the lengths of the box 73 | !'origin' then account for the shift of the grid origin off center 74 | 75 | !WRITE(6,*)'latt_vec' 76 | !WRITE(6,'(3F11.5)')a 77 | 78 | 79 | DO i=1,3 80 | box(:,i) = a(:,i)*DBLE(vis_control%box_int(i)) 81 | ENDDO 82 | origin = vis_control%origin_fact*(a(:,1)+a(:,2)+a(:,3)) 83 | !The mesh parameter determines how many grid points are used in each direction for the numerical integration 84 | !For non-cubic boxes, different components of this vector should be assigned so that resoultion is similar in all directions. 85 | mesh = vis_control%mesh 86 | 87 | WRITE(6,*)'Box dimensions in bohr' 88 | WRITE(6,'(3F11.5)')box 89 | WRITE(6,*) 90 | WRITE(6,*)'Origin in bohr' 91 | WRITE(6,'(3F11.5)')origin 92 | WRITE(6,*) 93 | WRITE(6,*)'Grid resoultion for each vector' 94 | WRITE(6,'(3I11)')mesh 95 | WRITE(6,*) 96 | 97 | 98 | !Final control parameter is whether density or wave functions will be plotted 99 | !The exponent will be applied to the wavefunction when calculating the density. 100 | IF( vis_control%density )THEN 101 | dens_exp = 2 102 | ELSE 103 | dens_exp = 1 104 | ENDIF 105 | 106 | 107 | !Prepare the file names of all the .cube files for each NBO of each type of spin 108 | !If there is only one spin type, it is unecessary to give different names based on spoin type 109 | ALLOCATE(file_names(nnbo,nspin)) 110 | IF( nspin .EQ. 1 )THEN 111 | DO inbo=1,nnbo 112 | IF( inbo < 10 )THEN 113 | WRITE(file_names(inbo,1),'(A5,I1,A5)')'nbo_',inbo,'.cube' 114 | ELSEIF( inbo < 100 )THEN 115 | WRITE(file_names(inbo,1),'(A5,I2,A5)')'nbo_',inbo,'.cube' 116 | ELSEIF( inbo < 1000 )THEN 117 | WRITE(file_names(inbo,1),'(A5,I3,A5)')'nbo_',inbo,'.cube' 118 | ELSE 119 | WRITE(6,*)'the code is not set up to write out the denisty for more than 999 NBOs' 120 | STOP 121 | ENDIF 122 | ENDDO 123 | ELSE !For spin polarized calculations call the first spin type alpha and the second type beta NBO's 124 | DO inbo=1,nnbo 125 | IF( inbo < 10 )THEN 126 | WRITE(file_names(inbo,1),'(A11,I1,A5)')'alpha_nbo_',inbo,'.cube' 127 | WRITE(file_names(inbo,2),'(A10,I1,A5)')'beta_nbo_',inbo,'.cube' 128 | ELSEIF( inbo < 100 )THEN 129 | WRITE(file_names(inbo,1),'(A11,I2,A5)')'alpha_nbo_',inbo,'.cube' 130 | WRITE(file_names(inbo,2),'(A10,I2,A5)')'beta_nbo_',inbo,'.cube' 131 | ELSEIF( inbo < 1000 )THEN 132 | WRITE(file_names(inbo,1),'(A11,I3,A5)')'alpha_nbo_',inbo,'.cube' 133 | WRITE(file_names(inbo,2),'(A10,I3,A5)')'beta_nbo_',inbo,'.cube' 134 | ELSE 135 | WRITE(6,*)'the code is not set up to write out the denisty for more than 999 NBOs' 136 | STOP 137 | ENDIF 138 | ENDDO 139 | ENDIF 140 | 141 | !Calculates the grid volume for the specified mesh dimensions 142 | !This is used in numerically integrating the density 143 | CALL grid_volume(gridvol, box, mesh) 144 | !WRITE(6,'(A,F10.5)')' integration grid volume',gridvol 145 | !WRITE(6,*) 146 | 147 | !To aid in visualization we will want more than just the atoms in the unit cell. 148 | !To do this we will scan over all atom positions in all unit cells, and store those 'close' to the central unit cell 149 | !Start by establishing cutoffs for determining 'closeness' 150 | image_screen = 0.d0 151 | DO j=1,3 152 | image_screen(j,1) = MIN( origin(j), MINVAL(0.5d0*box(j,:))) 153 | image_screen(j,2) = MAXVAL(box(j,:)) + origin(j) 154 | ENDDO 155 | 156 | !Then every position is scanned over (each atom in all unit cells characterized by an l-vector) 157 | !Those within the cutoffs determined above are stored 158 | ALLOCATE(image_disp(natom*ng)) 159 | image_disp = .FALSE. 160 | image_count = 0 161 | image_tot = 0 162 | DO j=1,natom 163 | !WRITE(6,*)'atom',j,atom_pos(:,j) 164 | DO ig=1,ng 165 | image_tot = image_tot + 1 166 | image_pos = atom_pos(:,j) 167 | DO k=1,3 168 | image_pos = image_pos + indexg(k,ig)*a(:,k) 169 | ENDDO 170 | IF( image_pos(1) > image_screen(1,1) .AND. image_pos(1) < image_screen(1,2))THEN 171 | IF( image_pos(2) > image_screen(2,1) .AND. image_pos(2) < image_screen(2,2))THEN 172 | IF( image_pos(3) > image_screen(3,1) .AND. image_pos(3) < image_screen(3,2))THEN 173 | !WRITE(6,*)index_l(il,:) 174 | !WRITE(6,*)image_pos 175 | image_disp(image_tot) = .TRUE. 176 | image_count = image_count + 1 177 | ENDIF 178 | ENDIF 179 | ENDIF 180 | ENDDO 181 | !WRITE(6,*) 182 | ENDDO 183 | !WRITE(6,*)'image count',image_count 184 | !WRITE(6,*) 185 | 186 | !Then a file containing the dimensions of the central unit cell as well as the positions of all atoms in the central and surrounding unit cells 187 | OPEN(10, file='lattice_vec.cube') 188 | WRITE(10, *) 'Cube file generated by write_cube subroutine' 189 | WRITE(10, *) 'Density' 190 | WRITE(10, '(I5,3F12.6)' ) image_count, 0.d0, 0.d0, 0.d0 191 | DO i=1,3 192 | WRITE(10, '(I5,3F12.6)' ) (mesh(i)/vis_control%box_int(i)), a(1,i)/(mesh(i)/vis_control%box_int(i)), a(2,i)/(mesh(i)/vis_control%box_int(i)), a(3,i)/(mesh(i)/vis_control%box_int(i)) 193 | ENDDO 194 | !WRITE(10, '(I5,3F12.6)' ) mesh(2), a(1,2)/mesh(2), a(2,2)/mesh(2), a(3,2)/mesh(2) 195 | !WRITE(10, '(I5,3F12.6)' ) mesh(3), a(1,3)/mesh(3), a(2,3)/mesh(3), a(3,3)/mesh(3) 196 | image_tot = 0 197 | DO j=1,natom 198 | DO ig=1,ng 199 | image_tot = image_tot + 1 200 | IF( image_disp(image_tot) )THEN 201 | image_pos = atom_pos(:,j) 202 | DO k=1,3 203 | image_pos = image_pos + indexg(k,ig)*a(:,k) 204 | ENDDO 205 | WRITE(10, '(I5,4F12.6)' ) atomic_number(j), 1.0, image_pos(1), image_pos(2), image_pos(3) 206 | ENDIF 207 | ENDDO 208 | ENDDO 209 | 210 | !The remainder of the lattice_vec.cube file is filled with appropriate dimension and formatted zero-valued density 211 | !This prevents VMD from having trouble opening the file and displaying the appropriate unit cell vectors 212 | DO j=1,PRODUCT(DBLE(mesh/vis_control%box_int)) 213 | WRITE(10,"(E13.5)",ADVANCE='NO')0.d0 214 | IF( MODULO(MODULO(j,mesh(3)/vis_control%box_int(3)),6) == 0 )WRITE(10,*) 215 | ENDDO 216 | 217 | CLOSE(10) 218 | 219 | WRITE(6,*)'Now creating .cube file for desired orbitals' 220 | 221 | !Finally a .cube file for each nbo, for each spin is filled with appropriate density on the 'mesh' grid 222 | !Note: this grid can extend beyond the unit cell based on the box variable 223 | DO ispin=1,nspin 224 | IF( nspin.GT.1 )WRITE(6,*)'For spin type',ispin 225 | 226 | DO inbo=vis_control%vis_start,vis_control%vis_end 227 | WRITE(6,*)'Orbital Number: ',inbo 228 | 229 | !Start by opening the appropriate file (names created above) and writing the cube file header 230 | file_num = inbo+6 231 | OPEN(file_num, file=file_names(inbo,ispin)) 232 | write(file_num, *) 'Cube file generated by write_cube subroutine' 233 | write(file_num, *) 'Density' 234 | write(file_num, '(I5,3F12.6)' ) natom, origin(1), origin(2), origin(3) 235 | write(file_num, '(I5,3F12.6)' ) mesh(1), box(1,1)/mesh(1), box(2,1)/mesh(1), box(3,1)/mesh(1) 236 | write(file_num, '(I5,3F12.6)' ) mesh(2), box(1,2)/mesh(2), box(2,2)/mesh(2), box(3,2)/mesh(2) 237 | write(file_num, '(I5,3F12.6)' ) mesh(3), box(1,3)/mesh(3), box(2,3)/mesh(3), box(3,3)/mesh(3) 238 | DO j=1,natom 239 | WRITE(file_num, '(I5,4F12.6)' ) atomic_number(j), 1.0, atom_pos(1,j), atom_pos(2,j), atom_pos(3,j) 240 | ENDDO 241 | 242 | !Then the grid is looped over for the total box and density tabulated 243 | DO ix=1,mesh(1) 244 | DO iy=1,mesh(2) 245 | DO iz=1,mesh(3) 246 | density = 0.d0 247 | 248 | r = ((ix-1)/DBLE(mesh(1)))*box(:,1) + ((iy-1)/DBLE(mesh(2)))*box(:,2) + ((iz-1)/DBLE(mesh(3)))*box(:,3) 249 | r = r + origin 250 | 251 | wave_funct = 0.d0 252 | !The effect of each basis function in each unit cell must be calculated for each grid point 253 | DO nu=1,nbasis 254 | DO ig=1,ng 255 | 256 | !In many unit cells, the coefficient is zero, so there is no need to calculate a function's value 257 | IF( ao_coeff(nu,inbo,ig,ispin) /= 0.d0 )THEN 258 | r_pos = r - (AO_basis(nu)%pos + indexg(1,ig)*a(:,1) + indexg(2,ig)*a(:,2) + indexg(3,ig)*a(:,3)) 259 | rsqr = DOT_PRODUCT(r_pos,r_pos) 260 | 261 | !The guassian component of nu at r is now calculated. Screening is used 262 | gaussian = 0.d0 263 | DO j=AO_basis(nu)%num_gauss,1,-1 !In going backwards I assume alpha's are stored in descending order 264 | screen = AO_basis(nu)%alpha(j) * rsqr 265 | IF( screen .GT. 45.d0 )EXIT !In the loop each gaussian is less diffuse than the last, so all following gaussians will also be screened 266 | gaussian = gaussian + AO_basis(nu)%coeff(j)*AO_basis(nu)%norm(j)*EXP(-screen) 267 | ENDDO 268 | 269 | !The cartesian component and multiplication with the coefficient of the AO in the NBO is only done, it the gaussian component is non-zero 270 | !Since many gaussians are screened out because of length, this screens alot of unnecessary calculations 271 | IF( gaussian .NE. 0.d0 )THEN 272 | cartesian = 0.d0 273 | DO j=1,AO_basis(nu)%ncart 274 | cartesian = cartesian + AO_basis(nu)%cart_coeff(j)*PRODUCT(r_pos**AO_basis(nu)%cart_mat(j,:)) 275 | ENDDO 276 | wave_funct = wave_funct + gaussian*cartesian*ao_coeff(nu,inbo,ig,ispin) 277 | ENDIF 278 | ENDIF 279 | 280 | ENDDO 281 | ENDDO 282 | 283 | !The wave function value is then squared to obtain a density 284 | IF( wave_funct .NE. 0.d0 )THEN 285 | density = wave_funct**dens_exp 286 | IF( ABS(density) .LT. 1.d-30 )density = 0.d0 !Too low of values in the cube file mess up VMD. Since they are small anyways I round down to zero 287 | ENDIF 288 | 289 | !The density is then written in the appropriate format of a .cube file 290 | WRITE(file_num, "(E13.5)", advance="no") density 291 | IF ( MOD(iz,6) == 0 )THEN 292 | WRITE(file_num,*) 293 | ENDIF 294 | 295 | ENDDO !End of loop in mesh through fastest direction (z) 296 | 297 | WRITE(file_num,*) 298 | 299 | ENDDO 300 | ENDDO !End of loop over mesh 301 | 302 | CLOSE(file_num) 303 | 304 | 305 | ENDDO !End of loop over band 306 | 307 | ENDDO 308 | 309 | 310 | END SUBROUTINE NBO_visualization 311 | 312 | SUBROUTINE grid_volume(gridvol, b, mesh) 313 | IMPLICIT NONE 314 | REAL*8, INTENT(IN) :: b(3,3) ! Reciprocal lattice vectors 315 | INTEGER, INTENT(IN) :: mesh(3) ! Number of grid points in each direction, inverse gives lenght of grid vector 316 | REAL*8, INTENT(OUT) :: gridvol ! Volume of box to use for integration 317 | REAL*8 :: grid_vec(3,3) ! Vectors of gridbox in direction of recip lattice vectors 318 | INTEGER :: j 319 | 320 | 321 | DO j=1,3 322 | grid_vec(:,j)=(1.d0/DBLE(mesh(j)))*b(:,j) 323 | ENDDO 324 | 325 | gridvol = DOT_PRODUCT(grid_vec(:,1), cross(grid_vec(:,2),grid_vec(:,3))) 326 | 327 | 328 | END SUBROUTINE grid_volume 329 | 330 | FUNCTION cross(a, b) 331 | REAL*8,INTENT (in) :: a(3), b(3) 332 | REAL*8 :: cross(3) 333 | 334 | cross(1) = a(2) * b(3) - a(3) * b(2) 335 | cross(2) = a(3) * b(1) - a(1) * b(3) 336 | cross(3) = a(1) * b(2) - a(2) * b(1) 337 | END FUNCTION cross 338 | 339 | 340 | 341 | END MODULE visual 342 | -------------------------------------------------------------------------------- /NBO/visual.mod: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Chengcheng-Xiao/Periodic_NBO/fc14e3069bb9fa755194d6f655a3352a3802c4c8/NBO/visual.mod -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Periodic NBO software 2 | 3 | __DEPRECATED__: please head to [official repo](https://github.com/jrschmidt2/periodic-NBO). 4 | 5 | --- 6 | 7 | *This project is originally written by Schmidt Research Group @ University of Wisconsin–Madison. 8 | Forked from [🔗LINK](https://schmidt.chem.wisc.edu/nbosoftware).* 9 | 10 | *The source code has been updated by replacing several deprecated routine-calling scheme, and a modified Makefile for it to work with newest intel compiler and MKL version 2019.3.199* 11 | 12 | We have generalized the Natural Bond Orbital algorithm to handle systems characterized by periodic symmetry. While the code only requires information that can be obtained from the output of any periodic electronic structure calculation, it requires specifically formatted input files. We have created interfaces for the VASP and CRYSTAL software packages, which process those codes' output into the requisite format. 13 | 14 | ## Getting Started 15 | 16 | These instructions will get you a copy of the project up and running on your local machine for development and testing purposes. 17 | 18 | This package comes in two part: 19 | 1. DFT interface and projection executable. 20 | 2. NBO calculation executable. 21 | 22 | ### Prerequisites 23 | 24 | The code is written in `Fortran 90`, and requires the `MKL BLAS95` and `MKL LAPACK95` libraries, as well as libraries used in the OpenMP parallelization. 25 | 26 | ### Installing DFT interfaces 27 | 1. VASP 28 | * Insert `projection_output.F` in `./projection_VASP/VASP_patch` into directory containing VASP source code `./scr`. 29 | * apply `proj_VASP.patch` by 30 | ``` 31 | patch -p0 < proj_VASP.patch 32 | ``` 33 | * Compile VASP。 34 | * To compile `projection.exe`, modify `Makefile` under `./projection_VASP` and then type `Make`. 35 | 36 | 2. CRYSTAL 37 | * No modification needed. 38 | 39 | ### Installing NBO software 40 | 1. modify `Makefile` under `./NBO`. 41 | 42 | 2. type `make` to get `nbo.exe` 43 | 44 | ## Useage 45 | Please see `READ_ME.txt` under each folder to see exactly how it works. 46 | 47 | 48 | ## How to cite 49 | 50 | We request that anyone who downloads and utilizes the code cite: 51 | 52 | Dunnington, B. D.; Schmidt, J. R., 53 | *Generalization of Natural Bond Orbital Analysis to Periodic Systems: Applications to Solids and Surfaces via Plane-Wave Density Functional Theory*, [J. Chem. Theory Comput., 2012, 8 (6), pp 1902–1911](http://dx.doi.org/ 10.1021/ct300002t) 54 | 55 | ## License 56 | 57 | This project is licensed under the GNU License - see the `LICENSE.md` for details 58 | -------------------------------------------------------------------------------- /projection_VASP/LICENSE.txt: -------------------------------------------------------------------------------- 1 | Copyright 2012,2013 Benjamin Dunnington and J.R. Schmidt 2 | 3 | This program is free software: you can redistribute it and/or modify 4 | it under the terms of the GNU General Public License as published by 5 | the Free Software Foundation, either version 3 of the License, or 6 | at your option) any later version. 7 | 8 | This program is distributed in the hope that it will be useful, 9 | but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | GNU General Public License for more details. 12 | 13 | You should have received a copy of the GNU General Public License 14 | along with this program. If not, see . 15 | -------------------------------------------------------------------------------- /projection_VASP/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile created by mkmf $Id: mkmf,v 13.0 2006/04/10 21:20:01 fms Exp $ 2 | 3 | LD=ifort 4 | FC=ifort 5 | FFLAGS= -I$(MKLROOT)/include/intel64/lp64 -mkl=sequential -heap-arrays 64 6 | LDFLAGS=-qopenmp -lmkl_blas95_ilp64 -lmkl_lapack95_ilp64 -lpthread -lm -I$(MKLROOT)/include/intel64/lp64 -mkl=sequential 7 | 8 | .DEFAULT: 9 | -touch $@ 10 | all: a.out 11 | rd_basis.o: ./rd_basis.f90 rd_wavefunction.o projection_shared.o 12 | $(FC) $(FFLAGS) -c ./rd_basis.f90 13 | projection_main.o: ./projection_main.f90 rd_wavefunction.o projection_shared.o rd_basis.o bloch_overlap.o PAW.o 14 | $(FC) $(FFLAGS) -c ./projection_main.f90 15 | PAW.o: ./PAW.f90 projection_shared.o rd_wavefunction.o 16 | $(FC) $(FFLAGS) -c ./PAW.f90 17 | rd_wavefunction.o: ./rd_wavefunction.f90 18 | $(FC) $(FFLAGS) -c ./rd_wavefunction.f90 19 | projection_shared.o: ./projection_shared.f90 rd_wavefunction.o 20 | $(FC) $(FFLAGS) -c ./projection_shared.f90 21 | bloch_overlap.o: ./bloch_overlap.f90 rd_wavefunction.o projection_shared.o 22 | $(FC) $(FFLAGS) -c ./bloch_overlap.f90 23 | SRC = ./rd_basis.f90 ./projection_main.f90 ./PAW.f90 ./rd_wavefunction.f90 ./projection_shared.f90 ./bloch_overlap.f90 24 | OBJ = rd_basis.o projection_main.o PAW.o rd_wavefunction.o projection_shared.o bloch_overlap.o 25 | clean: neat 26 | -rm -f .cppdefs $(OBJ) projection.exe 27 | neat: 28 | -rm -f $(TMPFILES) 29 | TAGS: $(SRC) 30 | etags $(SRC) 31 | tags: $(SRC) 32 | ctags $(SRC) 33 | a.out: $(OBJ) 34 | $(LD) $(OBJ) -o projection.exe $(LDFLAGS) 35 | -------------------------------------------------------------------------------- /projection_VASP/READ_ME.txt: -------------------------------------------------------------------------------- 1 | *********************************************************** 2 | *********************************************************** 3 | 4 | Projection Code Instructions and guide lines 5 | By BDD 2/25/15 6 | 7 | A description of the projection algorithm can be found in: 8 | Dunnington and Schmidt, JCTC; 8, 1902-1911 (2012) 9 | *********************************************************** 10 | *********************************************************** 11 | 12 | This projection code is capable of representing any plane-wave bands output by VASP 13 | into any user specified Gaussian type orbital basis set. 14 | The code is set up to then output all information necessary for periodic 15 | NBO analysis using the code of JRS and BDD. 16 | 17 | 18 | ************************************* 19 | ************************************* 20 | ************BASIC RECIPE************* 21 | ************************************* 22 | ************************************* 23 | 24 | 25 | 1. Insert projection_output.F into directory containing VASP source code and apply 26 | proj_VASP.patch 27 | 28 | 2. Run VASP calculation with LNBO=.TRUE. in INCAR (creates wavefunction.dat) 29 | 30 | 3. Command to run the projection with optional arguments in brackets 31 | ./projection.exe [basis.inp] [wavefunction.dat] [NBO.out] 32 | NOTE: basis.inp must obey Gaussian94 format 33 | 34 | ************************************* 35 | ************************************* 36 | ***********COMMON PROBLEMS*********** 37 | ************************************* 38 | ************************************* 39 | 40 | 41 | If the code crashes and prints "Segmentation fault." you need to increase 42 | OMP_STACKSIZE. 43 | 44 | Make sure the order of atom types in the basis.inp files matches that of the 45 | POTCAR file used for the VAsP calculation. 46 | 47 | Using diffuse AO-basis functions will cause problems due to the creation of linear 48 | dependencies. These functions are not useful for bulk systems and are also 49 | incompatible with NBO analysis. A good rule of thumb is no exponents much lower 50 | than 0.1 bohr^-2. 51 | 52 | Balance is the most important characteristic when determining the quality of a 53 | basis set for projecting into. For instance, using a quadruple-zeta basis for atoms 54 | in an adosrbate with a double-zeta basis for surface atoms will give artificially 55 | polarized results. 56 | This means you should be careful when using basis sets for different atom types 57 | from different sources. 58 | 59 | 60 | ************************************* 61 | ************************************* 62 | **********VASP Modification********** 63 | ************************************* 64 | ************************************* 65 | 66 | 67 | VASP must be modified to output the necessary information that can then be 68 | read by the projection code. There are two aspects of this modification process: 69 | 1. Inclusion of module, 'projection_output.F' 70 | This module is included in the tar and needs to be copied into the directory 71 | containing the VASP source code. 72 | For VASP 4 and VASP 5.3 you will also need to modify the makefile. In the 73 | list labelled 'SOURCE' you will need to include 'projection_output.o'at the end 74 | of the list. 75 | No modification of the makefile is required for VASP 5.4. 76 | 2. Apply proj_VASP.patch 77 | You will need to apply the appropriate patch based on the version of VASP you are 78 | using. The patch is called 'proj_VASP_{version #}.patch'. It can be applied 79 | to the VASP source code using the command 80 | "patch < proj_VASP_{version #}.patch" 81 | This will modify main.F to call our output subroutine as well as create a 82 | logical variable that controls printing of the output. 83 | 84 | 85 | ************************************* 86 | ************************************* 87 | ************Running VASP************* 88 | ************************************* 89 | ************************************* 90 | 91 | 92 | For VASP to print the necessary output, the line LNBO=.TRUE. must be included in 93 | the INCAR. This will produce an unformatted file called wavefunction.dat that can 94 | be read by the projection algorithm. 95 | There are a few limiations on other parameters of the VASP run as well: 96 | 97 | 1. ISYM=0 Turning off k-point symmetry is not required for the projection algorithm, 98 | as the process is performed uniquely at each k-point. However, if you are 99 | interested in performing a real-space analysis, i.e. NBO, k-point symmetry will 100 | need to be turned off in the VASP calculatio as our implementation of inverse 101 | Fourier Transforms is not compatible with symmetry. 102 | NOTE: ISYM=-1 is not recommended. 103 | 104 | 2. Gamma-point containing k-point mesh. To take advantage of the inversion symmetry 105 | of the Brillouin zone, the first k-point is assumed to be the gamma point. 106 | 107 | 3. NPAR must be left at default values. 108 | 109 | 4. NO ULTRASOFT PSEUDOPOTENTIALS. There is no functional form associated with this 110 | pseudopotential and it is therefore impossible to project a correction for the 111 | valence electrons' interaction with the core electrons. 112 | This means the valence bands will each reprensent a (different) incorrect number 113 | of electrons. 114 | Norm conserving and PAW type pseudopotentials are compatible with the code. 115 | 116 | The algorithm should be compatible with all other VASP options, including spin 117 | polarized calculations. 118 | 119 | 120 | ************************************* 121 | ************************************* 122 | ******Compiling the Projection******* 123 | ************************************* 124 | ************************************* 125 | 126 | 127 | The makefile contained with this file will produce an executable called 128 | 'projection.exe'. 129 | The code uses algorithms from BLAS and LAPACK. We have used the MKL versions. 130 | Modifications to both linking and the subroutine calls will need to be made if 131 | MKL libraries are not available. 132 | 133 | 134 | ************************************* 135 | ************************************* 136 | *******Running the Projection******** 137 | ************************************* 138 | ************************************* 139 | 140 | 141 | This executable then runs with three (optional) inputs. 142 | They are listed below in order they will be read in by the program, along with the 143 | default file name the program will look for in the working directory. 144 | 145 | 1. Basis set file. 'basis.inp' 146 | This should contain all information on the atomic orbital basis set to be used, 147 | in the format of Gaussian94. This means any header can be used, but each atom 148 | type must begin and end with a line of '****'. 149 | Basis set orbital types can include everything up to f-type, including 150 | 'sp'-labeling. 151 | Order of the atom types must match that of the POTCAR used in the VASP run. 152 | 153 | 2. VASP output file. 'wavefunction.dat' 154 | This file is output from our customized version of VASP as wavefunction.dat and 155 | contains all necessary information about the plane-wave output for use in the 156 | projection. 157 | 158 | 3. NBO input file. 'NBO.out' 159 | This file contains information, in a readable format, necessary for the periodic 160 | NBO code of JRS and BDD. 161 | The header of the file contains information on the basis set as well as atoms of 162 | the system. 163 | It also contains the k-points utilized in the VASP calculation (where the 164 | projection has been performed) as well as the indices of the real space unit 165 | cells that will be used in the NBO computation. This set of unit cells is only 166 | those which are nearset neighbors to the central unit cell. 167 | The actual matrices are stored in 'NBO_mat.out'. For each k-point there is an 168 | overlap, density and fock matrix (two density and fock for spin polarized 169 | calculations). This file is unformatted for memory considerations as well as 170 | efficient input/output. The file name of the matrix storage is placed at the end 171 | of 'NBO.out' and read from there by the NBO code, so it will have to be changed 172 | if the file name is changed. 173 | 174 | A few steps in the algorithm parallelized using Open MP. 175 | Some of the default environmental variables related to this are not optimal and 176 | should be changed: 177 | 178 | 1. OMP_NUM_THREADS controls how many threads are parallelized over. If this is not 179 | set, the code will try to use as many as possible. This should be set to how 180 | many processors are actually available. Not a functionality concern, just 181 | courteous. 182 | 183 | 2. OMP_STACKSIZE controls the amount of memory given to each thread of 184 | parallelization. The default is way too low. If this is too low, the code will 185 | crash and simply display 'Segmentaion fault.' I have found that setting this to 186 | 800mb is sufficient for even surface supercells. 187 | 188 | 189 | ************************************* 190 | ************************************* 191 | ************Output Files************* 192 | ************************************* 193 | ************************************* 194 | 195 | 196 | The projection code outputs a couple of additional files. 197 | 198 | 1. 'spillover.out' Contains quantitative information on the quality of the 199 | projection. SPILLOVER is defined as in Eq 10 of the periodic NBO paper. For 200 | norm-conserving pseudopotentials, this value is rigorously bound by 0 and 1. 201 | However, for PAW-type pseudopotentials, approximations are made in calculating 202 | atomic orbital-augmenter overlap and this constraint is lifted. As a result the 203 | spillover sum includes both positive and negative terms. To account for this we 204 | have defined the SPREAD parameter, which is defined the same as spillover, 205 | except using the absolute value for all terms within the summation. 206 | Both spillover and spread are calculated across all bands, as well as only 207 | those that are occupied, and therefore contribute to the density matrix. 208 | Additionally, NO norm should be above 1.01 and a tally of occupied bands who 209 | breach this limit is included in this file. 210 | 211 | Additionally, atomic weighted spread and spillover are provided based on 212 | occupied bands. These are calculated similarly to Eq 10, except there is now a 213 | weighting (and normalization factor) calculated as the sum of the squares of 214 | the coefficients in the projected band of all basis functions centered on a 215 | particular atom. 216 | 217 | Finally is a listing of the occupied band that the AO basis does the worst job 218 | in representing, gauged by the spread of that band, for each k-point. These 219 | give an upward bound on the error incurred using a projection 220 | 221 | 222 | 2. 'band_spillover.out' This contains the norm of each projected band, for each 223 | spin at each k-point. This just gives a more detailed picture of the 224 | information summarized in the spillover.out file. 225 | 226 | The program also outputs information to the screen. 227 | This mainly consists of system information from the VASP wavefunction file. 228 | Additionally after the projection the density and fock matrices (in the projected 229 | matrices) are checked by calculating the associated observable, number of electrons 230 | and sum of orbital eigenvalues respectively. These are also calculated from the VASP 231 | input at the beginning of the calculation. 232 | 233 | 234 | ************************************* 235 | ************************************* 236 | *********Sample Calculations********* 237 | ************************************* 238 | ************************************* 239 | 240 | 241 | Included are three sample systems to run; bulk silicon, magnesium oxide, and nickel. 242 | 243 | First I have included a script to run the projection program. 244 | Note that two environmental parameters related to Open_MP paralllelization have been 245 | set. Both should be set when running the code, especially OMP_STACKSIZE which 246 | controls the memory for each thread included. The default is low and even if only 247 | one processor is used, the code can crash here. 248 | If the code crashes and just prints 'Segmentation fault.' this is the problem. 249 | I have found that export OMP_STACKSIZE=800mb is sufficient for most systems. 250 | 251 | For each system, I have included 3 of the 4 VASP input files. 252 | There are also AO basis sets included for each system. 253 | 254 | Si: Standard 3-21G(d) basis set 255 | 256 | MgO: 6-311G(d) basis set with outermost valence functions removed. 257 | Linear dependencies arise very easily in periodic systems and any basis 258 | function with an exponent below 0.1 bohr^-2 is probably going to cause problem. 259 | While the projection code is enabled to deal with these linear dependencies, 260 | NBO is not. In general, diffuse AO-functions should always be avoided for 261 | periodic systems. 262 | 263 | Ni: Modified 6-31G basis set. Details of the modification process can be found 264 | in the supporting information of: Journal of Catalysis, 324, 50-58, (2015). 265 | The overall strategy is to modulate the sp-functions' exponent to limit linear 266 | dependencies, then modify the d-function's exponent to account for the bulk 267 | environment. For main group or molecular solids, gas-phase basis sets can often 268 | be applied (perhaps requiring trimming). However, bulk transition metals are 269 | not represented as well with gas-phase basis sets and requie more involved basis 270 | set development. 271 | 272 | One final note about basis sets: 273 | It should be noted that even though the VASP results only explicitly include valence 274 | electrons, the core basis functions remain in all sets. These functions help in 275 | capturing the PAW effect's on the orbitals. The core region of the valence orbitals 276 | is oscillatory and can in general not be well represented by only the smoothly 277 | varying valence like AO-basis functions. 278 | -------------------------------------------------------------------------------- /projection_VASP/VASP_patch/proj_VASP_4.patch: -------------------------------------------------------------------------------- 1 | --- ../../../untainted/vasp.4.6/main.F 2013-10-02 13:44:36.000000000 -0500 2 | +++ main.F 2015-02-24 15:01:19.000000000 -0600 3 | @@ -142,6 +142,7 @@ 4 | !-MM- Added to write AE charge densities 5 | USE aedens 6 | !-MM_ end of additions 7 | + USE projection_output !Added by BDD for projection analysis 8 | IMPLICIT COMPLEX(q) (C) 9 | IMPLICIT REAL(q) (A-B,D-H,O-Z) 10 | 11 | @@ -304,6 +305,11 @@ 12 | CHARACTER (LEN=5) IDENTIFY 13 | !-----parameters for sphpro.f 14 | INTEGER :: LDIMP,LMDIMP,LTRUNC=3 15 | + 16 | +!Added by BDD 17 | +!-----Logical to be read in for performing output of pw's for projection 18 | + LOGICAL LNBO 19 | + 20 | !======================================================================= 21 | ! All COMMON blocks 22 | !======================================================================= 23 | @@ -3774,6 +3780,22 @@ 24 | ENDIF 25 | 26 | ENDIF wrtwave 27 | + 28 | + 29 | + !Added by BDD for customized output 30 | + wrtnbo: IF ( INFO%LSTOP ) THEN 31 | + 32 | + !First, test if the flag has been given in the INCAR for output 33 | + LNBO = .FALSE. 34 | + CALL RDATAB(IO%LOPEN,'INCAR',IO%IU5,'LNBO','=','#',';','L', & 35 | + & IDUM,RDUM,CDUM,LNBO,CHARAC,N,1,IERR) 36 | + !Then call the subroutine 37 | + IF ( LNBO )CALL output_NBO(WDES,W,LATT_INI,T_INFO,P,CQIJ) 38 | + 39 | + ENDIF wrtnbo 40 | + 41 | + 42 | + 43 | !======================================================================= 44 | ! next electronic energy minimisation 45 | CALL VTIME(TVPUL,TCPUL) 46 | -------------------------------------------------------------------------------- /projection_VASP/VASP_patch/proj_VASP_5.3.patch: -------------------------------------------------------------------------------- 1 | diff -u vasp.5.3/main.F test/main.F 2 | --- vasp.5.3/main.F 2014-03-31 08:35:09.000000000 -0500 3 | +++ test/main.F 2015-07-22 12:13:03.000000000 -0500 4 | @@ -169,6 +169,8 @@ 5 | USE lcao 6 | USE wnpr 7 | 8 | + USE projection_output 9 | + 10 | IMPLICIT COMPLEX(q) (C) 11 | IMPLICIT REAL(q) (A-B,D-H,O-Z) 12 | 13 | @@ -323,6 +325,11 @@ 14 | CHARACTER (LEN=5) IDENTIFY 15 | !-----parameters for sphpro.f 16 | INTEGER :: LDIMP,LMDIMP,LTRUNC=3 17 | + 18 | +!Added by BDD 19 | +!-----Logical to be read in for performing output of pw's for projection 20 | + LOGICAL LNBO 21 | + 22 | !======================================================================= 23 | ! All COMMON blocks 24 | !======================================================================= 25 | @@ -4148,6 +4155,22 @@ 26 | CALL REDIS_PW_OVER_BANDS(WDES, W) 27 | ENDIF 28 | ENDIF wrtwave 29 | + 30 | + 31 | + !Added by BDD for customized output 32 | + wrtnbo: IF ( INFO%LSTOP ) THEN 33 | + 34 | + !First, test if the flag has been given in the INCAR for output 35 | + LNBO = .FALSE. 36 | + CALL RDATAB(IO%LOPEN,'INCAR',IO%IU5,'LNBO','=','#',';','L', & 37 | + & IDUM,RDUM,CDUM,LNBO,CHARAC,N,1,IERR) 38 | + !Then call the subroutine 39 | + IF ( LNBO )CALL output_NBO(WDES,W,LATT_INI,T_INFO,P,CQIJ) 40 | + 41 | + ENDIF wrtnbo 42 | + 43 | + 44 | + 45 | !======================================================================= 46 | ! next electronic energy minimisation 47 | CALL STOP_TIMING("LOOP+",IO%IU6,XMLTAG='totalsc') 48 | -------------------------------------------------------------------------------- /projection_VASP/VASP_patch/proj_VASP_5.4.patch: -------------------------------------------------------------------------------- 1 | diff -ruN src/.objects ../nbo/src/.objects 2 | --- src/.objects 2017-04-20 17:04:05.000000000 +0800 3 | +++ ../nbo/src/.objects 2019-04-10 19:39:51.000000000 +0800 4 | @@ -175,6 +175,7 @@ 5 | dmft.o \ 6 | auger.o \ 7 | dmatrix.o \ 8 | + projection_output.o \ 9 | elphon.o 10 | 11 | SOURCE_O1 = \ 12 | @@ -374,4 +375,5 @@ 13 | dmft.o \ 14 | auger.o \ 15 | dmatrix.o \ 16 | + projection_output.o \ 17 | elphon.o 18 | diff -ruN src/main.F ../nbo/src/main.F 19 | --- src/main.F 2017-04-20 17:03:58.000000000 +0800 20 | +++ ../nbo/src/main.F 2019-04-10 19:39:11.000000000 +0800 21 | @@ -184,6 +184,8 @@ 22 | USE cuda_interface 23 | USE main_gpu 24 | #endif 25 | + USE projection_output 26 | + 27 | IMPLICIT COMPLEX(q) (C) 28 | IMPLICIT REAL(q) (A-B,D-H,O-Z) 29 | 30 | @@ -350,6 +352,9 @@ 31 | CHARACTER (LEN=5) IDENTIFY 32 | !-----parameters for sphpro.f 33 | INTEGER :: LDIMP,LMDIMP,LTRUNC=3 34 | +!Added by BDD 35 | +!-----Logical to be read in for performing output of pw's for projection 36 | + LOGICAL LNBO 37 | !======================================================================= 38 | ! All COMMON blocks 39 | !======================================================================= 40 | @@ -4185,6 +4190,17 @@ 41 | CALL REDIS_PW_OVER_BANDS(WDES, W) 42 | ENDIF 43 | ENDIF wrtwave 44 | + !Added by BDD for customized output 45 | + wrtnbo: IF ( INFO%LSTOP ) THEN 46 | + 47 | + !First, test if the flag has been given in the INCAR for output 48 | + LNBO = .FALSE. 49 | + CALL RDATAB(IO%LOPEN,'INCAR',IO%IU5,'LNBO','=','#',';','L', & 50 | + & IDUM,RDUM,CDUM,LNBO,CHARAC,N,1,IERR) 51 | + !Then call the subroutine 52 | + IF ( LNBO )CALL output_NBO(WDES,W,LATT_INI,T_INFO,P,CQIJ) 53 | + 54 | + ENDIF wrtnbo 55 | 56 | !elphon_ 57 | IF (ELPH_LWSWQ()) CALL ELPH_OVERLAP_W_WP(W,LATT_CUR,LMDIM,CQIJ,NONLR_S,NONL_S,IO) 58 | -------------------------------------------------------------------------------- /projection_VASP/VASP_patch/projection_output.F: -------------------------------------------------------------------------------- 1 | #include "symbol.inc" 2 | 3 | 4 | MODULE projection_output 5 | 6 | CONTAINS 7 | 8 | 9 | 10 | !This subroutine was written by JRS and BDD to print information from VASP to a standardized format 11 | !This is intended to be used with the projection algortihm described in: JCTC 2012, 8, 1902-1911. 12 | !The information is output to an unformatted file called wavefunction.dat 13 | !As written, this is not compatible with VASP runs that do not use the default value for NPAR 14 | 15 | SUBROUTINE output_NBO(WDES,W,LATT_INI,T_INFO,P,CQIJ) 16 | 17 | USE prec 18 | USE wave 19 | USE lattice 20 | USE poscar 21 | USE pseudo 22 | IMPLICIT REAL(q) (A-H,O-Z) 23 | 24 | TYPE (latt) LATT_INI 25 | TYPE (wavedes) WDES 26 | TYPE (wavedes1) WDES1 27 | TYPE (wavespin) W 28 | TYPE (type_info) T_INFO 29 | TYPE (potcar) P(WDES%NTYP) 30 | OVERLAP :: CQIJ(:,:,:,:) 31 | ! local work arrays 32 | COMPLEX(q),ALLOCATABLE :: CW(:),EIG(:) 33 | #ifdef WAVECAR_double 34 | COMPLEX(q), ALLOCATABLE :: CRD(:) 35 | #else 36 | COMPLEX(qs), ALLOCATABLE :: CRD(:) 37 | #endif 38 | GDEF,ALLOCATABLE :: CPROJ(:),CPROJ_LOC(:) 39 | 40 | NPL_TOT = MAXVAL(WDES%NPLWKP_TOT) 41 | NPRO_TOT=WDES%NPRO_TOT 42 | ALLOCATE(CW(NPL_TOT),CRD(NPL_TOT),EIG(WDES%NB_TOT),CPROJ(WDES%NPRO_TOT),CPROJ_LOC(WDES%NPRO_TOT)) 43 | 44 | NODE_ME=0 45 | IONODE=0 46 | #ifdef MPI 47 | NODE_ME=WDES%COMM%NODE_ME 48 | IONODE =WDES%COMM%IONODE 49 | #endif 50 | 51 | io_begin 52 | OPEN(99,FILE='wavefunction.dat',FORM='UNFORMATTED',STATUS='UNKNOWN') 53 | 54 | WRITE(6,*)'Writing out the wavefunction.dat file' 55 | 56 | !First write out some information about the system in general (number of ion, number of ion types, and type of each ion) 57 | !Also the POSTION of each ion 58 | !WRITE(99) WDES%NIONS, WDES%NTYP 59 | WRITE(99) T_INFO%NIONS, T_INFO%NTYP 60 | WRITE(99) T_INFO%ITYP 61 | WRITE(99) T_INFO%POSION 62 | 63 | !Write out the number of k points, number of bands, energy cutoff of basis set, number of planewaves and projectors, number of spins 64 | WRITE(99) WDES%NKPTS, WDES%NB_TOT, WDES%ENMAX, NPL_TOT, NPRO_TOT, WDES%ISPIN 65 | WRITE(99) ((LATT_INI%A(I,J),I=1,3),J=1,3) 66 | io_end 67 | 68 | !Write out information about each k-point that is spin independent 69 | !For each k point, write out the number of plane wave coefficients, the k-vector, and the symmetry weight 70 | !Also write out the index of each PW component for each k point (i.e. corresponding g vector written as a 71 | !linear combination of the reciprical lattice vectors, e.g. g=(igx*kx+igy*ky+igz*kz)+(vkptx*kx+vkpty*ky+vkptz*kz)) 72 | DO K=1,WDES%NKPTS 73 | CALL SETWDES(WDES,WDES1,K) 74 | io_begin 75 | NPL=WDES%NPLWKP_TOT(K) 76 | WRITE(99) NPL, WDES%VKPT(1:3,K),WDES%WTKPT(K) 77 | WRITE(99) (WDES%IGX(J,K),WDES%IGY(J,K),WDES%IGZ(J,K),J=1,NPL) 78 | io_end 79 | ENDDO 80 | 81 | 82 | !For each k point, write out the eigenvalues & occupations (for each band) 83 | DO ISP=1,WDES%ISPIN 84 | DO K=1,WDES%NKPTS 85 | CALL SETWDES(WDES,WDES1,K) 86 | io_begin 87 | NPL=WDES%NPLWKP_TOT(K) 88 | WRITE(99) (DBLE(REAL(W%CELTOT(J,K,ISP),KIND=q)),W%FERTOT(J,K,ISP),J=1,WDES%NB_TOT) 89 | io_end 90 | !Then write out the plane wave coefficients for the band 91 | DO J=1,WDES%NB_TOT 92 | CALL MRG_PW_BAND(WDES1, J, CW, W%CW(1,1,K,ISP)) 93 | #ifdef MPI 94 | IND=0 95 | DO NC=1,WDES1%NCOL 96 | DO I=1,WDES1%PL_COL(NC) 97 | CRD(IND+I)=CW(WDES1%PL_INDEX(NC)+I) 98 | ENDDO 99 | IND=IND+WDES1%PL_COL(NC) 100 | ENDDO 101 | #else 102 | CRD(1:NPL)=W%CW(1:NPL,J,K,ISP) 103 | #endif 104 | 105 | ! Write out the pseudo-wavefunction (which is the same as the AE wavefunciton for a norm 106 | ! conserving pseudo-potential) 107 | do_io WRITE(99) (CRD(I),I=1,NPL) 108 | 109 | ! Write out the PAW projected part of the wavefunction 110 | #ifdef MPI 111 | !Get the local storage index for this band, if bands are distributed amongst processors 112 | NB_LOC=NB_LOCAL(J,WDES1) 113 | CPROJ=0.d0 114 | IF (NB_LOC.GT.0) THEN 115 | !If this one band is split amongst several procs, merge the data 116 | CALL MRG_PROJ(WDES1, CPROJ(1), W%CPROJ(1,NB_LOC,K,ISP)) 117 | ENDIF 118 | !Now get the desired projector coefficients for the desired by by summation (all zero but one) 119 | CALLMPI( M_sum_g(WDES1%COMM_INTER,CPROJ, WDES1%NPRO_TOT)) 120 | #else 121 | CPROJ(1:NPRO_TOT)=W%CPROJ(1:NPRO_TOT,NB_LOC,K,ISP) 122 | #endif 123 | 124 | CRD(1:NPRO_TOT)=CPROJ(1:NPRO_TOT) 125 | do_io WRITE(99) (CRD(I),I=1,NPRO_TOT) 126 | 127 | ENDDO 128 | ENDDO 129 | ENDDO 130 | 131 | 132 | 133 | ! Now output the pseudo-potential information for each ion type (this is necessary for PAW to reconstruct that AE wavefunction) 134 | io_begin 135 | DO I=1,T_INFO%NTYP 136 | !Write out the number of l channels, and the max l used for the PAW calculation 137 | !WRITE(99) P(I)%LDIM, P(I)%LMAX_CALC 138 | WRITE(99) P(I)%LMAX, P(I)%LMAX_CALC 139 | !Write out their associated l quantum numbers 140 | WRITE(99) P(I)%LPS 141 | !Write out information about the valence of the original atoma s well as the pseudopotential 142 | WRITE(99) P(I)%ZVALF, P(I)%ZVALF_ORIG 143 | !Write out the radial grid information, number of points and r values, and integration weights 144 | WRITE(99) P(I)%R%NMAX 145 | WRITE(99) P(I)%R%R 146 | WRITE(99) P(I)%R%SI 147 | !Write out the (valence) all-electron and pseudo wavefunctions on the r grid 148 | WRITE(99) P(I)%WAE 149 | WRITE(99) P(I)%WPS 150 | ENDDO 151 | 152 | CLOSE(99) 153 | io_end 154 | 155 | DEALLOCATE(CW,CRD,EIG) 156 | 157 | RETURN 158 | END SUBROUTINE 159 | 160 | 161 | END MODULE 162 | -------------------------------------------------------------------------------- /projection_VASP/bloch_overlap.mod: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Chengcheng-Xiao/Periodic_NBO/fc14e3069bb9fa755194d6f655a3352a3802c4c8/projection_VASP/bloch_overlap.mod -------------------------------------------------------------------------------- /projection_VASP/paw.mod: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Chengcheng-Xiao/Periodic_NBO/fc14e3069bb9fa755194d6f655a3352a3802c4c8/projection_VASP/paw.mod -------------------------------------------------------------------------------- /projection_VASP/projection_main.f90: -------------------------------------------------------------------------------- 1 | PROGRAM projection_main 2 | USE rd_wavefunction 3 | USE projection_shared 4 | USE rd_basis 5 | USE bloch_overlap 6 | USE PAW 7 | USE blas95 8 | IMPLICIT NONE 9 | 10 | CHARACTER(128) :: basis_fn, VASP_fn, NBO_fn 11 | CHARACTER(64) :: mat_fn 12 | 13 | TYPE(AO_function), ALLOCATABLE :: AO_basis(:) 14 | 15 | INTEGER, ALLOCATABLE :: index_l(:,:) !For each l_vector gives the number of unitcells displaces in each direction for the l vector 16 | 17 | COMPLEX*16,ALLOCATABLE :: PAW_overlap(:,:,:) 18 | COMPLEX*16,ALLOCATABLE :: bloch_band_coeff(:,:,:,:) 19 | !COMPLEX*16,ALLOCATABLE :: AO_PW_overlap(:,:,:) 20 | COMPLEX*16,ALLOCATABLE :: AO_PW_overlap(:,:) 21 | COMPLEX*16 :: gdotrnu 22 | !COMPLEX*16,ALLOCATABLE :: proj_matrix(:,:,:) 23 | COMPLEX*16,ALLOCATABLE :: proj_matrix(:,:,:,:) 24 | 25 | 26 | COMPLEX*16,ALLOCATABLE :: proj_overlap(:,:,:,:) 27 | 28 | !COMPLEX*16,ALLOCATABLE :: bloch_density(:,:,:),bloch_fock(:,:,:) 29 | 30 | COMPLEX*16,ALLOCATABLE :: fock_dummy(:,:),coeff_dummy(:,:) 31 | 32 | COMPLEX*16,ALLOCATABLE :: n_elec_dummy(:,:) 33 | COMPLEX*16 :: num_elec,energy_sum 34 | 35 | INTEGER :: nu,ik,ig,iband,ispin 36 | !REAL*8, PARAMETER :: pi=3.141592653589793238462d0 37 | !COMPLEX*16, PARAMETER :: sqrt_neg_one=(0.d0,1.d0) 38 | 39 | REAL*8 :: ti,tf,t1,t2 40 | 41 | CALL CPU_TIME(ti) 42 | 43 | !Start by getting the names of the files to use as input (basis and wavefunction) and output (NBO) 44 | !If no filenames are supplied the generics will be used instead 45 | IF( IARGC() .LT. 1 )THEN 46 | basis_fn = 'basis.inp' 47 | ELSE 48 | CALL GETARG(1, basis_fn) 49 | ENDIF 50 | IF( IARGC() .LT. 2 )THEN 51 | VASP_fn = 'wavefunction.dat' 52 | ELSE 53 | CALL GETARG(2, VASP_fn) 54 | ENDIF 55 | IF( IARGC() .LT. 3 )THEN 56 | NBO_fn = 'NBO.out' 57 | ELSE 58 | CALL GETARG(3, NBO_fn) 59 | ENDIF 60 | 61 | mat_fn = 'NBO_mat.out' 62 | 63 | WRITE(6,'(2A)')' Input file for AO basis ',basis_fn 64 | WRITE(6,'(2A)')' Input file for PW calc ',VASP_fn 65 | WRITE(6,'(2A)')' Output file for NBO ',NBO_fn 66 | WRITE(6,'(2A)')' Matrix file for NBO ',mat_fn 67 | WRITE(6,*) 68 | 69 | !Read in information about the underlying PW calculation 70 | CALL read_vasp_wavefunction(VASP_fn) 71 | 72 | !Read in input file for atomic orbital basis set 73 | CALL read_basis(basis_fn,AO_basis) 74 | !This subroutine has been made obsolete by a change to the data output to NBO.out 75 | !Basically all the unique data contained in here is now passed to the nbo program, 76 | !That program then generates a single file which can be read in by an auxillary fortran code to produce cube files. 77 | !!!Then output information on all basis functions in a readable format for a visualization program. 78 | !!!CALL basis_set_info_out(AO_basis) 79 | 80 | WRITE(6,*)'****************************************' 81 | WRITE(6,*)'*** Beginning Projection Calculation ***' 82 | WRITE(6,*)'****************************************' 83 | WRITE(6,*) 84 | 85 | !Calcualtes the overlap matrix inverse at each k-point, which is required for the projector operator. 86 | CALL bloch_space_overlap(AO_basis,index_l) 87 | 88 | ! !Now ready to perform actual projection. 89 | ! CALL CPU_TIME(t1) 90 | 91 | !If the PW calculation used PAW pseudopotentials, their contribution to the projection (Bloch-space overlap with AO basis) must be calculated 92 | !PAW_pseudo = .FALSE. 93 | IF( PAW_pseudo ) CALL PAW_proj_setup(AO_basis,index_l,PAW_overlap) 94 | 95 | !ALLOCATE(bloch_band_coeff(s_dim,nbands,nkpts,nspins),proj_matrix(s_dim,nbands,nkpts),AO_PW_overlap(s_dim,nplmax,nkpts)) 96 | ALLOCATE(bloch_band_coeff(s_dim,nbands,nkpts,nspins),proj_matrix(s_dim,nbands,nkpts,nspins),AO_PW_overlap(nplmax,nkpts)) 97 | AO_PW_overlap=0.d0 98 | 99 | !Now the k-point dependent projections will be done. 100 | !For each kpt the projection is done independently 101 | !WRITE(6,*)'Beginning of projections for each k-point' 102 | 103 | !Now ready to perform actual projection. 104 | !CALL CPU_TIME(t1) 105 | 106 | 107 | !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(ik,nu,ig,ispin,gdotrnu) 108 | !!!!!SHARED(nkpts,s_dim,npl,nspins,AO_basis,gk,AO_PW_overlap,PAW_overlap,pw_coeff,PAW_coeff,proj_matrix,bloch_s_inv,bloch_band_coeff,PAW_pseudo) 109 | !$OMP DO SCHEDULE(STATIC) 110 | DO ik=1,nkpts 111 | 112 | !WRITE(6,*)'kpt',ik,npl(ik) 113 | 114 | !!!!!!!!!!!! 115 | !!!!NOTE!!!! 116 | !!!!!!!!!!!! 117 | !I previously calculated the AO_PW overlap for all basis function in the top loop, 118 | !this was then passed to the bottom loop, where matrix multiplication was to treat all AOs at the same time. 119 | !This was faster, but had huge memore requirements. 120 | !That array also had a k-point dimension, for parallelization, which only made things worse 121 | !Switching to one AO function at a time treated via matrix-vector multiplication is a bit slower but requires an order of magnitude lower memory requirements. 122 | ! 123 | !I think a happy middle ground could be reached by treating blocks of AO's using matrix mulitplication 124 | !The blocks could be the number of bands, so that only the amount of memory used for the plane wave coefficients would be needed. 125 | !Then a few large matrix multiplications would be needed, instead of the many vector-matrix multiplications I am currently doing. 126 | !For another day 127 | ! 128 | 129 | DO nu=1,s_dim 130 | !First the overlap of each nu basis function with each planewave must be calculated 131 | !WRITE(6,*)nu 132 | DO ig=1,npl(ik) 133 | !WRITE(6,*)ig 134 | !CALL nu_g_overlap(AO_basis(nu),gk(:,ig,ik),AO_PW_overlap(nu,ig,ik)) !Overlap of AO with PW 135 | !gdotrnu = EXP(sqrt_neg_one*DOT_PRODUCT(gk(:,ig,ik),AO_basis(nu)%pos)) !Phase factor accounting for AO's position off the origin 136 | !AO_PW_overlap(nu,ig,ik) = AO_PW_overlap(nu,ig,ik) * gdotrnu 137 | !!WRITE(6,*)AO_PW_overlap(nu,ig,ik) 138 | 139 | CALL nu_g_overlap(AO_basis(nu),gk(:,ig,ik),AO_PW_overlap(ig,ik)) !Overlap of AO with PW 140 | gdotrnu = EXP(sqrt_neg_one*DOT_PRODUCT(gk(:,ig,ik),AO_basis(nu)%pos)) !Phase factor accounting for AO's position off the origin 141 | AO_PW_overlap(ig,ik) = AO_PW_overlap(ig,ik) * gdotrnu 142 | !WRITE(6,*)AO_PW_overlap(ig,ik) 143 | ENDDO !End loop over plane wave basis 144 | 145 | !Then for each basis function, nu, the contribution of the planewaves is calculated for all bands at one using vector-matrix multiplication 146 | DO ispin=1,nspins 147 | !each computation is SUM(nu) S-1{mu,nu} * (SUM(g) *c(a,g)) 148 | CALL GEMV(pw_coeff(:,:,ik,ispin),AO_PW_overlap(:,ik),proj_matrix(nu,:,ik,ispin),(1.d0,0.d0),(0.d0,0.d0),'T') 149 | ENDDO 150 | ENDDO 151 | 152 | DO ispin=1,nspins 153 | ! !Calculation of planewave contributions to band coeff's are done at once using matrix multiplication 154 | ! !each computation is SUM(nu) S-1{mu,nu} * (SUM(g) *c(a,g)) 155 | ! CALL GEMM(AO_PW_overlap(:,:,ik),pw_coeff(:,:,ik,ispin),proj_matrix(:,:,ik),'N','N',(1.d0,0.d0),(0.d0,0.d0)) 156 | ! 157 | ! !Since band is simply summation of PW AND PAW, PAW contirbution is simply added to PW's 158 | ! IF( PAW_pseudo ) CALL GEMM(PAW_overlap(:,:,ik),PAW_coeff(:,:,ik,ispin),proj_matrix(:,:,ik),'N','N',(1.d0,0.d0),(1.d0,0.d0)) 159 | ! 160 | ! !Band overlaps are finally multiplied by inverse of overlap matrix to complete projection 161 | ! !The use of the inverse of the overlap matrix is necessary due to the non-orthogonality of the AO-basis 162 | ! CALL GEMM(bloch_s_inv(:,:,ik),proj_matrix(:,:,ik),bloch_band_coeff(:,:,ik,ispin),'N','N',(1.d0,0.d0),(0.d0,0.d0)) 163 | 164 | !Since band is simply summation of PW AND PAW, PAW contirbution is simply added to PW's 165 | IF( PAW_pseudo ) CALL GEMM(PAW_overlap(:,:,ik),PAW_coeff(:,:,ik,ispin),proj_matrix(:,:,ik,ispin),'N','N',(1.d0,0.d0),(1.d0,0.d0)) 166 | 167 | !Band overlaps are finally multiplied by inverse of overlap matrix to complete projection 168 | !The use of the inverse of the overlap matrix is necessary due to the non-orthogonality of the AO-basis 169 | CALL GEMM(bloch_s_inv(:,:,ik),proj_matrix(:,:,ik,ispin),bloch_band_coeff(:,:,ik,ispin),'N','N',(1.d0,0.d0),(0.d0,0.d0)) 170 | 171 | ENDDO 172 | 173 | ENDDO 174 | !$OMP END DO NOWAIT 175 | !$OMP END PARALLEL 176 | 177 | 178 | DEALLOCATE(proj_matrix,AO_PW_overlap) 179 | DEALLOCATE(pw_coeff) 180 | DEALLOCATE(bloch_s_inv) 181 | !PAUSE 182 | 183 | 184 | !CALL CPU_TIME(t2) 185 | !WRITE(6,*)'Completed projection',SNGL(t2-t1) 186 | !WRITE(6,*) 187 | 188 | 189 | !Calculate ovelrap matrices for projected bands and use these to quantify completeness of projection. 190 | CALL calc_spillover(proj_overlap,bloch_band_coeff) 191 | 192 | !Calculate density and fock matrices in projected AO basis 193 | ALLOCATE(coeff_dummy(s_dim,nbands),fock_dummy(nbands,s_dim)) 194 | ALLOCATE(bloch_density(s_dim,s_dim,nkpts,nspins),bloch_fock(s_dim,s_dim,nkpts,nspins)) 195 | DO ispin=1,nspins 196 | DO ik=1,nkpts 197 | !Start by orthogonalizeing the bands in the AO basis, using an Occupnacy Weighted Symmetric Orthogonalization 198 | !Even though the PW bands are orthogonal, since the projections are not exact the projected bands lose this quality 199 | !This orthogonality greatly eases the calculation of both density and Fock matrices 200 | !Occupancy weighted symmetric orthogonaliztion is used, since it maximally maintains the character of the projected bands 201 | !Sacrificing the character of unoccupied bands is OKAY for us, since they do not affect the density matrix. 202 | CALL do_OWSO(proj_overlap(:,:,ik,ispin),weight(:,ik,ispin),bloch_band_coeff(:,:,ik,ispin)) 203 | 204 | !DENSITY MATRIX 205 | ! P{mu,nu} = occ{iband} * band_coeff{mu,iband} * CONJG(band_coeff{nu,iband}) 206 | !First scale the band coeff's by the weight of that band. 207 | DO iband=1,nbands 208 | coeff_dummy(:,iband) = bloch_band_coeff(:,iband,ik,ispin) * weight(iband,ik,ispin) 209 | ENDDO 210 | !Matrix muliplication is used to calculate the density matrix 211 | CALL GEMM(coeff_dummy,bloch_band_coeff(:,:,ik,ispin),bloch_density(:,:,ik,ispin),'N','C',(1.d0,0.d0),(0.d0,0.d0)) 212 | 213 | !FOCK MATRIX 214 | !Matrix multiplication is used to convert the Fock matrix into the projected basis 215 | ! F{mu,nu} = SUM(fock_coeff{nu,iband}*F{iband,iband}*CONJG(fock_coeff{nu,iband})) 216 | !First the nonorthogonality of the bloch orbtials must be addressed since the MO->AO transform is not unitary 217 | !coeff's must be multiplied by Overlap matrix 218 | CALL GEMM(bloch_s_mat(:,:,ik),bloch_band_coeff(:,:,ik,ispin),coeff_dummy,'N','N',(1.d0,0.d0),(0.d0,0.d0)) 219 | !Then the trnsformation is simply a unitary transform using the new coefficients 220 | DO iband=1,nbands 221 | fock_dummy(iband,:) = eig(iband,ik,ispin)*CONJG(coeff_dummy(:,iband)) 222 | ENDDO 223 | CALL GEMM(coeff_dummy,fock_dummy,bloch_fock(:,:,ik,ispin),'N','N',(1.d0,0.d0),(0.d0,0.d0)) 224 | ENDDO 225 | ENDDO 226 | 227 | 228 | !Now we can check the projection by comparing observables. 229 | !For the density matrix we will calculate the corersponding number of electrons 230 | !For the Fock matrix the sum of the energies of the occupied states is calculated 231 | !These should match the original values from the PW results 232 | !Q = Trace[P * ADJ(S)] 233 | ALLOCATE(n_elec_dummy(s_dim,s_dim)) 234 | num_elec = 0.d0 235 | energy_sum = 0.d0 236 | DO ispin=1,nspins 237 | DO ik=1,nkpts 238 | CALL GEMM(bloch_density(:,:,ik,ispin),bloch_s_mat(:,:,ik),n_elec_dummy,'N','N',(1.d0,0.d0),(0.d0,0.d0)) 239 | n_elec_dummy = n_elec_dummy*kpt_wt(ik) 240 | DO nu=1,s_dim 241 | num_elec = num_elec + n_elec_dummy(nu,nu) 242 | ENDDO 243 | CALL GEMM(bloch_density(:,:,ik,ispin),bloch_fock(:,:,ik,ispin),n_elec_dummy,'N','N',(1.d0,0.d0),(0.d0,0.d0)) 244 | n_elec_dummy = n_elec_dummy*kpt_wt(ik) 245 | DO nu=1,s_dim 246 | energy_sum = energy_sum + n_elec_dummy(nu,nu) 247 | ENDDO 248 | ENDDO 249 | ENDDO 250 | 251 | WRITE(6,*)'Testing of projected density and Fock matrices' 252 | WRITE(6,*)'Bloch-space energy sum ',energy_sum*DBLE(3-nspins) 253 | WRITE(6,*)'Bloch-space valence electrons ',num_elec*DBLE(3-nspins) 254 | WRITE(6,*) 255 | 256 | CALL CPU_TIME(t1) 257 | !WRITE(6,*)'Time for density and Fock matrices',SNGL(t1-t2) 258 | !WRITE(6,*) 259 | 260 | !Write out all information needed for NBO analysis 261 | !Formatting is specifc to NBO code of JRS and BDD 262 | CALL write_NBO_output(NBO_fn,mat_fn,AO_basis,index_l) 263 | 264 | 265 | CALL CPU_TIME(tf) 266 | WRITE(6,*)'Total processor time for projection program',SNGL(tf-ti) 267 | 268 | CONTAINS 269 | 270 | 271 | !This subrotuine computes the overlap matrices of the projected bands in the AO basis. 272 | !This information is also used to calculate the spillover (quantify how much of band density is lost in projection 273 | SUBROUTINE calc_spillover(r_mat,band_coeff) 274 | USE blas95 275 | USE rd_wavefunction 276 | USE projection_shared 277 | IMPLICIT NONE 278 | 279 | COMPLEX*16,ALLOCATABLE,INTENT(OUT) :: r_mat(:,:,:,:) !This will contain the band overlap matrices on exit from the program. 280 | COMPLEX*16,DIMENSION(:,:,:,:),INTENT(IN) :: band_coeff !This contains the coefficient of each band in the AO-basis at each k-point 281 | 282 | COMPLEX*16,DIMENSION(s_dim,nbands) :: r_mat_dummy !Used for BLAS subroutines 283 | REAL*8,DIMENSION(nspins) :: spillover 284 | REAL*8,DIMENSION(nspins) :: spread 285 | COMPLEX*16 :: chi_overlap 286 | REAL*8 :: ind_spill 287 | INTEGER,DIMENSION(nspins) :: norm_tally 288 | 289 | REAL*8,DIMENSION(nspins) :: band_spillover 290 | REAL*8,DIMENSION(nspins) :: weight_spillover,weight_spread 291 | REAL*8,DIMENSION(nspins) :: band_weight_spillover,band_weight_spread 292 | INTEGER,DIMENSION(nspins) :: weight_count 293 | INTEGER,DIMENSION(nspins) :: tot_weight 294 | 295 | REAL*8,DIMENSION(nkpts,2) :: max_spread 296 | REAL*8 :: coeff_sum 297 | 298 | REAL*8,DIMENSION(n_atom,nspins) :: atom_spillover,atom_spread,atom_norm 299 | REAL*8,DIMENSION(n_atom) :: atom_sum 300 | INTEGER :: iatom 301 | 302 | INTEGER :: ik,j,iband,ispin 303 | 304 | !All spillover analysis is writen out to this 305 | OPEN(7,file='band_spillover.out') 306 | spillover = 0.d0 307 | spread = 0.d0 308 | weight_spread = 0.d0 309 | weight_spillover = 0.d0 310 | tot_weight = 0 311 | 312 | norm_tally = 0 313 | max_spread = 0 314 | 315 | atom_spillover = 0.d0 316 | atom_spread = 0.d0 317 | atom_norm = 0 318 | 319 | !CO_count = 0 320 | !CO_spillover = 0.d0 321 | !CO_spread = 0.d0 322 | !factor_test = 0.d0 323 | 324 | ALLOCATE(r_mat(nbands,nbands,nkpts,nspins)) 325 | r_mat = (0.d0,0.d0) 326 | r_mat_dummy = (0.d0,0.d0) 327 | 328 | 329 | DO ik=1,nkpts 330 | 331 | band_spillover = 0.d0 332 | band_weight_spillover = 0.d0 333 | band_weight_spread = 0.d0 334 | !weight_spillover = 0.d0 335 | weight_count = 0 336 | 337 | !WRITE(6,*)'band coefficients for kpt',ik 338 | !DO iband=1,nbands 339 | ! WRITE(6,*)'coeff for band',iband 340 | ! WRITE(6,*)band_coeff(:,iband,ik,1) 341 | ! WRITE(6,*) 342 | !ENDDO 343 | 344 | DO ispin=1,nspins 345 | 346 | !Overlap of projected bands is computed using matrix mulitplication 347 | !Each overlap is equal to SUM(mu) SUM(nu) c*S{mu,nu}c 348 | CALL GEMM(bloch_s_mat(:,:,ik),band_coeff(:,:,ik,ispin),r_mat_dummy,'N','N',(1.d0,0.d0),(0.d0,0.d0)) 349 | CALL GEMM(band_coeff(:,:,ik,ispin),r_mat_dummy,r_mat(:,:,ik,ispin),'C','N',(1.d0,0.d0),(0.d0,0.d0)) 350 | 351 | 352 | !Then the norm of each band at each k-point is analyzed to make sure the norm is appropriate 353 | !And spillover is calculated for all bands as well as occupied bands at each k-point, and overall (average over k-points) 354 | DO iband=1,nbands 355 | 356 | !IF( weight(iband,ik,ispin) > 1.d-5 )THEN 357 | ! coeff_sum = SUM(CONJG(band_coeff(:,iband,ik,ispin)) * band_coeff(:,iband,ik,ispin)) 358 | ! DO iatom=1,n_atom 359 | ! atom_sum(iatom) = SUM(CONJG(band_coeff(atom_basis(iatom):atom_basis(iatom+1)-1,iband,ik,ispin)) & 360 | ! &* band_coeff(atom_basis(iatom):atom_basis(iatom+1)-1,iband,ik,ispin)) 361 | ! atom_sum(iatom) = atom_sum(iatom) / coeff_sum 362 | ! ENDDO 363 | !ENDIF 364 | 365 | chi_overlap = r_mat(iband,iband,ik,ispin) 366 | ind_spill = 1.d0 - REAL(chi_overlap) 367 | 368 | IF( REAL(chi_overlap) > 1.01d0 .AND. weight(iband,ik,ispin) > 1.d-5 )THEN 369 | WRITE(6,*)'The norm of band',iband,' with spin',ispin,'is larger than 1.01 for kpt',ik, SNGL(REAL(chi_overlap)) 370 | norm_tally(ispin) = norm_tally(ispin) + 1 371 | ENDIF 372 | 373 | WRITE(7,*)'normalization for band',iband,'with spin',ispin,'kpt',ik 374 | WRITE(7,*)SNGL(REAL(chi_overlap)) 375 | WRITE(7,*) 376 | 377 | band_spillover(ispin) = band_spillover(ispin) + ind_spill 378 | spread(ispin) = spread(ispin) + ABS(ind_spill) 379 | IF( weight(iband,ik,ispin) > 1.d-5 )THEN 380 | band_weight_spillover(ispin) = band_weight_spillover(ispin) + ind_spill 381 | band_weight_spread(ispin) = band_weight_spread(ispin) + ABS(ind_spill) 382 | weight_count(ispin) = weight_count(ispin) + 1 383 | IF( ABS(ind_spill) .GT. ABS(max_spread(ik,1)) )THEN 384 | max_spread(ik,1) = ind_spill 385 | max_spread(ik,2) = iband 386 | ENDIF 387 | 388 | !Atomic weighted spread and spillover 389 | coeff_sum = SUM(CONJG(band_coeff(:,iband,ik,ispin)) * band_coeff(:,iband,ik,ispin)) 390 | DO iatom=1,n_atom 391 | !Calculate atomic weighting factor 392 | atom_sum(iatom) = SUM(CONJG(band_coeff(atom_basis(iatom):atom_basis(iatom+1)-1,iband,ik,ispin)) & 393 | &* band_coeff(atom_basis(iatom):atom_basis(iatom+1)-1,iband,ik,ispin)) 394 | atom_sum(iatom) = atom_sum(iatom) / coeff_sum 395 | 396 | !Sum up spill and spread, as well as a normalization factor 397 | atom_spillover(iatom,ispin) = atom_spillover(iatom,ispin) + atom_sum(iatom)*ind_spill 398 | atom_spread(iatom,ispin) = atom_spread(iatom,ispin) + atom_sum(iatom)*ABS(ind_spill) 399 | atom_norm(iatom,ispin) = atom_norm(iatom,ispin) + atom_sum(iatom) 400 | ENDDO 401 | 402 | ENDIF 403 | 404 | ENDDO 405 | spillover(ispin) = spillover(ispin) + band_spillover(ispin) 406 | weight_spillover(ispin) = weight_spillover(ispin) + band_weight_spillover(ispin) !/ DBLE(weight_count(ispin))) 407 | weight_spread(ispin) = weight_spread(ispin) + band_weight_spread(ispin) !/ DBLE(weight_count(ispin))) 408 | tot_weight(ispin) = tot_weight(ispin) + weight_count(ispin) 409 | 410 | WRITE(7,*)'For spin',ispin,'kpt',ik,' spillover is' 411 | WRITE(7,*)SNGL(band_spillover(ispin) / DBLE(nbands)) 412 | WRITE(7,*) 413 | WRITE(7,*)'For spin',ispin,'kpt',ik,'occupied bands',weight_count(ispin),'spillover' 414 | WRITE(7,*)SNGL(band_weight_spillover(ispin) / DBLE(weight_count(ispin))) 415 | WRITE(7,*) 416 | WRITE(7,*) 417 | 418 | ENDDO 419 | 420 | 421 | ENDDO 422 | 423 | spillover = spillover / DBLE(nbands*nkpts) 424 | spread = spread / DBLE(nbands*nkpts) 425 | weight_spillover = weight_spillover / tot_weight 426 | weight_spread = weight_spread / tot_weight 427 | 428 | !!Only total spillover and number of improper norms are written to output stream 429 | !DO ispin=1,nspins 430 | ! DO j=6,7 431 | ! WRITE(j,*)'Total Spillover from projection for spin',ispin 432 | ! WRITE(j,*)SNGL(spillover(ispin)) 433 | ! WRITE(j,*) 434 | ! WRITE(j,*)'Total Spread from projection for spin',ispin 435 | ! WRITE(j,*)SNGL(spread(ispin)) 436 | ! WRITE(j,*) 437 | ! WRITE(j,*)'Total Spillover for occupied bands for spin',ispin 438 | ! WRITE(j,*)SNGL(weight_spillover(ispin)) 439 | ! WRITE(j,*) 440 | ! WRITE(j,*)'Total spread for occupied bands for spin',ispin 441 | ! WRITE(j,*)SNGL(weight_spread(ispin)) 442 | ! WRITE(j,*) 443 | ! WRITE(j,*)'There were',norm_tally(ispin),'improper norms out of',nbands*nkpts 444 | ! WRITE(j,*) 445 | ! ENDDO 446 | !ENDDO 447 | 448 | CLOSE(7) 449 | 450 | 451 | OPEN(65,file='spillover.out') 452 | 453 | WRITE(65,*)' ################################################### ' 454 | WRITE(65,*)' ####### Projection Quality Measurements ####### ' 455 | WRITE(65,*)' ################################################### ' 456 | WRITE(65,*) 457 | 458 | WRITE(65,*)' ### Overall System ### ' 459 | DO ispin=1,nspins 460 | IF( nspins .GT. 1)WRITE(65,*)'For spin type, ',ispin 461 | WRITE(65,*)'Total Spillover' 462 | WRITE(65,*)SNGL(spillover(ispin)) 463 | WRITE(65,*) 464 | WRITE(65,*)'Total Spread' 465 | WRITE(65,*)SNGL(spread(ispin)) 466 | WRITE(65,*) 467 | WRITE(65,*)'Total Spillover for occupied bands' 468 | WRITE(65,*)SNGL(weight_spillover(ispin)) 469 | WRITE(65,*) 470 | WRITE(65,*)'Total Spread for occupied bands' 471 | WRITE(65,*)SNGL(weight_spread(ispin)) 472 | WRITE(65,*) 473 | WRITE(65,'(A,I4,A,I8,A)')' There were',norm_tally(ispin),' improper norms (>1.01) out of',tot_weight,' occupied bands' 474 | WRITE(65,*) 475 | ENDDO 476 | WRITE(65,*) 477 | WRITE(65,*) 478 | 479 | 480 | WRITE(65,*)' ### Atomic Weighted Spillover and Spread ### ' 481 | DO ispin=1,nspins 482 | IF( nspins .GT. 1)WRITE(65,*)'For spin type, ',ispin 483 | WRITE(65,*)'Atom Spillover Spread' 484 | DO iatom=1,n_atom 485 | atom_spillover(iatom,ispin) = atom_spillover(iatom,ispin) / atom_norm(iatom,ispin) 486 | atom_spread(iatom,ispin) = atom_spread(iatom,ispin) / atom_norm(iatom,ispin) 487 | WRITE(65,'(I5,2F20.10)')iatom,atom_spillover(iatom,ispin),atom_spread(iatom,ispin) 488 | ENDDO 489 | WRITE(65,*) 490 | ENDDO 491 | WRITE(65,*) 492 | WRITE(65,*) 493 | 494 | 495 | WRITE(65,*)' ### Worst Bands ### ' 496 | WRITE(65,*)'Worst spread, averaged across all k-points' 497 | WRITE(65,*)SUM(max_spread(:,1))/DBLE(nkpts) 498 | WRITE(65,*) 499 | WRITE(65,*)'Worst spread at each k-point' 500 | DO ik=1,nkpts 501 | WRITE(65,'(A8,I3,A5,I4,A4,F)')'For kpt',ik,'band',INT(max_spread(ik,2)),'at',max_spread(ik,1) 502 | ENDDO 503 | WRITE(65,*) 504 | 505 | 506 | CLOSE(65) 507 | 508 | 509 | 510 | 511 | END SUBROUTINE calc_spillover 512 | 513 | 514 | 515 | 516 | 517 | 518 | 519 | END PROGRAM projection_main 520 | -------------------------------------------------------------------------------- /projection_VASP/projection_shared.mod: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Chengcheng-Xiao/Periodic_NBO/fc14e3069bb9fa755194d6f655a3352a3802c4c8/projection_VASP/projection_shared.mod -------------------------------------------------------------------------------- /projection_VASP/rd_basis.mod: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Chengcheng-Xiao/Periodic_NBO/fc14e3069bb9fa755194d6f655a3352a3802c4c8/projection_VASP/rd_basis.mod -------------------------------------------------------------------------------- /projection_VASP/rd_wavefunction.f90: -------------------------------------------------------------------------------- 1 | MODULE rd_wavefunction 2 | IMPLICIT NONE 3 | 4 | !Information about the system: number of ions, number of ion types, and type of each ion 5 | !Also ion positions 6 | INTEGER :: n_atom, ntyp 7 | INTEGER,ALLOCATABLE :: atom_types(:),itypes(:) 8 | REAL*8,ALLOCATABLE :: atoms(:,:) 9 | !Maximum number of kpts, bands, plane waves, PAW augmenters, and spins 10 | INTEGER :: nkpts, nbands, nplmax, npromax, nspins 11 | !The energy cutoff 12 | REAL*8 :: enmax 13 | !k-points (scaled), eigenvalues, and Fermi weights 14 | REAL*8,ALLOCATABLE :: kpt(:,:),eig(:,:,:),weight(:,:,:) 15 | REAL*8,ALLOCATABLE :: kpt_wt(:) 16 | !The x,y,z index of each PW component; the actual g-vector 17 | !is calculated below 18 | INTEGER,ALLOCATABLE :: igx(:,:),igy(:,:),igz(:,:) 19 | !The plane wave coefficients 20 | !COMPLEX*8,ALLOCATABLE :: cw(:,:,:), cproj(:,:,:) 21 | COMPLEX*16,ALLOCATABLE :: pw_coeff(:,:,:,:),PAW_coeff(:,:,:,:) 22 | !REAL*8, ALLOCATABLE :: g(:,:,:) ! Array containing each g vector for each plane wave at each k-point 23 | REAL*8, ALLOCATABLE :: gk(:,:,:) ! Array containing each g vector for each plane wave at each k-point, has the k point added in 24 | INTEGER,ALLOCATABLE :: npl(:) !The number of plane waves at a give k-point 25 | LOGICAL :: gamma_point !tells whether or not the vasp output is from a gamma point only calculation 26 | 27 | !************************************************************************************* 28 | !Information about the pseudo-potential (for PAW calculations) 29 | TYPE pseudo 30 | !This includes the number of l channels, and the number used for the PAW on site terms 31 | INTEGER :: ldim, lmaxpaw 32 | !and their associated l quantum numbers 33 | INTEGER,ALLOCATABLE :: lps(:) 34 | !And also information about the radial grid, including number of points, radial values 35 | !and integration weights 36 | INTEGER :: nmax 37 | REAL*8,ALLOCATABLE :: r(:),si(:) 38 | REAL*8 :: rend 39 | !Finall, the (valence) all-electron and pseudo-wavefunctions, and differences 40 | REAL*8,ALLOCATABLE :: wae(:,:),wps(:,:),wdiff(:,:) 41 | !An array the will hold the value of the each wdiff channel at r=0. This value is extrapolated using the 1st and 2nd radial points 42 | REAL*8,ALLOCATABLE :: center_value(:,:) 43 | !Number of valence electrons that are treated completely by the pseudopotential 44 | REAL*8 :: val_corr, val_corr_test !Since VASP has two variables to hold this quantity I will read both of them in and make sure they are the same 45 | END TYPE pseudo 46 | TYPE(pseudo),ALLOCATABLE :: P(:) 47 | 48 | LOGICAL :: PAW_pseudo 49 | 50 | REAL*8,ALLOCATABLE :: PAW_pos(:,:) 51 | 52 | CHARACTER(128) :: wavefunction_fn 53 | 54 | REAL*8 :: a(3,3),b(3,3) ! Direct and Reciprocal lattice vectors 55 | REAL*8 :: pwnorm ! Normalization factor for plane waves (inverse of square root of volume) 56 | REAL*8 :: unitvol ! volume of the unit cell, to use for plane wave norm 57 | 58 | REAL*8, ALLOCATABLE :: pseudo_norm(:) !Norm of each of band only taking into account the planewave portion 59 | REAL*8, ALLOCATABLE :: aug_norm(:) 60 | 61 | INTEGER :: kdim(3) !Dimensionality of k-point mesh. Global so it can be used when writing the NBO.out file. 62 | 63 | REAL*8,PARAMETER :: eV = 27.211652d0 64 | 65 | 66 | CONTAINS 67 | 68 | SUBROUTINE read_vasp_wavefunction(VASP_fn) 69 | 70 | CHARACTER(128) :: VASP_fn 71 | 72 | COMPLEX*8,ALLOCATABLE :: cw(:,:,:,:), cproj(:,:,:,:) 73 | 74 | INTEGER :: unity(3)=1.d0 ! Vector of ones; 'mesh' for total lattice volume 75 | INTEGER :: PAW_tally, pro_per_atom 76 | REAL*8 :: energy_sum, occ_sum 77 | INTEGER :: iion, ityp, ikpt, iband, ipl, nplread, ipro, ispin, j, k, l 78 | !INTEGER :: l,ll,m 79 | 80 | REAL*8 :: kgrid(3) !For determing info on the k-point mesh 81 | 82 | REAL*8, PARAMETER :: bohr = 0.529177249d0, pi=4.d0*ATAN(1.d0), hartree=27.21138386 83 | 84 | OPEN(10,FILE=VASP_fn,FORM='UNFORMATTED') 85 | 86 | PRINT *, '*** Reading system ***' 87 | PRINT * 88 | READ(10) n_atom, ntyp 89 | ALLOCATE(atom_types(ntyp),atoms(3,n_atom),P(ntyp),itypes(n_atom)) 90 | READ(10) itypes 91 | READ(10) atoms 92 | 93 | atom_types = 0 94 | DO j=1,ntyp 95 | DO k=1,n_atom 96 | IF( itypes(k) == j )THEN 97 | atom_types(j) = atom_types(j) + 1 98 | ENDIF 99 | ENDDO 100 | IF( atom_types(j) == 0 )THEN 101 | WRITE(6,*)'atom_types was not allocated propetly' 102 | STOP 103 | ENDIF 104 | ENDDO 105 | 106 | PRINT *, 'n_atom: ', n_atom 107 | PRINT *, 'ntyp: ', ntyp 108 | PRINT *, 'atom_types: ', atom_types 109 | PRINT * 110 | 111 | PRINT *, '*** Reading wavefunction *** ' 112 | PRINT * 113 | 114 | READ(10) nkpts,nbands,enmax,nplmax,npromax,nspins 115 | PRINT *, 'nkpts: ', nkpts 116 | PRINT *, 'nbands: ', nbands 117 | PRINT *, 'enmax: ', enmax, 'eV' 118 | PRINT *, 'nplmax: ', nplmax 119 | PRINT *, 'npromax:', npromax 120 | PRINT *, 'nspins: ', nspins 121 | PRINT * 122 | 123 | gamma_point = .FALSE. 124 | IF( nkpts == 1 )gamma_point = .TRUE. 125 | 126 | ALLOCATE(kpt(3,nkpts),eig(nbands,nkpts,nspins),weight(nbands,nkpts,nspins)) 127 | ALLOCATE(kpt_wt(nkpts)) 128 | ALLOCATE(igx(nplmax,nkpts),igy(nplmax,nkpts),igz(nplmax,nkpts)) 129 | ALLOCATE(cw(nplmax,nbands,nkpts,nspins),cproj(npromax,nbands,nkpts,nspins)) 130 | ALLOCATE(pw_coeff(nplmax,nbands,nkpts,nspins),PAW_coeff(npromax,nbands,nkpts,nspins)) 131 | ALLOCATE(npl(nkpts)) 132 | ALLOCATE(gk(3, nplmax, nkpts)) 133 | 134 | READ(10) a 135 | !VASP uses angstroms for everything, but the projection code uses bohr, so the unit cell vectors are covnerted here 136 | !All other position quantities are calculated from these vectors, so now all distance will be in bohr 137 | a = a / bohr 138 | 139 | PRINT *, 'Direct lattice vectors:' 140 | PRINT *, SNGL(a(1:3,1)) 141 | PRINT *, SNGL(a(1:3,2)) 142 | PRINT *, SNGL(a(1:3,3)) 143 | PRINT * 144 | 145 | !Convert ion positions to absolute coordinates from fractional 146 | DO iion=1,n_atom 147 | atoms(:,iion)=atoms(1,iion)*a(:,1)+atoms(2,iion)*a(:,2)+atoms(3,iion)*a(:,3) 148 | ENDDO 149 | 150 | CALL calc_recip_lattice(a,b) 151 | PRINT *, 'Reciprical lattice vectors:' 152 | PRINT *, SNGL(b(1:3,1)) 153 | PRINT *, SNGL(b(1:3,2)) 154 | PRINT *, SNGL(b(1:3,3)) 155 | PRINT * 156 | 157 | !Information on the k-point mesh and plane-wave basis at each k-point are then read in 158 | DO ikpt=1,nkpts 159 | READ(10) npl(ikpt), kpt(1:3,ikpt), kpt_wt(ikpt) 160 | READ(10) (igx(ipl,ikpt),igy(ipl,ikpt),igz(ipl,ikpt),ipl=1,npl(ikpt)) 161 | !Now the g-vector of each plane-wave is calculated 162 | DO ipl=1,npl(ikpt) 163 | gk(:,ipl,ikpt) = igx(ipl,ikpt)*b(:,1)+igy(ipl,ikpt)*b(:,2)+igz(ipl,ikpt)*b(:,3) 164 | gk(:,ipl,ikpt) = gk(:,ipl,ikpt) +kpt(1,ikpt)*b(:,1)+kpt(2,ikpt)*b(:,2)+kpt(3,ikpt)*b(:,3) 165 | ENDDO 166 | !WRITE(6,*)'k-point',ikpt,SNGL(kpt(:,ikpt)) 167 | !WRITE(6,*)'k-point weight',SNGL(kpt_wt(ikpt)) 168 | !WRITE(6,*) 169 | ENDDO 170 | 171 | !Now analyze the k-point mesh as obtained out of VASP 172 | !We want to see if there are any dimensions with only a single k-point 173 | !This will be used for adjusting the unit cells written out to the NBO.out file 174 | kgrid = 1 175 | DO ikpt=1,nkpts 176 | DO j=1,3 177 | IF( ABS(kpt(j,ikpt)).GT.1.d-13 )THEN 178 | !WRITE(6,*)j,(1.d0/ABS(kpt(j,ik))) 179 | IF( (1.d0/ABS(kpt(j,ikpt))).GT.kgrid(j) )THEN 180 | kgrid(j) = (1.d0/ABS(kpt(j,ikpt))) 181 | ENDIF 182 | ENDIF 183 | ENDDO 184 | ENDDO 185 | DO j=1,3 186 | !WRITE(6,*)kgrid(j)-NINT(kgrid(j)) 187 | IF( ABS(kgrid(j)-NINT(kgrid(j))).GT.1.d-10 )THEN 188 | WRITE(6,*)'kgrid does not contain a near integer in the direction',j 189 | WRITE(6,*)kgrid(j) 190 | STOP 191 | ENDIF 192 | kdim(j) = NINT(kgrid(j)) 193 | ENDDO 194 | 195 | WRITE(6,*)'Dimemsionality of k-point mesh' 196 | WRITE(6,'(3I8)')kdim 197 | WRITE(6,*) 198 | 199 | !Spin dependent information is now read in 200 | !This includes band energies and occupancies for each band at each k-point 201 | !As well as coefficients for plane-waves and PAW augmenters for each band at each k-point 202 | DO ispin=1,nspins 203 | DO ikpt=1,nkpts 204 | READ(10) (eig(iband,ikpt,ispin), weight(iband,ikpt,ispin),iband=1,nbands) 205 | DO iband=1,nbands 206 | READ(10) (cw(ipl,iband,ikpt,ispin),ipl=1,npl(ikpt)) 207 | READ(10) (cproj(ipro,iband,ikpt,ispin),ipro=1,npromax) 208 | ENDDO 209 | ENDDO 210 | ENDDO 211 | 212 | !The energy values in VASP are in eV, but we want them in Hartree, so they are converted here 213 | eig = eig / hartree 214 | 215 | !The number of electrons and energy expectation value for the plane-wave bands is calculated. 216 | !This is done to compare projected results 217 | energy_sum = 0.d0 218 | occ_sum = 0.d0 219 | DO ispin=1,nspins 220 | DO ikpt=1,nkpts 221 | DO iband=1,nbands 222 | occ_sum = occ_sum + weight(iband,ikpt,ispin)*kpt_wt(ikpt) 223 | energy_sum = energy_sum + eig(iband,ikpt,ispin)*weight(iband,ikpt,ispin)*kpt_wt(ikpt) 224 | ENDDO 225 | ENDDO 226 | ENDDO 227 | WRITE(6,*)'Number of electrons in VASP bands ',occ_sum * DBLE(3-nspins) 228 | WRITE(6,*)'Energy sum for VASP bands ',energy_sum * DBLE(3-nspins) 229 | WRITE(6,*) 230 | 231 | !Initialize logical variable assuming this is NOT a PAW pseudopotential 232 | PAW_pseudo = .FALSE. 233 | 234 | PRINT *, '*** Reading pseudo-potential ***' 235 | PRINT * 236 | DO iion=1,ntyp 237 | 238 | !WRITE(6,*)'Pseudotential for ion type:',iion 239 | READ(10) P(iion)%ldim, P(iion)%lmaxpaw 240 | ALLOCATE(P(iion)%lps(P(iion)%ldim)) 241 | READ(10) P(iion)%lps 242 | READ(10) P(iion)%val_corr,P(iion)%val_corr_test 243 | READ(10) P(iion)%nmax 244 | 245 | !WRITE(6,*)'ldim',P(iion)%ldim 246 | !WRITE(6,*)'lmaxpaw', P(iion)%lmaxpaw 247 | !WRITE(6,*)'lps', P(iion)%lps 248 | IF( P(iion)%val_corr .NE. P(iion)%val_corr_test )THEN 249 | WRITE(6,*)'PVALF and PVALF_ORIG are not the same for ion type',iion 250 | WRITE(6,*)P(iion)%val_corr, P(iion)%val_corr_test 251 | STOP 252 | ELSE 253 | !WRITE(6,*)'val_corr',P(iion)%val_corr 254 | ENDIF 255 | !WRITE(6,*)'nmax', P(iion)%nmax 256 | 257 | ALLOCATE(P(iion)%r(P(iion)%nmax)) 258 | ALLOCATE(P(iion)%si(P(iion)%nmax)) 259 | ALLOCATE(P(iion)%wae(P(iion)%nmax,P(iion)%ldim)) 260 | ALLOCATE(P(iion)%wps(P(iion)%nmax,P(iion)%ldim)) 261 | ALLOCATE(P(iion)%wdiff(P(iion)%nmax,P(iion)%ldim)) 262 | ALLOCATE(P(iion)%center_value(P(iion)%ldim,0:2)) 263 | 264 | READ(10) P(iion)%r 265 | READ(10) P(iion)%si 266 | READ(10) P(iion)%wae 267 | READ(10) P(iion)%wps 268 | IF (P(iion)%nmax > 0) P(iion)%rend=P(iion)%r(P(iion)%nmax) 269 | 270 | PRINT *, 'Ion type: ', iion 271 | PRINT *, '# l channels: ', P(iion)%ldim 272 | PRINT *, 'lmax PAW: ', P(iion)%lmaxpaw !Evidently this is zero of non-PAW calcs, non-zero for PAW 273 | IF (P(iion)%lmaxpaw.GT.0) THEN 274 | !PRINT *, 'PAW pseudo-potential detected.' 275 | IF( iion .GT. 1 .AND. .NOT. PAW_pseudo )STOP ' One atom type is not PAW but another is? This aint gonna work.' 276 | PAW_pseudo = .TRUE. 277 | ELSE 278 | PRINT *, 'Found norm-conserving pseduo-potential.' 279 | IF( PAW_pseudo )STOP ' One atom type is PAW but another is not? This aint gonna work.' 280 | PAW_pseudo = .FALSE. 281 | ENDIF 282 | PRINT *, 'l of channel: ', P(iion)%lps 283 | PRINT *, '# radial pts:', P(iion)%nmax 284 | PRINT * 285 | 286 | !Even though VASP stores the AE and PS radial function separately for projection purposes we want the difference, which will be stored in wdiff 287 | !Also VASP stores the radial functions multiplied by a factor of r, we remove this here. 288 | DO j=1,P(iion)%nmax 289 | P(iion)%wdiff(j,:) = (P(iion)%wae(j,:) - P(iion)%wps(j,:)) / P(iion)%r(j) 290 | P(iion)%wae(j,:) = P(iion)%wae(j,:) / P(iion)%r(j) 291 | P(iion)%wps(j,:) = P(iion)%wps(j,:) / P(iion)%r(j) 292 | ENDDO 293 | 294 | !The PAW radial grids must be converted from angstrom to bohr 295 | P(iion)%r = P(iion)%r / bohr 296 | P(iion)%si = P(iion)%si / bohr 297 | 298 | !For off-site overlaps the integral of the PAW along the radial grid must be computed 299 | P(iion)%center_value = 0.d0 300 | DO k=1,P(iion)%ldim 301 | DO l=0,2 302 | DO j=1,P(iion)%nmax 303 | P(iion)%center_value(k,l) = P(iion)%center_value(k,l) + P(iion)%wdiff(j,k) * P(iion)%r(j)**(2+l) * P(iion)%si(j) 304 | ENDDO 305 | !WRITE(6,*)'Integrated PAW value for channel',k,'of order',l,P(iion)%center_value(k,l) 306 | ENDDO 307 | ENDDO 308 | !WRITE(6,*) 309 | 310 | IF( PAW_pseudo )THEN 311 | !Adjust the maximum radius of the core region into bohr. This parameter is only used when doing a 3D integration of the core region (density test) 312 | P(iion)%rend = P(iion)%rend / bohr 313 | !PRINT *, 'Max radial dist. (bohr): ', SNGL(P(iion)%rend) 314 | !PRINT *,SNGL(P(iion)%r(P(iion)%nmax)) 315 | !PRINT * 316 | IF( P(iion)%r(P(iion)%nmax) /= P(iion)%rend )THEN 317 | WRITE(6,*)'there are problems with bohr angstrom comparison for r-end' 318 | STOP 319 | ENDIF 320 | ENDIF 321 | !WRITE(6,*) 322 | 323 | ENDDO 324 | 325 | !Now an array containing the coordinate of the atom which contains a given projector function will be filled 326 | !The array is only filled if the pseudopotential is a PAW 327 | !All atoms are looped over, how many projectors are on an atom is calcualted and that many spots in the array are filled with the location of the atom 328 | !PAW_tally is used to placehold in the array for already filled positions. 329 | IF( PAW_pseudo )THEN 330 | ALLOCATE(PAW_pos(npromax,3)) 331 | PAW_tally = 0 332 | DO k=1,n_atom 333 | ityp = itypes(k) 334 | pro_per_atom = SUM(2*P(ityp)%lps+1) 335 | !WRITE(6,*)'PAW augmenters on atom',k,pro_per_atom 336 | DO j=PAW_tally+1,PAW_tally+pro_per_atom 337 | PAW_pos(j,:) = atoms(:,k) 338 | !WRITE(6,*)'PAW_pos',j 339 | !WRITE(6,*)PAW_pos(j,:) 340 | ENDDO 341 | PAW_tally = PAW_tally + pro_per_atom 342 | ENDDO 343 | 344 | WRITE(6,*)'Total number of PAW-augmenter functions, per unit cell',PAW_tally 345 | IF( PAW_tally /= npromax )STOP 'the PAW_tally parameter is not correct coming out of filling PAW_pos array' 346 | WRITE(6,*) 347 | ENDIF 348 | 349 | CLOSE(10) 350 | 351 | !WRITE(6,*)'Band normalization test' 352 | !DO ikpt=1,nkpts 353 | ! WRITE(6,*)'For kpt',ikpt 354 | ! DO iband=1,nbands 355 | ! WRITE(6,*)'Norm for band',iband,SUM(CONJG(cw(:,iband,ikpt,1))*cw(:,iband,ikpt,1)) 356 | ! ENDDO 357 | ! WRITE(6,*) 358 | !ENDDO 359 | 360 | 361 | !Include planewave norm -> 1/sqrt(volume of unit cell) 362 | CALL grid_volume(unitvol, a, unity) 363 | cw = cw * 1.d0/SQRT(unitvol) 364 | 365 | !Convert the coefficient arrays to ones with doulbe precision for use in BLAS subroutines 366 | PAW_coeff = cproj * bohr**(1.5) !Also need to convert this to inverse bohr from inverse angstroms 367 | pw_coeff = cw 368 | 369 | 370 | 371 | ENDSUBROUTINE read_vasp_wavefunction 372 | 373 | !Does a simple linear interpolation to calculat the radial wavefunction at 374 | !a given radial distance. Note that VASP actually tabulates the radial 375 | !wfn times r, so it is necessary to divide by r to get the desired value. 376 | SUBROUTINE get_radial_wavefunction(w,rvals,r,val) 377 | IMPLICIT NONE 378 | REAL*8 :: w(:),rvals(:),r,val 379 | INTEGER :: n,nmax 380 | 381 | nmax=SIZE(w,1) 382 | val=0.d0 383 | DO n=1,nmax-1 384 | IF (rvals(n) <= r .AND. rvals(n+1) > r) THEN 385 | val=w(n)+(w(n+1)-w(n))/(rvals(n+1)-rvals(n))*(r-rvals(n)) 386 | ENDIF 387 | ENDDO 388 | !val=val/r 389 | 390 | END SUBROUTINE get_radial_wavefunction 391 | 392 | 393 | !******************************************************************** 394 | !******************************************************************** 395 | ! VASP ROUTINES (somewhat modified 396 | !******************************************************************** 397 | !******************************************************************** 398 | 399 | !************************* SETYLM ************************************ 400 | ! 401 | ! calculate spherical harmonics for a set of grid points up to 402 | ! LMAX. Note that these are missing a factor of r**(-l) from the "true" 403 | ! cartesian speherical harmonics! 404 | ! written by Georg Kresse and updated by JRS 405 | !********************************************************************* 406 | 407 | SUBROUTINE SETYLM(LYDIM,INDMAX,YLM,X,Y,Z) 408 | IMPLICIT NONE 409 | INTEGER LYDIM ! maximum L 410 | INTEGER INDMAX ! number of points (X,Y,Z) 411 | REAL*8 YLM(:,:) ! spherical harmonics 412 | REAL*8 X(:),Y(:),Z(:) ! x,y and z coordinates 413 | 414 | ! local variables 415 | REAL*8 FAK 416 | INTEGER IND 417 | 418 | REAL*8, PARAMETER :: bohr = 0.529177249d0, pi=4.d0*ATAN(1.d0) 419 | 420 | !----------------------------------------------------------------------- 421 | ! runtime check of workspace 422 | !----------------------------------------------------------------------- 423 | IF ( UBOUND(YLM,2) < (LYDIM+1)**2) THEN 424 | WRITE(0,*)'internal ERROR: SETYLM, insufficient L workspace' 425 | STOP 426 | ENDIF 427 | 428 | IF ( UBOUND(YLM,1) < INDMAX) THEN 429 | WRITE(0,*)'internal ERROR: SETYLM, insufficient INDMAX workspace' 430 | STOP 431 | ENDIF 432 | 433 | FAK=1/(2.d0 * SQRT(PI)) 434 | !----------------------------------------------------------------------- 435 | ! here is the code for L=0, hard coded 436 | !----------------------------------------------------------------------- 437 | IF (LYDIM <0) GOTO 100 438 | !DIR$ IVDEP 439 | !OCL NOVREC 440 | DO IND=1,INDMAX 441 | YLM(IND,1)=FAK 442 | ENDDO 443 | !----------------------------------------------------------------------- 444 | ! here is the code for L=1, once again hard coded 445 | !----------------------------------------------------------------------- 446 | IF (LYDIM <1) GOTO 100 447 | !DIR$ IVDEP 448 | !OCL NOVREC 449 | DO IND=1,INDMAX 450 | YLM(IND,2) = (FAK*SQRT(3.d0))*Y(IND) 451 | YLM(IND,3) = (FAK*SQRT(3.d0))*Z(IND) 452 | YLM(IND,4) = (FAK*SQRT(3.d0))*X(IND) 453 | ENDDO 454 | !----------------------------------------------------------------------- 455 | ! code for L=2, 456 | !----------------------------------------------------------------------- 457 | IF (LYDIM <2) GOTO 100 458 | !DIR$ IVDEP 459 | !OCL NOVREC 460 | DO IND=1,INDMAX 461 | YLM(IND,5)= (FAK*SQRT(15.d0)) *X(IND)*Y(IND) 462 | YLM(IND,6)= (FAK*SQRT(15.d0)) *Y(IND)*Z(IND) 463 | YLM(IND,7)= (FAK*SQRT(5.d0)/2.d0)*(3*Z(IND)*Z(IND)-1) 464 | YLM(IND,8)= (FAK*SQRT(15.d0)) *X(IND)*Z(IND) 465 | YLM(IND,9)= (FAK*SQRT(15.d0)/2.d0)*(X(IND)*X(IND)-Y(IND)*Y(IND)) 466 | ENDDO 467 | !----------------------------------------------------------------------- 468 | ! initialize all componentes L>2 to zero (Actually unimplemented) 469 | !----------------------------------------------------------------------- 470 | IF (LYDIM <3) GOTO 100 471 | STOP 'L > 2 unimplemented in SETYLM' 472 | 473 | 100 CONTINUE 474 | 475 | END SUBROUTINE SETYLM 476 | 477 | 478 | 479 | 480 | 481 | 482 | 483 | SUBROUTINE calc_recip_lattice(a,b) 484 | IMPLICIT NONE 485 | REAL*8,INTENT(IN) :: a(3,3) 486 | REAL*8,INTENT(OUT) :: b(3,3) 487 | 488 | REAL*8 :: norm 489 | 490 | REAL*8,PARAMETER :: pi = 4.d0*datan(1.d0) 491 | 492 | norm = 1.d0/DOT_PRODUCT(a(:,1),cross(a(:,2),a(:,3))) 493 | norm = norm * 2.d0*pi 494 | 495 | b(:,1) = cross(a(:,2),a(:,3))*norm 496 | b(:,2) = cross(a(:,3),a(:,1))*norm 497 | b(:,3) = cross(a(:,1),a(:,2))*norm 498 | 499 | END SUBROUTINE calc_recip_lattice 500 | 501 | FUNCTION cross(a, b) 502 | REAL*8,INTENT (in) :: a(3), b(3) 503 | REAL*8 :: cross(3) 504 | 505 | cross(1) = a(2) * b(3) - a(3) * b(2) 506 | cross(2) = a(3) * b(1) - a(1) * b(3) 507 | cross(3) = a(1) * b(2) - a(2) * b(1) 508 | END FUNCTION cross 509 | 510 | 511 | SUBROUTINE grid_volume(gridvol, b, mesh) 512 | IMPLICIT NONE 513 | REAL*8, INTENT(IN) :: b(3,3) ! Reciprocal lattice vectors 514 | INTEGER, INTENT(IN) :: mesh(3) ! Number of grid points in each direction, inverse gives lenght of grid vector 515 | REAL*8, INTENT(OUT) :: gridvol ! Volume of box to use for integration 516 | REAL*8 :: grid_vec(3,3) ! Vectors of gridbox in direction of recip lattice vectors 517 | INTEGER :: j 518 | 519 | DO j=1,3 520 | grid_vec(:,j)=(1.d0/DBLE(mesh(j)))*b(:,j) 521 | ENDDO 522 | 523 | gridvol = DOT_PRODUCT(grid_vec(:,1), cross(grid_vec(:,2),grid_vec(:,3))) 524 | 525 | 526 | END SUBROUTINE grid_volume 527 | 528 | 529 | 530 | 531 | 532 | 533 | 534 | ENDMODULE 535 | -------------------------------------------------------------------------------- /projection_VASP/rd_wavefunction.mod: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Chengcheng-Xiao/Periodic_NBO/fc14e3069bb9fa755194d6f655a3352a3802c4c8/projection_VASP/rd_wavefunction.mod -------------------------------------------------------------------------------- /projection_VASP/sample_systems/MgO/INCAR: -------------------------------------------------------------------------------- 1 | general: 2 | SYSTEM = MgO_bulk 3 | ISTART = 0 4 | ICHARG = 2 5 | ISMEAR = -5 #Determines partial occupancies of obritals, Since metal is being looked at methfessel-Paxton should be used (>0) 2-> 2nd order 6 | ALGO= Fast #Sets algorithm of electronic minimization, uses Davidson-Block for first iteration, then RMM-DIIS for all subsequent. Resets at every ionic move. 7 | 8 | ISYM = 0 9 | 10 | EDIFF = 1E-6 11 | NELMIN = 4 12 | 13 | LNBO = True 14 | 15 | dynamic: 16 | NSW = 0 #max number of ionic moves 17 | POTIM = 0.1 #scaling of forces for ionic moves 18 | IBRION = 2 #Conjugate gradient method, I think it is close to equilibrated but maybe not 19 | EDIFFG = -1E-2 20 | 21 | -------------------------------------------------------------------------------- /projection_VASP/sample_systems/MgO/KPOINTS: -------------------------------------------------------------------------------- 1 | K-Points 2 | 0 3 | Monkhorst-Pack 4 | 5 5 5 5 | 0 0 0 6 | -------------------------------------------------------------------------------- /projection_VASP/sample_systems/MgO/POSCAR: -------------------------------------------------------------------------------- 1 | Bulk MgO 2 | 4.212 3 | 1.0000000000000000 0.0000000000000000 0.0000000000000000 4 | 0.0000000000000000 1.0000000000000000 0.0000000000000000 5 | 0.0000000000000000 0.0000000000000000 1.0000000000000000 6 | 4 4 7 | Direct 8 | 0.0000000000000000 0.0000000000000000 0.0000000000000000 9 | 0.5000000000000000 0.5000000000000000 0.0000000000000000 10 | 0.0000000000000000 0.5000000000000000 0.5000000000000000 11 | 0.5000000000000000 0.0000000000000000 0.5000000000000000 12 | 0.5000000000000000 0.0000000000000000 0.0000000000000000 13 | 0.0000000000000000 0.5000000000000000 0.0000000000000000 14 | 0.0000000000000000 0.0000000000000000 0.5000000000000000 15 | 0.5000000000000000 0.5000000000000000 0.5000000000000000 16 | 17 | 0.00000000E+00 0.00000000E+00 0.00000000E+00 18 | 0.00000000E+00 0.00000000E+00 0.00000000E+00 19 | 0.00000000E+00 0.00000000E+00 0.00000000E+00 20 | 0.00000000E+00 0.00000000E+00 0.00000000E+00 21 | 0.00000000E+00 0.00000000E+00 0.00000000E+00 22 | 0.00000000E+00 0.00000000E+00 0.00000000E+00 23 | 0.00000000E+00 0.00000000E+00 0.00000000E+00 24 | 0.00000000E+00 0.00000000E+00 0.00000000E+00 25 | -------------------------------------------------------------------------------- /projection_VASP/sample_systems/MgO/basis.inp: -------------------------------------------------------------------------------- 1 | ! 6-311G* EMSL Basis Set Exchange Library 11/14/12 4:03 PM 2 | ! Elements References 3 | ! -------- ---------- 4 | ! H, Li - Ne: R. Krishnan, J.S. Binkley, R. Seeger and J.A. Pople, 5 | ! J. Chem. Phys. 72, 650 (1980) 6 | ! Na - Ar: A.D. McLean and G.S. Chandler J. Chem. Phys. 72, 5639, (1980). 7 | ! K - Ca: J-P. Blaudeau, M. P. McGrath, L.A. Curtiss and L. Radom, 8 | ! J. Chem. Phys. 107, 5016 (1997). 9 | ! Ga - Kr: L. A. Curtiss, M. P. McGrath, J-P. Blandeau, N. E. Davis, 10 | ! R. C. Binning, Jr. L. Radom, J. Chem. Phys. 103, 6104 (1995). 11 | ! I : M.N. Glukhovstev, A. pross, M.P. McGrath, L. Radom, J. Chem. Phys. 12 | ! 103, 1878 (1995) 13 | ! 14 | 15 | ! Elements References 16 | ! -------- ---------- 17 | ! Li - Ar: R. Krishnan, J.S. Binkley, R. Seeger, J.A. Pople, J. Chem. Phys. 72, 18 | ! 650 (1980). 19 | ! K - Ca: J-P. Blaudeau, M. P. McGrath, L.A. Curtiss 20 | ! and L. Radom, J. Chem. Phys. 107, 5016 21 | ! (1997). 22 | ! Ga - Kr: L. A. Curtiss, M. P. McGrath, J-P. Blandeau, N. E. Davis, R. C. 23 | ! Binning, Jr., L. Radom, J. Chem. Phys. 103, 6104 (1995) 24 | ! 25 | 26 | 27 | **** 28 | Mg 0 29 | S 6 1.00 30 | 43866.5000000 0.0009180 31 | 6605.3700000 0.0070470 32 | 1513.2600000 0.0359410 33 | 432.3170000 0.1414610 34 | 142.1490000 0.4267640 35 | 51.3983000 0.4979750 36 | S 3 1.00 37 | 51.3983000 0.2513550 38 | 19.9196000 0.6186710 39 | 8.0247400 0.1884170 40 | S 1 1.00 41 | 2.5081700 1.0000000 42 | S 1 1.00 43 | 0.8715310 1.0000000 44 | P 4 1.00 45 | 193.8540000 0.0101880 46 | 45.4420000 0.0753600 47 | 14.1864000 0.3074190 48 | 5.0575100 0.7175750 49 | P 2 1.00 50 | 1.8886100 0.6673390 51 | 0.7226520 0.3946490 52 | P 1 1.00 53 | 0.2364170 1.0000000 54 | D 1 1.00 55 | 0.1750000 1.0000000 56 | **** 57 | O 0 58 | S 6 1.00 59 | 8588.5000000 0.00189515 60 | 1297.2300000 0.0143859 61 | 299.2960000 0.0707320 62 | 87.3771000 0.2400010 63 | 25.6789000 0.5947970 64 | 3.7400400 0.2808020 65 | SP 3 1.00 66 | 42.1175000 0.1138890 0.0365114 67 | 9.6283700 0.9208110 0.2371530 68 | 2.8533200 -0.00327447 0.8197020 69 | SP 1 1.00 70 | 0.9056610 1.0000000 1.0000000 71 | SP 1 1.00 72 | 0.2556110 1.0000000 1.0000000 73 | D 1 1.00 74 | 1.2920000 1.0000000 75 | **** 76 | -------------------------------------------------------------------------------- /projection_VASP/sample_systems/Nickel/INCAR: -------------------------------------------------------------------------------- 1 | general: 2 | SYSTEM = Ni_bulk 3 | ISTART = 0 4 | ICHARG = 2 5 | ISMEAR = 2; SIGMA=0.05 #Determines partial occupancies of obritals, Since metal is being looked at methfessel-Paxton should be used (>0) 2-> 2nd order 6 | ALGO= Fast #Sets algorithm of electronic minimization, uses Davidson-Block for first iteration, then RMM-DIIS for all subsequent. Resets at every ionic move. 7 | 8 | ISYM = 0 9 | 10 | EDIFF = 1E-6 11 | NELMIN = 4 12 | 13 | ISPIN = 2 14 | 15 | LNBO = True 16 | 17 | dynamic: 18 | NSW=0 #max number of ionic moves 19 | POTIM = 0.2 #scaling of forces for ionic moves 20 | IBRION = 2 #Conjugate gradient method, I think it is close to equilibrated but maybe not 21 | EDIFFG = -1E-2 22 | 23 | -------------------------------------------------------------------------------- /projection_VASP/sample_systems/Nickel/KPOINTS: -------------------------------------------------------------------------------- 1 | K-Points 2 | 0 3 | Monkhorst-Pack 4 | 11 11 11 5 | 0 0 0 6 | -------------------------------------------------------------------------------- /projection_VASP/sample_systems/Nickel/POSCAR: -------------------------------------------------------------------------------- 1 | copper 2 | 3.524 3 | 1.0 0.0 0.0 4 | 0.0 1.0 0.0 5 | 0.0 0.0 1.0 6 | 4 7 | direct 8 | 0.5 0.5 0.0 9 | 0.0 0.5 0.5 10 | 0.5 0.0 0.5 11 | 0.0 0.0 0.0 12 | -------------------------------------------------------------------------------- /projection_VASP/sample_systems/Nickel/basis.inp: -------------------------------------------------------------------------------- 1 | ! 6-31G EMSL Basis Set Exchange Library 2/25/15 3:47 PM 2 | ! Elements References 3 | ! -------- ---------- 4 | ! H - He: W.J. Hehre, R. Ditchfield and J.A. Pople, J. Chem. Phys. 56, 5 | ! Li - Ne: 2257 (1972). Note: Li and B come from J.D. Dill and J.A. 6 | ! Pople, J. Chem. Phys. 62, 2921 (1975). 7 | ! Na - Ar: M.M. Francl, W.J. Petro, W.J. Hehre, J.S. Binkley, M.S. Gordon, 8 | ! D.J. DeFrees and J.A. Pople, J. Chem. Phys. 77, 3654 (1982) 9 | ! K - Zn: V. Rassolov, J.A. Pople, M. Ratner and T.L. Windus, J. Chem. Phys. 10 | ! 109, 1223 (1998) 11 | ! Note: He and Ne are unpublished basis sets taken from the Gaussian 12 | ! program 13 | ! 14 | 15 | 16 | 17 | **** 18 | Ni 0 19 | S 6 1.00 20 | 71396.3500000 1.753003E-03 21 | 10720.8400000 1.343122E-02 22 | 2442.1290000 6.627041E-02 23 | 688.4265000 2.302508E-01 24 | 220.6153000 4.790186E-01 25 | 75.3937300 3.523444E-01 26 | SP 6 1.00 27 | 1492.5320000 2.370714E-03 3.967554E-03 28 | 355.4013000 3.160566E-02 3.109479E-02 29 | 114.9534000 1.266335E-01 1.359517E-01 30 | 43.2204300 -2.417037E-02 3.485136E-01 31 | 17.5971000 -6.187775E-01 4.625498E-01 32 | 7.2577650 -4.576770E-01 2.035186E-01 33 | SP 6 1.00 34 | 59.3526100 -4.162002E-03 -7.421452E-03 35 | 20.0218100 7.425111E-02 -2.953410E-02 36 | 8.6145610 2.541360E-01 6.731852E-02 37 | 3.6605310 -2.903477E-01 4.016660E-01 38 | 1.5281110 -7.302121E-01 4.926623E-01 39 | 0.6040570 -2.076057E-01 1.756893E-01 40 | SP 1 1.00 41 | 0.108 1.000000E+00 1.00000000 42 | D 3 1.00 43 | 28.1914700 9.098881E-02 44 | 7.5235840 3.958208E-01 45 | 2.2712280 6.947154E-01 46 | D 1 1.00 47 | 0.560 1.0000000 48 | **** 49 | -------------------------------------------------------------------------------- /projection_VASP/sample_systems/Silicon/INCAR: -------------------------------------------------------------------------------- 1 | general: 2 | SYSTEM = Si_bulk 3 | ISTART = 0 4 | ICHARG = 2 5 | ISMEAR = -5 #Determines partial occupancies of obritals, Since metal is being looked at methfessel-Paxton should be used (>0) 2-> 2nd order 6 | ALGO= Fast #Sets algorithm of electronic minimization, uses Davidson-Block for first iteration, then RMM-DIIS for all subsequent. Resets at every ionic move. 7 | 8 | ISYM = 0 9 | 10 | EDIFF = 1E-6 11 | NELMIN = 4 12 | 13 | LNBO = True 14 | 15 | dynamic: 16 | NSW = 0 #max number of ionic moves 17 | POTIM = 0.1 #scaling of forces for ionic moves 18 | IBRION = 2 #Conjugate gradient method, I think it is close to equilibrated but maybe not 19 | EDIFFG = -1E-2 20 | 21 | -------------------------------------------------------------------------------- /projection_VASP/sample_systems/Silicon/KPOINTS: -------------------------------------------------------------------------------- 1 | K-Points 2 | 0 3 | Monkhorst-Pack 4 | 5 5 5 5 | 0 0 0 6 | -------------------------------------------------------------------------------- /projection_VASP/sample_systems/Silicon/POSCAR: -------------------------------------------------------------------------------- 1 | tetrahedral silicon 2 | 5.475 3 | 1.0000000000000000 0.0000000000000000 0.0000000000000000 4 | 0.0000000000000000 1.0000000000000000 0.0000000000000000 5 | 0.0000000000000000 0.0000000000000000 1.0000000000000000 6 | 8 7 | Direct 8 | 0.0000000000000000 0.0000000000000000 0.0000000000000000 9 | 0.2500000000000000 0.2500000000000000 0.2500000000000000 10 | 0.5000000000000000 0.5000000000000000 0.0000000000000000 11 | 0.0000000000000000 0.5000000000000000 0.5000000000000000 12 | 0.5000000000000000 0.0000000000000000 0.5000000000000000 13 | 0.7500000000000000 0.2500000000000000 0.7500000000000000 14 | 0.7500000000000000 0.7500000000000000 0.2500000000000000 15 | 0.2500000000000000 0.7500000000000000 0.7500000000000000 16 | 17 | 0.00000000E+00 0.00000000E+00 0.00000000E+00 18 | 0.00000000E+00 0.00000000E+00 0.00000000E+00 19 | 0.00000000E+00 0.00000000E+00 0.00000000E+00 20 | 0.00000000E+00 0.00000000E+00 0.00000000E+00 21 | 0.00000000E+00 0.00000000E+00 0.00000000E+00 22 | 0.00000000E+00 0.00000000E+00 0.00000000E+00 23 | 0.00000000E+00 0.00000000E+00 0.00000000E+00 24 | 0.00000000E+00 0.00000000E+00 0.00000000E+00 25 | -------------------------------------------------------------------------------- /projection_VASP/sample_systems/Silicon/basis.inp: -------------------------------------------------------------------------------- 1 | ! 3-21G EMSL Basis Set Exchange Library 11/8/12 12:58 PM 2 | ! Elements References 3 | ! -------- ---------- 4 | ! H - Ne: J.S. Binkley, J.A. Pople, W.J. Hehre, J. Am. Chem. Soc 102 939 (1980) 5 | ! Na - Ar: M.S. Gordon, J.S. Binkley, J.A. Pople, W.J. Pietro and W.J. Hehre, 6 | ! J. Am. Chem. Soc. 104, 2797 (1983). 7 | ! K - Ca: K.D. Dobbs, W.J. Hehre, J. Comput. Chem. 7, 359 (1986). 8 | ! Ga - Kr: K.D. Dobbs, W.J. Hehre, J. Comput. Chem. 7, 359 (1986). 9 | ! Sc - Zn: K.D. Dobbs, W.J. Hehre, J. Comput. Chem. 8, 861 (1987). 10 | ! Y - Cd: K.D. Dobbs, W.J. Hehre, J. Comput. Chem. 8, 880 (1987). 11 | ! Cs : A 3-21G quality set derived from the Huzinage MIDI basis sets. 12 | ! E.D. Glendening and D. Feller, J. Phys. Chem. 99, 3060 (1995) 13 | ! 14 | 15 | 16 | **** 17 | Si 0 18 | S 3 1.00 19 | 910.6550000 0.0660823 20 | 137.3360000 0.3862290 21 | 29.7601000 0.6723800 22 | SP 3 1.00 23 | 36.6716000 -0.1045110 0.1133550 24 | 8.3172900 0.1074100 0.4575780 25 | 2.2164500 0.9514460 0.6074270 26 | SP 2 1.00 27 | 1.0791300 -0.3761080 0.0671030 28 | 0.3024220 1.2516500 0.9568830 29 | SP 1 1.00 30 | 0.0933392 1.0000000 1.0000000 31 | D 1 1.00 32 | 0.4500000 1.0000000 33 | **** 34 | --------------------------------------------------------------------------------