## File: findqpt.f90

package info (click to toggle)
elkcode 5.4.24-2
• links: PTS, VCS
• area: main
• in suites: buster, sid
• size: 12,840 kB
• sloc: f90: 48,415; fortran: 22,457; perl: 965; makefile: 384; sh: 369; python: 105; ansic: 67
 file content (37 lines) | stat: -rw-r--r-- 1,044 bytes parent folder | download
 `12345678910111213141516171819202122232425262728293031323334353637` `````` ! Copyright (C) 2010 J. K. Dewhurst, S. Sharma and E. K. U. Gross. ! This file is distributed under the terms of the GNU General Public License. ! See the file COPYING for license details. subroutine findqpt(vpl,isym,iq) use modmain implicit none ! arguments real(8), intent(in) :: vpl(3) integer, intent(out) :: isym,iq ! local variables integer ivp(3),lspl real(8) v1(3),v2(3),t1 ivp(:)=nint(vpl(:)*ngridq(:)) ivp(:)=modulo(ivp(:),ngridq(:)) iq=iqmap(ivp(1),ivp(2),ivp(3)) v1(:)=vql(:,iq) call r3frac(epslat,v1) ! find the symmetry which rotates vql to vpl do isym=1,nsymcrys lspl=lsplsymc(isym) ! multiply vpl by the transpose of the symmetry matrix (i.e. the inverse) v2(:)=symlat(1,:,lspl)*vpl(1) & +symlat(2,:,lspl)*vpl(2) & +symlat(3,:,lspl)*vpl(3) call r3frac(epslat,v2) t1=abs(v1(1)-v2(1))+abs(v1(2)-v2(2))+abs(v1(3)-v2(3)) if (t1.lt.epslat) return end do write(*,*) write(*,'("Error(findqpt): equivalent q-point not in set")') write(*,'(" Requested q-point : ",3G18.10)') vpl write(*,*) stop end subroutine ``````