77_ddb/sortph.F90 sometimes fails to connect branches correctly.
Here are my quick-hacked 77_ddb/sortph.F90 and a
small patch for 72_response/phfrq3.F90.
Understand what they are, then use them.
But, you do NOT have to understand GROUP THEORY !!!
This technique may be also used to plot electronic band structures.
Ciao, ciao,
Takeshi Nishimatsu
http://loto.sourceforge.net/feram/
Fast MD program for perovskite-type ferroelectrics
Code: Select all
!{\src2tex{textfont=tt}}
!!****f* ABINIT/sortph
!! NAME
!! sortph
!!
!! FUNCTION
!! Sort the energies in order to have fine phonon
!! dispersion curves
!! It is best not to include the gamma point in the list
!!
!! COPYRIGHT
!! Copyright (C) 2002-2010 ABINIT group (FDortu,MVeithen)
!! This file is distributed under the terms of the
!! GNU General Public License, see ~abinit/COPYING
!! or http://www.gnu.org/copyleft/gpl.txt .
!! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
!!
!! MODIFIED
!! Takeshi Nishimatsu
!!
!! INPUTS
!! displ(2,3*natom,3*natom)= contain
!! the displacements of atoms in cartesian coordinates.
!! The first index means either the real or the imaginary part,
!! The second index runs on the direction and the atoms displaced
!! The third index runs on the modes.
!! filnam=name of output files
!! hacmm1,hartev,harthz,xkb= different conversion factors
!! natom= number of atom
!! phfrq(3*natom)= phonon frequencies in Hartree
!! qphon(3)=phonon wavevector
!! udispl=unit number for output of phonon eigendisplacements
!! ufreq=unit number for output of phonon frequencies
!!
!! OUTPUT
!! (only writing ?)
!!
!! NOTES
!! Called by one processor only
!!
!! PARENTS
!! mkphbs,thm9
!!
!! CHILDREN
!!
!! SOURCE
#if defined HAVE_CONFIG_H
#include "config.h"
#endif
subroutine sortph(displ,filnam, natom,phfrq,qphon,udispl,ufreq)
use defs_basis
use defs_datatypes
use defs_abitypes
implicit none
!Arguments -----------------------------------
!scalars
integer,intent(in) :: natom,udispl,ufreq
character(len=fnlen),intent(in) :: filnam
!arrays
complex(dp),intent(in) :: displ(3*natom,3*natom)
real(dp),intent(in) :: phfrq(3*natom),qphon(3)
!Local variables-------------------------------
!scalars
integer :: iatom,imode,j,i(1)
character(len=fnlen) :: file_displ,file_freq
!arrays
logical :: mask(3*natom)
real(dp) :: phfrqNew(3*natom)
complex(dp) :: displNew(3*natom,3*natom)
complex(dp) :: transpose_displ(3*natom,3*natom)
real(dp) :: abs_similarity(3*natom,3*natom) !|<displNew|displLast>|
complex(dp),allocatable,save :: displLast(:,:)
! *********************************************************************
write(6, '(a)' )' sortph : enter '
if(.not.allocated(displLast)) then
file_freq = trim(filnam)//".freq" !---------------------------------------------------
write(6, '(a,a)' )' sortph : opening file ',trim(file_freq)
open(ufreq,FILE=trim(file_freq),STATUS='replace',ACCESS='sequential',ACTION='write')
write(6, '(a,a,a)' )' sortph : file ',trim(file_freq),' opened '
file_displ = trim(filnam)//".displ" !--------------------------------------------------
write(6, '(a,a)' )' sortph : opening file ',trim(file_displ)
open(udispl,FILE=trim(file_displ),STATUS='replace',ACCESS='sequential',ACTION='write')
write(6, '(a,a,a)' )' sortph : file ',trim(file_displ),' opened '
allocate(displLast(3*natom,3*natom)) !---------------------------------------
phfrqNew(:) = phfrq(:)
displNew(:,:) = displ(:,:)
else
!Avoid gfortran 4.2.1 bug, with which you CANNOT conjg(transpose(displ))
transpose_displ = transpose(displ)
abs_similarity = abs(matmul(conjg(transpose_displ),displLast))
mask(:) = .true.
do j = 1, 3*natom
i(:) = maxloc( abs_similarity(:,j), mask(:) )
mask(i(1)) = .false.
phfrqNew(j) = phfrq(i(1))
displNew(:,j) = displ(:,i(1))
end do
endif
! Write frequencies in a file
! CE FORMAT DOIT ETRE REECRIT CAR CAS PARTICULIER 3*natom=15
write(ufreq,'(15(5d14.6))') (phfrqNew(j),j=1,3*natom)
! write displacements in a file
do imode=1,3*natom
do iatom=1,natom
write(udispl,'(d14.6)') &
sqrt( displNew(3*(iatom-1)+1,imode)* &
& conjg(displNew(3*(iatom-1)+1,imode)) + &
& displNew(3*(iatom-1)+2,imode)* &
& conjg(displNew(3*(iatom-1)+2,imode)) + &
& displNew(3*(iatom-1)+3,imode)* &
& conjg(displNew(3*(iatom-1)+3,imode)) )
end do
end do
displLast(:,:) = displNew(:,:)
write(6, '(a)' )' sortph : exit '
end subroutine sortph
!!***
Code: Select all
--- 72_response/phfrq3.F90~ 2010-05-16 05:54:52.000000000 +0900
+++ 72_response/phfrq3.F90 2010-07-10 11:07:29.421562936 +0900
@@ -331,20 +331,20 @@
end do
end do
end do
-
-!Get the phonon displacements
- do imode=1,3*natom
- do idir1=1,3
- do ipert1=1,natom
- i1=idir1+(ipert1-1)*3
- index=i1+3*natom*(imode-1)
- displ(2*index-1)=eigvec(2*index-1)&
-& / sqrt(amu(typat(ipert1))*amu_emass)
- displ(2*index )=eigvec(2*index )&
-& / sqrt(amu(typat(ipert1))*amu_emass)
- end do
- end do
- end do
+displ=eigvec
+! !Get the phonon displacements
+! do imode=1,3*natom
+! do idir1=1,3
+! do ipert1=1,natom
+! i1=idir1+(ipert1-1)*3
+! index=i1+3*natom*(imode-1)
+! displ(2*index-1)=eigvec(2*index-1)&
+! & / sqrt(amu(typat(ipert1))*amu_emass)
+! displ(2*index )=eigvec(2*index )&
+! & / sqrt(amu(typat(ipert1))*amu_emass)
+! end do
+! end do
+! end do
end subroutine phfrq3
!!***