3
0
mirror of https://github.com/triqs/dft_tools synced 2024-08-29 07:22:01 +02:00

First import. triqs 1.0 alpha1

This commit is contained in:
Olivier Parcollet 2013-07-23 19:49:42 +02:00
commit 0e585ad9b4
52 changed files with 16481 additions and 0 deletions

23
CMakeLists.txt Normal file
View File

@ -0,0 +1,23 @@
# Append triqs installed files to the cmake load path
list(APPEND CMAKE_MODULE_PATH ${TRIQS_PATH}/share/triqs/cmake)
# start configuration
cmake_minimum_required(VERSION 2.8)
project(ctseg CXX Fortran)
set(CMAKE_BUILD_TYPE Release)
enable_testing()
# Load TRIQS, including all predefined variables from TRIQS installation
find_package(TRIQS)
if (NOT ${TRIQS_WITH_PYTHON_SUPPORT})
MESSAGE(FATAL_ERROR "Wien2TRIQS require Python support in TRIQS")
endif()
# We want to be installed in the TRIQS tree
set(CMAKE_INSTALL_PREFIX ${TRIQS_PATH})
add_subdirectory(fortran/dmftproj)
add_subdirectory(fortran/F90)
add_subdirectory(python)
add_subdirectory(test)

View File

@ -0,0 +1,3 @@
triqs_build_f2py_module( triqs_DFT vertex vertex.pyf vertex.f90)
install (FILES ${CMAKE_CURRENT_BINARY_DIR}/vertex.so DESTINATION ${TRIQS_PYTHON_LIB_DEST}/applications/dft)

226
fortran/F90/vertex.f90 Normal file
View File

@ -0,0 +1,226 @@
SUBROUTINE u4ind(u_out,rcl,l,N,TM)
IMPLICIT NONE
INTEGER,INTENT(in) :: l,N
COMPLEX*16, DIMENSION(N,N), INTENT(in) :: TM !Transformation Matrix
DOUBLE PRECISION, DIMENSION(2*l+1,2*l+1,2*l+1,2*l+1) :: uc
!double precision, dimension(N,N,N,N), intent(out) :: u_out
COMPLEX*16, DIMENSION(N,N,N,N), INTENT(out) :: u_out
DOUBLE PRECISION, DIMENSION(N,N,N,N) :: u_tmp
DOUBLE PRECISION, DIMENSION(l+1), INTENT(in) :: rcl
INTEGER :: mmax,k,k2p1,ms1,ms2,ms3,ms4,ms5,ms6,ms7,ms8
INTEGER :: sp,ms1sig,ms2sig,ms3sig,ms4sig
INTEGER :: xk,xm1,xm2,xm3,xm,xm4
DOUBLE PRECISION :: cgk0,cgk1,cgk2,yor(7,7),yoi(7,7)
COMPLEX*16 :: am1,am2,am3,am4
!external cgk, ctormt
!WRITE(*,*)l,N
mmax=2*l+1
IF ((N==mmax).OR.(N==2*mmax)) THEN
! dimensions are fine:
uc=0.d0
DO k = 0, 2*l, 2
k2p1 = k/2 + 1
cgk0 = cgk(l,0,k,0,l,0)
DO ms1 = 1,mmax
xm1 = (ms1-l-1)
DO ms2 = 1,mmax
xm2 = (ms2-l-1)
DO ms3 = 1,mmax
xm3 = (ms3-l-1)
xm = xm1 - xm3
DO ms4 = 1,mmax
IF ((ms1+ms2-ms3-ms4).NE.0) CYCLE
xm4 = (ms4-l-1)
cgk1 = cgk(l,xm3,k,xm,l,xm1)
cgk2 = cgk(l,xm2,k,xm,l,xm4)
uc(ms1,ms2,ms3,ms4) = uc(ms1,ms2,ms3,ms4) + rcl(k2p1)*cgk0*cgk0*cgk1*cgk2
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
u_tmp = 0.d0
sp = (N/mmax)-1
! Now construct the big u matrix:
! expand in spins:
DO ms1=1,mmax
DO ms1sig =0,sp
DO ms2=1,mmax
DO ms2sig=0,sp
DO ms3 = 1,mmax
DO ms3sig = 0,sp
DO ms4 = 1,mmax
DO ms4sig = 0,sp
IF ((ms1sig==ms3sig).AND.(ms2sig==ms4sig)) THEN
u_tmp(ms1sig*mmax+ms1,ms2sig*mmax+ms2,ms3sig*mmax+ms3,ms4sig*mmax+ms4) = uc(ms1,ms2,ms3,ms4)
ENDIF
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
!call ctormt()
! Transformation:
!write(*,*)'TEST'
u_out = 0.d0
DO ms1=1,N
DO ms2=1,N
DO ms3=1,N
DO ms4=1,N
DO ms5=1,N
am1 = CONJG(TM(ms1,ms5)) !cmplx(yor(ms1,ms5),-yoi(ms1,ms5))
DO ms6=1,N
am2 = CONJG(TM(ms2,ms6)) !cmplx(yor(ms2,ms6),-yoi(ms2,ms6))
DO ms7=1,N
am3 = TM(ms3,ms7) !cmplx(yor(ms3,ms7),yoi(ms3,ms7))
DO ms8=1,N
am4 = TM(ms4,ms8) !cmplx(yor(ms4,ms8),yoi(ms4,ms8))
u_out(ms1,ms2,ms3,ms4) = u_out(ms1,ms2,ms3,ms4) + am1*am2*am3*am4 * u_tmp(ms5,ms6,ms7,ms8)
ENDDO
ENDDO
ENDDO
ENDDO
!if (abs(u_out(ms1,ms2,ms3,ms4))>0.0001d0) then
! write(*,*)ms1,ms2,ms3,ms4, u_out(ms1,ms2,ms3,ms4)
!endif
ENDDO
ENDDO
ENDDO
ENDDO
ELSE
WRITE(*,*)"N and l does not fit together: N=2l+1 or 2*(2l+1)!"
ENDIF
CONTAINS
SUBROUTINE ctormt
IMPLICIT NONE
DOUBLE PRECISION :: sqtwo, sq54, sq34
yor=0.d0
yoi=0.d0
sqtwo=1.d0/SQRT(2.d0)
sq54=SQRT(5.d0)/4d0
sq34=SQRT(3.d0)/4d0
IF (l.EQ.0) THEN
yor(1,1)=1.d0
ELSEIF (l.EQ.1) THEN
yor(1,1)= sqtwo
yor(1,3)=-sqtwo
yor(2,2)=1.d0
yoi(3,1)= sqtwo
yoi(3,3)= sqtwo
ELSEIF (l.EQ.2) THEN
!yoi(1,1)= sqtwo
!yoi(1,5)=-sqtwo
!yoi(2,2)= sqtwo
!yoi(2,4)= sqtwo
!yor(3,3)=1.d0
!yor(4,2)= sqtwo
!yor(4,4)=-sqtwo
!yor(5,1)= sqtwo
!yor(5,5)= sqtwo
! Wien2K matrix:
yor(3,1) = -sqtwo
yor(3,5) = sqtwo
yor(5,2) = sqtwo
yor(5,4) = sqtwo
yor(1,3) = 1.d0
yor(4,2) = sqtwo
yor(4,4) = -sqtwo
yor(2,1) = sqtwo
yor(2,5) = sqtwo
ELSEIF (l.EQ.3) THEN
yoi(1,2)=sqtwo
yoi(1,6)=-sqtwo
yor(2,1)=-sq54
yor(2,3)=sq34
yor(2,5)=-sq34
yor(2,7)=sq54
yoi(3,1)=-sq54
yoi(3,3)=-sq34
yoi(3,5)=-sq34
yoi(3,7)=-sq54
yor(4,4)=1.d0
yor(5,1)=-sq34
yor(5,3)=-sq54
yor(5,5)=sq54
yor(5,7)=sq34
yoi(6,1)=sq34
yoi(6,3)=-sq54
yoi(6,5)=-sq54
yoi(6,7)=sq34
yor(7,2)=sqtwo
yor(7,6)=sqtwo
ENDIF
END SUBROUTINE ctormt
DOUBLE PRECISION FUNCTION cgk(a,al,b,be,c,ga)
IMPLICIT NONE
INTEGER :: a,al,b,be,c,ga
INTEGER :: z,zmin,zmax,i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12,i13
DOUBLE PRECISION :: fa(0:20), fac
fa = (/1.d0, 1.d0, 2.d0, 6.d0, 24.d0, 12.d1, 72.d1, 504.d1,&
4032.d1, 36288.d1, 36288.d2, 399168.d2, 4790016.d2,&
62270208.d2, 871782912.d2, 1307674368.d3, 20922789888.d3,&
355687428096.d3, 6402373705728.d3, 121645100408832.d3,243290200817664.d4/)
i1=0
i2=(a+b-c)
i3=(a-al)
i4=(b+be)
i5=(c-b+al)
i6=(c-a-be)
zmin=MAX(i1,-i5,-i6)
zmax=MIN(i2, i3, i4)
cgk=0.d0
IF (ABS(al).GT.a) RETURN
IF (ABS(be).GT.b) RETURN
IF (ABS(ga).GT.c) RETURN
IF ( zmin.GT.zmax ) RETURN
IF ( (al+be).NE.ga ) RETURN
i7=(a-b+c)
i8=(c+b-a)
i9=(c+b+a)
i10=(a+al)
i11=(b-be)
i12=(c+ga)
i13=(c-ga)
DO z=zmin,zmax
IF (MOD(z,2)==0) THEN
fac = 1.d0
ELSE
fac=-1.d0
ENDIF
cgk=cgk+fac/(fa(z)*fa(i2-z)*fa(i3-z)*fa(i4-z)*fa(i5+z)* fa(i6+z))
ENDDO
cgk=cgk*SQRT(fa(i2)*fa(i7)*fa(i8)*fa(i10)*fa(i3)*fa(i4)*fa(i11)*fa(i12)*fa(i13)*(2.d0*c+1.d0)/fa(i9+1))
END FUNCTION cgk
END SUBROUTINE u4ind

17
fortran/F90/vertex.pyf Normal file
View File

@ -0,0 +1,17 @@
! -*- f90 -*-
! Note: the context of this file is case sensitive.
python module vertex ! in
interface ! in :vertex
subroutine u4ind(u_out,rcl,l,n,tm) ! in :vertex:vertex.f90
complex*16 dimension(n,n,n,n),intent(out),depend(n,n,n,n) :: u_out
double precision dimension(l + 1),intent(in) :: rcl
integer optional,intent(in),check((len(rcl)-1)>=l),depend(rcl) :: l=(len(rcl)-1)
integer optional,intent(in),check(shape(tm,0)==n),depend(tm) :: n=shape(tm,0)
complex*16 dimension(n,n),intent(in) :: tm
end subroutine u4ind
end interface
end python module vertex
! This file was auto-generated with f2py (version:1).
! See http://cens.ioc.ee/projects/f2py2e/

View File

@ -0,0 +1,33 @@
# List the sources
set (SOURCES modules dmftproj readcomline set_ang_trans setsym
set_rotloc timeinv read_k_list set_projections orthogonal
rot_projectmat density symmetrize_mat rot_dens
orthogonal_wannier outputqmc outbwin outband)
# add the extension and the path
FOREACH(f ${SOURCES} )
set(S "${CMAKE_CURRENT_SOURCE_DIR}/${f}.f;${S}")
ENDFOREACH(f)
# The main target and what to link with...
add_executable(dmftproj ${S})
target_link_libraries(dmftproj ${TRIQS_LIBRARY_LAPACK} )
# where to install
install (TARGETS dmftproj DESTINATION bin )
# that is it !
SET( D ${CMAKE_CURRENT_SOURCE_DIR}/SRC_templates/)
SET(WIEN_SRC_TEMPL_FILES ${D}/case.cf_f_mm2 ${D}/case.cf_p_cubic ${D}/case.indmftpr ${D}/run_triqs ${D}/runsp_triqs)
# build the fortran stuff...
message(STATUS "-----------------------------------------------------------------------------")
message(STATUS " ******** WARNING ******** ")
message(STATUS " Wien2k users : after installation of TRIQS, copy the files from ")
message(STATUS " ${CMAKE_INSTALL_PREFIX}/share/triqs/Wien2k_SRC_files/SRC_templates ")
message(STATUS " to your Wien2k installation WIENROOT/SRC_templates (Cf documentation). ")
message(STATUS " This is not handled automatically by the installation process. ")
message(STATUS "-----------------------------------------------------------------------------")
install (FILES ${WIEN_SRC_TEMPL_FILES} DESTINATION share/triqs/Wien2k_SRC_files/SRC_templates )

View File

@ -0,0 +1,14 @@
0. 0. 0. 0. 0. 0. 1. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0.
*0. 0. 0.70710678 0. 0. 0. 0. 0. 0. 0. 0.70710678 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. A1
*0. 0. 0. 0.70710678 0. 0. 0. 0. 0. 0. 0. -.70710678 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. A2
0. 0.70710678 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0.70710678 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0.
*0. 0. 0. 0. 0. 0.70710678 0. 0. 0. 0.70710678 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. B1
0.70710678 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. -.70710678 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0.
*0. 0. 0. 0. 0.70710678 0. 0. 0. -.70710678 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. B2
0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 1. 0. 0. 0. 0. 0. 0. 0.
*0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0.70710678 0. 0. 0. 0. 0. 0. 0. 0.70710678 0. 0. 0. A1
*0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0.70710678 0. 0. 0. 0. 0. 0. 0. -.70710678 0. 0. A2
0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0.70710678 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0.70710678
*0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0.70710678 0. 0. 0. 0.70710678 0. 0. 0. 0. B1
0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0.70710678 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. -.70710678 0.
*0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0. 0.70710678 0. 0. 0. -.70710678 0. 0. 0. 0. 0. B2

View File

@ -0,0 +1,7 @@
0.707106781 0. 0. 0. -0.707106781 0. 0. 0. 0. 0. 0. 0.
0. 0.707106781 0. 0. 0. 0.707106781 0. 0. 0. 0. 0. 0.
*0. 0. 1. 0. 0. 0. 0. 0. 0. 0. 0. 0.
0. 0. 0. 0. 0. 0. 0.707106781 0. 0. 0. -0.707106781 0.
0. 0. 0. 0. 0. 0. 0. 0.707106781 0. 0. 0. 0.707106781
*0. 0. 0. 0. 0. 0. 0. 0. 1. 0. 0. 0.

View File

@ -0,0 +1,16 @@
3 ! Nsort
1 1 3 ! Mult(Nsort)
3 ! lmax
complex ! choice of angular harmonics
1 1 0 0 ! l included for each sort
0 0 0 0 ! If split into ireps, gives number of ireps. for a given orbital (otherwise 0)
cubic ! choice of angular harmonics
1 1 2 0 ! l included for each sort
0 0 2 0 ! If split into ireps, gives number of ireps. for a given orbital (otherwise 0)
01 !
0 ! SO flag
complex ! choice of angular harmonics
1 1 0 0 ! l included for each sort
0 0 0 0 ! If split into ireps, gives number of ireps. for a given orbital (otherwise 0)
-0.6 0.14 ! t2g + eg + Op

View File

@ -0,0 +1,784 @@
#!/bin/csh -f
hup
unalias rm
unalias mv
set name = $0
set bin = $name:h #directory of WIEN-executables
if !(-d $bin) set bin = .
set name = $name:t #name of this script-file
set logfile = :log
set tmp = (:$name) #temporary files
set scratch = # set directory for vectors and help files
if ($?SCRATCH) then #if envronment SCRATCH is set
set scratch=`echo $SCRATCH | sed -e 's/\/$//'`/ #set $scratch to that value
endif
#---> functions & subroutines
alias testinput 'set errin="\!:1";if (! -e \!:1 || -z \!:1) goto \!:2'
alias teststatus 'if ($status) goto error'
alias testerror 'if (! -z \!:1.error) goto error'
alias teststop 'if (\!:1 == $stopafter ) goto stop'
alias cleandayfile 'grep -v "\[" $dayfile >.tmp;'\
'mv .tmp $dayfile'
alias output 'set date = `date +"(%T)"`;'\
'printf "> %s\t%s " "\!:*" "$date" >> $dayfile'
alias exec '($bin/x \!:*) >> $dayfile;'\
'teststatus'
alias total_exec 'output \!:*;'\
'exec \!:*;'\
'cleandayfile;'\
'testerror \!:1;'\
'teststop \!:1'
alias TOTtoFOR 'sed "s/TOT/FOR/" \!:1 > $tmp;'\
'mv $tmp \!:1'
alias FORtoTOT 'sed "s/FOR/TOT/" \!:1 > $tmp;'\
'mv $tmp \!:1'
alias IPRINT_inc 'sed "s/0 NUMBER/1 NUMBER/g" \!:1 > .case.inc;'\
'mv .case.inc \!:1'
#---> default parameters
set ccut = 0.0000 #upper limit for charge convergence
set fcut = 0 #upper limit for force convergence
set ecut = 0.0001 #upper limit for energy convergence
unset ec_conv
set cc_conv
set fc_conv
set ec_test
unset ec_test1
unset cc_test
unset fc_test
set iter = 40 #maximum number of iterations
set riter = 99 #restart after $riter iterations
set stopafter #stop after $stopafter
set next #set -> start cycle with $next
set qlimit = 0.05 #set -> writes E-L in new in1 when qlimit is fulfilled
set in1new = 999
set write_all = -ef # new default: -in1ef is activated (version 10.1)
set para
set nohns
set nohns1 = 0
set it
set readHinv
set it0
unset vec2pratt
set itnum=0
set itnum1=0
set so
set complex
set complex2
set cmplx
set cmplx2
set broyd
set ctest=(0 0 0)
set etest=(0 0 0)
set msrcount=0
# QDMFT
set qdmft
set hf
set diaghf
set nonself
set noibz
set newklist
set redklist
set NSLOTS = 1
# END QDMFT
#---> default flags
unset renorm
set in1orig
unset force #set -> force-calculation after self-consistency
unset f_not_conv
unset help #set -> help output
unset init #set -> switches initially set to total energy calc.
#---> handling of input options
echo "> ($name) options: $argv" >> $logfile
alias sb 'shift; breaksw' #definition used in switch
while ($#argv)
switch ($1)
case -[H|h]:
set help; sb
case -so:
set complex2 = c
set cmplx2 = -c
set so = -so; sb
case -nohns:
set nohns = -nohns; shift; set nohns1 = $1;sb
case -it:
set itnum = 99; set it = -it; set it0 = -it; sb
case -it1:
set itnum = 99; set it = -it; set it0 = -it; touch .noHinv; sb
case -it2:
set itnum = 99; set it = -it; set it0 = -it; touch .fulldiag; sb
case -noHinv:
set itnum = 99; set it = -it; set it0 = -it; set readHinv = -noHinv; sb
case -vec2pratt:
set vec2pratt; sb
case -p:
set para = -p; sb
case -I:
set init; sb
case -NI:
unset broyd; sb
case -e:
shift; set stopafter = $1; sb
case -cc:
shift; set ccut = $1; set cc_test;unset cc_conv; sb
case -ec:
shift; set ecut = $1; set ec_test1;unset ec_conv; sb
case -fc:
shift; set f_not_conv; set fcut = $1; set fc_test;unset fc_conv; sb
case -ql:
shift; set qlimit = $1; sb
case -in1ef:
set in1new = -1;set write_all = -ef; sb
case -in1new:
shift; set in1new = $1;set write_all; sb
case -in1orig:
set in1orig = -in1orig; set in1new = 999; sb
case -renorm:
set renorm; set next=scf1; sb
case -i:
shift; set iter = $1; sb
case -r:
shift; set riter = $1; sb
case -s:
shift; set next = $1; sb
# QDMFT
case -qdmft:
set qdmft=-qdmft; set NSLOTS = $1; sb
# END QDMFT
case -hf:
set hf = -hf; sb
case -diaghf:
set diaghf = -diaghf; set hf = -hf; set iter = 1; sb
case -nonself:
set nonself = -nonself; set hf = -hf; set iter = 1; sb
case -noibz:
set noibz = -noibz; sb
case -newklist:
set newklist = -newklist; set hf = -hf; sb
case -redklist:
set redklist = -redklist; set hf = -hf; sb
default:
echo "ERROR: option $1 does not exist \!"; sb
endsw
end
if ($?help) goto help
if($?cc_test) then
unset ec_test;set ec_conv
endif
if($?fc_test) then
unset ec_test;set ec_conv
endif
if($?ec_test1) then
set ec_test;unset ec_conv
endif
if(! $?ec_test) then
set ecut=0
endif
#---> path- and file-names
set file = `pwd`
set file = $file:t #tail of file-names
set dayfile = $file.dayfile #main output-file
#---> starting out
printf "\nCalculating $file in `pwd`\non `hostname` with PID $$\n" > $dayfile
echo "using `cat $WIENROOT/VERSION` in $WIENROOT" >> $dayfile
printf "\n:LABEL1: Calculations in `pwd`\n:LABEL2: on `hostname` at `date`\n" >> $file.scf
echo ":LABEL3: using `cat $WIENROOT/VERSION` in $WIENROOT" >> $file.scf
if ( "$so" == "-so" && "$hf" == "-hf") then
echo "Hartree-Fock and spin-orbit coupling not supported yet. STOP"
echo "Hartree-Fock and spin-orbit coupling not supported yet. STOP" >> $file.dayfile
exit 9
endif
if ( "$hf" == "-hf") then
if (-e $file.corewf) rm $file.corewf
IPRINT_inc $file.inc #modify IPRINT switch in case.inc
endif
#---> complex
if ((-e $file.in1c) && !(-z $file.in1c)) then
set complex = c
set complex2 = c
set cmplx = -c
set cmplx2 = -c
endif
set vresp
testinput $file.inm_vresp no_vresp
set vresp=-vresp
no_vresp:
# set iter/riter to 999 when MSR1a/MSECa is used
set testmsr=`head -1 $file.inm | grep "MSR[12]a" | cut -c1-3`
set testmsr1=`head -1 $file.inm | grep "MSECa" | cut -c1-5`
if($testmsr1 == 'MSECa') set testmsr=MSR
if ($testmsr == 'MSR') then
if($riter == "99") set riter=999
if($iter == "40") set iter=999
foreach i ($file.in2*)
TOTtoFOR $i #switch FOR-label
echo changing TOT to FOR in $i
end
if (! -e $file.inM && ! -z $file.inM ) then
x pairhess
echo $file.inM and .minrestart have been created by pairhess >>$dayfile
endif
endif
if ($next != "") goto start #start with optional program
set next = lapw0 #default start with lstart
if !(-e $file.clmsum) then
if (-e $file.clmsum_old) then
cp $file.clmsum_old $file.clmsum
else
echo 'no' $file'.clmsum(_old) file found, which is necessary for lapw0 \!'
echo 'no' $file'.clmsum(_old) file found, which is necessary for lapw0 \!'\
>>$dayfile
goto error
endif
endif
if ($?broyd) then
if (-e $file.broyd1) then
echo "$file.broyd* files present \! You did not save_lapw a previous clculation."
echo "You have 60 seconds to kill this job ( ^C or kill $$ )"
echo "or the script will rm *.broyd* and continue (use -NI to avoid automatic rm)"
sleep 60
rm *.broyd*
echo "$file.broyd* files removed \!" >> $dayfile
endif
endif
start: #initalization of in2-files
if ($?init && $testmsr != 'MSR' ) then
foreach i ($file.in2*)
sed "1s/[A-Z]..../TOT /" $i > $tmp
mv $tmp $i
end
endif
set icycle=1
set riter_save=$riter
printf "\n\n start \t(%s) " "`date`" >> $dayfile
#goto mixer only if clmval file is present
if ($next == "scf1") then
if !(-e $file.clmval) then
set next = lapw0
endif
endif
echo "with $next ($iter/$riter to go)" >> $dayfile
goto $next
cycle: #begin of sc-cycle
nohup echo in cycle $icycle " ETEST: $etest[3] CTEST: $ctest[3]"
hup
if ($it == '-it' ) then
set ittest=`echo "$icycle / $itnum * $itnum "| bc`
if ( $ittest == $icycle ) touch .fulldiag
endif
lapw0:
printf "\n cycle $icycle \t(%s) \t(%s)\n\n" "`date`" "$iter/$riter to go" >> $dayfile
testinput $file.in0_grr cont_lapw0
total_exec lapw0 -grr $para
cont_lapw0:
testinput $file.in0 error_input
total_exec lapw0 $para
if ($fcut == "0") goto lapw1
set f_exist=`grep :FHF $file.scf0`
if ($#f_exist == 0 ) then
set fcut=0
set fc_conv
echo Force-convergence not possible. Forces not present.
echo Force-convergence not possible. Forces not present.>> $dayfile
if($?ec_test) goto lapw1
if($?cc_test) goto lapw1
goto error
endif
#---> test of force-convergence for all forces
if !(-e $file.scf) goto lapw1
if(! $?ec_conv) goto lapw1
if(! $?cc_conv) goto lapw1
set natom=`head -2 $file.struct |tail -1 |cut -c28-30`
#set natom = `grep UNITCELL $file.output0 |awk '{print $NF}'`
set iatom = 1
set ftest = (1 0)
grep :FOR $file.scf >test_forces.scf
while ($iatom <= $natom) #cycle over all atoms
set itest=$iatom
@ itest ++
testinput $file.inM cont_force_test
set atest=`head -$itest $file.inM |tail -1`
set itest=`echo " $atest[1] + $atest[2] + $atest[3]"|bc`
if ( $itest == '0' ) goto skipforce
cont_force_test:
if ($iatom <= 9) then
set test = (`$bin/testconv -p :FOR00$iatom -c $fcut -f test_forces`)
else if ($iatom <= 99) then
set test = (`$bin/testconv -p :FOR0$iatom -c $fcut -f test_forces`)
else
set test = (`$bin/testconv -p :FOR$iatom -c $fcut -f test_forces`)
endif
if !($test[1]) set ftest[1] = 0
set ftest[2] = $test[2]
set ftest = ($ftest $test[3] $test[4])
skipforce:
@ iatom ++
end
rm test_forces.scf
echo ":FORCE convergence:" $ftest[1-] >> $dayfile
if ($ftest[1]) then #force convergenced
if ($nohns == '-nohns') then
set nohns
echo "NOHNS deactivated by FORCE convergence" >> $dayfile
else
# set iter = 1
if(! $?ec_conv) goto lapw1
if(! $?cc_conv) goto lapw1
set fc_conv
unset f_not_conv
foreach i ($file.in2*)
TOTtoFOR $i #switch FOR-label
end
endif
else
unset fc_conv
endif
lapw1:
testinput $file.in1$complex error_input
#generates in1-file from :EPL/EPH in case.scf2
# if ($icycle == $in1new) rm $file.broyd1 $file.broyd2
if ($icycle >= $in1new ) then
if (! -e $file.in1${complex}_orig ) cp $file.in1${complex} $file.in1${complex}_orig
write_in1_lapw $write_all -ql $qlimit $cmplx >> $dayfile
if($status == 0 ) cp $file.in1${complex}new $file.in1${complex}
endif
if($in1orig == '-in1orig') then
if ( -e $file.in1${complex}_orig ) mv $file.in1${complex}_orig $file.in1${complex}
# unset in1orig
endif
set readHinv0 = $readHinv
if (-e .noHinv) then
echo " case.storeHinv files removed"
set readHinv0 = -noHinv0
rm .noHinv
endif
if (-e .fulldiag) then
echo " full diagonalization forced"
set it0
set readHinv0
rm .fulldiag
endif
if ( $it0 == "-it" ) then
touch ${scratch}$file.vector.old
if( ! $?vec2pratt ) then
foreach i (${scratch}$file.vector*.old)
rm $i
end
vec2old_lapw $para >> $dayfile
else
vec2pratt_lapw $para >> $dayfile
endif
endif
if ( $hf == "-hf" ) then
if ((-e $file.vectorhf) && !(-z $file.vectorhf)) then
mv $file.vectorhf $file.vectorhf_old
if (!(-e $file.weighhf) || (-z $file.weighhf)) mv $file.energyhf $file.tmp_energyhf
else if ((-e $file.vectorhf_old) && !(-z $file.vectorhf_old)) then
if (!(-e $file.weighhf) || (-z $file.weighhf)) mv $file.energyhf $file.tmp_energyhf
else
cp $file.kgen_fbz $file.kgen
cp $file.klist_fbz $file.klist
total_exec lapw1 $it0 $nohns $readHinv0 $cmplx
mv $file.vector $file.vectorhf_old
mv $file.energy $file.tmp_energyhf
if (-e $file.weighhf) rm $file.weighhf
endif
cp $file.kgen_ibz $file.kgen
cp $file.klist_ibz $file.klist
if (!(-e $file.vsp_old) || (-z $file.vsp_old)) then
cp $file.vsp $file.vsp_old
endif
endif
total_exec lapw1 $it0 $para $nohns $readHinv0 $cmplx
set it0 = $it
set readHinv0 = $readHinv
lapwso:
if ( -e $file.scfso ) rm $file.scfso
if ( "$so" == "-so" ) then
testinput $file.inso error_input
total_exec lapwso $para $cmplx
endif
lapw2:
testinput $file.in2$complex2 error_input
if ( $hf == "-hf" ) then
if (!(-e $file.weighhf) || (-z $file.weighhf)) then
cp $file.kgen_fbz $file.kgen
cp $file.klist_fbz $file.klist
if (-e $file.vector) mv $file.vector $file.vector_save
mv $file.vectorhf_old $file.vector
if (-e $file.energy) mv $file.energy $file.energy_save
mv $file.tmp_energyhf $file.energy
total_exec lapw2 $vresp $in1orig $cmplx2
mv $file.weigh $file.weighhf
mv $file.vector $file.vectorhf_old
if (-e $file.vector_save) mv $file.vector_save $file.vector
mv $file.energy $file.energyhf
if (-e $file.energy_save) mv $file.energy_save $file.energy
cp $file.kgen_ibz $file.kgen
cp $file.klist_ibz $file.klist
endif
endif
#QDMFT
if ( "$qdmft" == "-qdmft" ) then
total_exec lapw2 $para $vresp -almd $cmplx2 $so
dmftproj $so # please check: $so can't be here
# pytriqs call
printf "\n> ERROR: Insert a correct call of pytriqs (with mpi wrapper, if needed) in run_triqs Wien2k script\n" >> $dayfile
printf "\n> stop\n" >> $dayfile
printf "\n> ERROR: Insert a correct call of pytriqs (with mpi wrapper, if needed) in run_triqs Wien2k script\n"
exit 0
# to call pytriqs uncomment and modify the line below to adapt it to your system
# the number of core is in NSLOTS variable
#mpprun --force-mpi=openmpi/1.3.2-i110074 /home/x_leopo/TRIQS_segment/triqs_install/bin/pytriqs $file.py
total_exec lapw2 $para $vresp -qdmft $cmplx2 $so
else
total_exec lapw2 $para $vresp $in1orig $cmplx2 $so
if ( $hf == "-hf" ) then
sed 's/:SUM/:SLSUM/g' < $file.scf2 > $file.scf2_tmp
mv $file.scf2_tmp $file.scf2
mv $file.clmval $file.clmvalsl
if ( -e $file.scfhf_1 ) rm $file.scfhf_*
endif
endif
# END QDMFT
rm -f $file.clmsc
if ( $hf == "-hf" ) goto hf
lapw1s:
testinput $file.in1${complex}s lcore
total_exec lapw1 -sc $para $nohns $readHinv $cmplx
lapw2s:
testinput $file.in2${complex2}s error_input
total_exec lapw2 -sc $para $vresp $in1orig $cmplx2
goto lcore
hf:
testinput $file.inhf error_input
if (!(-e $file.corewf) || (-z $file.corewf)) then
total_exec lcore
endif
total_exec hf $diaghf $nonself $noibz $newklist $redklist $para $cmplx
lapw2hf:
testinput $file.in2$complex2 error_input
cp $file.kgen_fbz $file.kgen
cp $file.klist_fbz $file.klist
total_exec lapw2 -hf $vresp $in1orig $cmplx2
cp $file.kgen_ibz $file.kgen
cp $file.klist_ibz $file.klist
lcore:
testinput $file.inc scf
total_exec lcore
coresuper:
if ( ! -e .lcore) goto scf
total_exec dstart -lcore
rm -f $file.clmcor
endif
scf:
if ( $hf == "-hf" ) then
foreach i ( 0 0_grr 1 so 2 1s 2s c hf 2hf )
if (-e $file.scf$i) cat $file.scf$i >> $file.scf
end
else
foreach i ( 0 1 so 2 1s 2s c )
if (-e $file.scf$i) cat $file.scf$i >> $file.scf
end
endif
scf1:
foreach i (clmsum vsp vns vrespsum )
if (-e $file.$i ) \
cp $file.$i $file.${i}_old #save last cycle
end
mixer:
testinput $file.inm error_input
total_exec mixer
cat $file.scfm >> $file.scf
if($?renorm) then
unset renorm
rm $file.broy*
endif
mixer_vresp:
testinput $file.inm_vresp energytest
total_exec mixer_vresp
grep -e "CTO " -e NEC $file.outputm_vresp | sed 's/:/:VRESP/' >> $file.scf
#total_exec int16
energytest:
#---> output energies
#set EF = `grep 'F E R' $file.scf2 |awk '{printf("%.5f", $NF)}'`
#set ET = `grep 'AL EN' $file.outputm |awk '{printf("%.5f", $NF)}'`
#cat << theend >> $dayfile
#EF $EF
#ET $ET
#theend
#echo $ET > $file.finM
#---> test of energy convergence
#if ($ecut == "0") goto chargetest
set etest = (`$bin/testconv -p :ENE -c $ecut`)
teststatus
echo ":ENERGY convergence: $etest[1-3]" >> $dayfile
if (! $?ec_test) goto chargetest
if ($etest[1]) then
if ($nohns == '-nohns') then
set nohns
echo "NOHNS deactivated by ENERGY convergence" >> $dayfile
else
# set iter = 1
set ec_conv
endif
else
unset ec_conv
endif
chargetest:
#if ($ccut == "0.0000") goto nextiter
set ctest = (`$bin/testconv -p :DIS -c $ccut`)
teststatus
echo ":CHARGE convergence: $ctest[1-3]" >> $dayfile
if (! $?cc_test) goto nextiter
if ($ctest[1]) then
if ($nohns == '-nohns') then
set nohns
echo "NOHNS deactivated by CHARGE convergence" >> $dayfile
else
# set iter = 1
set cc_conv
endif
else
unset cc_conv
endif
# check F-condition for MSR1a mode
if ($testmsr == 'MSR') then
set msrtest =(`grep :FRMS $file.scf |tail -1` )
if ($#msrtest >= 13 ) then
echo msrcount $msrcount msrtest $msrtest[13]
# Trap silly early convergene with "minimum-requests"
set etest2 = (`$bin/testconv -p :ENE -c 0.001`)
if ( $etest2[1] == '0')set msrtest[13]='F'
set ctest2 = (`$bin/testconv -p :DIS -c 0.01`)
if ( $ctest2[1] == '0')set msrtest[13]='F'
#
if ($msrtest[13] == 'T') then
#change in case.inm MSR1a/MSECa to MSR1/MSEC3, rm *.bro*, unset testmsr
@ msrcount ++
if($msrcount == 3) then
sed "1s/MSR1a/MSR1 /" $file.inm >$file.inm_tmp
sed "1s/MSECa/MSEC3/" $file.inm_tmp >$file.inm
rm *.broy* $file.inm_tmp
set a=`grep -e GREED *scfm | tail -1 | cut -c 50-55`
set b=`echo "scale=5; if( $a/2 > 0.05) $a/2 else 0.05 " |bc -l`
echo $b > .msec
echo "MSR1a/MSECa changed to MSR1/MSEC3 in $file.inm, relaxing only electrons" >> $dayfile
set testmsr
endif
else
set msrcount=0
endif
endif
endif
#---> output forces
#grep 'FTOT' $file.outputm|awk '{print "FT ",$2,$4,$5,$6}'\
# >> $dayfile
#grep 'FTOT' $file.outputm|awk '{print $4,$5,$6}' \
# >> $file.finM
nextiter:
@ iter --
@ riter --
@ nohns1 --
@ icycle ++
if ($icycle == 2) set newklist
#---> nohns
if (! $nohns1 ) then
set nohns
echo "NOHNS deactivated" >> $dayfile
endif
#---> restart
if (! $riter && -e $file.broyd1) then
echo " restart" >> $dayfile
rm $file.broyd1 $file.broyd2
set riter=$riter_save
endif
foreach i ($tmp) #delete temporary files
if (-e $i) rm $i
end
#output cycle
#printf "%s\n\n" "$iter/$riter to go" >> $dayfile
if (-e .stop) goto stop1
if ($testmsr == 'MSR' && -e .minstop) then
sed "1s/MSR1a/MSR1 /" $file.inm >$file.inm_tmp
sed "1s/MSECa/MSEC3/" $file.inm_tmp >$file.inm
rm *.broy* $file.inm_tmp
set a=`grep -e GREED *scfm | tail -1 | cut -c 50-55`
set b=`echo "scale=5; if( $a/2 > 0.05) $a/2 else 0.05 " |bc -l`
echo $b > .msec
echo "MSR1a/MSECa changed to MSR1/MSEC3 in $file.inm, relaxing only electrons" >> $dayfile
set testmsr
endif
echo ec cc and fc_conv $?ec_conv $?cc_conv $?fc_conv
echo ec cc and fc_conv $?ec_conv $?cc_conv $?fc_conv >> $dayfile
if($?ec_conv && $?cc_conv && $?fc_conv && ($testmsr == '') ) goto stop
if ($iter) goto cycle #end of sc-cycle
if ( $?f_not_conv ) then
printf "\n> FORCES NOT CONVERGED\n" >> $dayfile
printf "\n> stop\n" >> $dayfile
printf "\n> FORCES NOT CONVERGED\n"
exit 3
endif
if ( ! $?ec_conv ) then
printf "\n> energy in SCF NOT CONVERGED\n" >> $dayfile
printf "\n> stop\n" >> $dayfile
printf "\n> energy in SCF NOT CONVERGED\n"
exit 0
endif
if ( ! $?cc_conv ) then
printf "\n> charge in SCF NOT CONVERGED\n" >> $dayfile
printf "\n> stop\n" >> $dayfile
printf "\n> charge in SCF NOT CONVERGED\n"
exit 0
endif
stop: #normal exit
printf "\n> stop\n" >> $dayfile
printf "\n> stop\n"
exit 0
stop1: #normal exit
printf "\n> stop due to .stop file\n" >> $dayfile
rm .stop
printf "\n> stop due to .stop file\n"
exit 1
error_input: #error exit
printf "\n> stop error: the required input file $errin for the next step could not be found\n" >> $dayfile
printf "\n> stop error: the required input file $errin for the next step could not be found\n"
exit 9
error: #error exit
printf "\n> stop error\n" >> $dayfile
printf "\n> stop error\n"
exit 9
help: #help exit
cat << theend
PROGRAM: $0
PURPOSE: running the nonmagnetic scf-cycle in WIEN
to be called within the case-subdirectory
has to be located in WIEN-executable directory
USAGE: $name [OPTIONS] [FLAGS]
OPTIONS:
-cc LIMIT -> charge convergence LIMIT (0.0001 e)
-ec LIMIT -> energy convergence LIMIT ($ecut Ry)
-fc LIMIT -> force convergence LIMIT (1.0 mRy/a.u.)
default is -ec 0.0001; multiple convergence tests possible
-e PROGRAM -> exit after PROGRAM ($stopafter)
-i NUMBER -> max. NUMBER ($iter) of iterations
-s PROGRAM -> start with PROGRAM ($next)
-r NUMBER -> restart after NUMBER ($riter) iterations (rm *.broyd*)
-nohns NUMBER ->do not use HNS for NUMBER iterations
-in1new N -> create "new" in1 file after N iter (write_in1 using scf2 info)
-ql LIMIT -> select LIMIT ($qlimit) as min.charge for E-L setting in new in1
-qdmft NP -> including DMFT from Aichhorn/Georges/Biermann running on NP proc
FLAGS:
-h/-H -> help
-I -> with initialization of in2-files to "TOT"
-NI -> does NOT remove case.broyd* (default: rm *.broyd* after 60 sec)
-p -> run k-points in parallel (needs .machine file [speed:name])
-it -> use iterative diagonalization
-it1 -> use iterative diag. with recreating H_inv (after basis change)
-it2 -> use iterative diag. with reinitialization (after basis change)
-noHinv -> use iterative diag. without H_inv
-vec2pratt -> use vec2pratt instead of vec2old for iterative diag.
-so -> run SCF including spin-orbit coupling
-renorm-> start with mixer and renormalize density
-in1orig-> if present, use case.in1_orig file; do not modify case.in1
-hf -> HF/hybrid-DFT calculation
-diaghf -> non-selfconsistent HF with diagonal HF only (only e_i)
-nonself -> non-selfconsistent HF/hybrid-DFT calculation (only E_x(HF))
-newklist -> HF/hybrid-DFT calculation starting from a different k-mesh
-redklist -> HF/hybrid-DFT calculation with a reduced k-mesh for the potential
CONTROL FILES:
.lcore runs core density superposition producing case.clmsc
.stop stop after SCF cycle
.minstop stops MSR1a minimization and changes to MSR1
.fulldiag force full diagonalization
.noHinv remove case.storeHinv files
case.inm_vresp activates calculation of vresp files for meta-GGAs
case.in0_grr activates a second call of lapw0 (mBJ pot., or E_xc analysis)
ENVIRONMENT VARIBLES:
SCRATCH directory where vectors and help files should go
theend
exit 1

View File

@ -0,0 +1,975 @@
#!/bin/csh -f
hup
unalias rm
set name = $0
set bin = $name:h #directory of WIEN-executables
if !(-d $bin) set bin = .
set name = $name:t #name of this script-file
set logfile = :log
set tmp = (:$name) #temporary files
set scratch = # set directory for vectors and help files
if ($?SCRATCH) then #if envronment SCRATCH is set
set scratch=`echo $SCRATCH | sed -e 's/\/$//'`/ #set $scratch to that value
endif
#---> functions & subroutines
alias testinput 'set errin="\!:1";if (! -e \!:1 || -z \!:1) goto \!:2'
alias teststatus 'if ($status) goto error'
alias testerror 'if ( -e \!:1.error && ! -z \!:1.error) goto error'
alias teststop 'if (\!:1 == $stopafter ) goto stop'
alias cleandayfile 'grep -v "\[" $dayfile >.tmp;'\
'mv .tmp $dayfile'
alias output 'set date = `date +"(%T)"`;'\
'printf "> %s\t%s " "\!:*" "$date" >> $dayfile'
alias exec '($bin/x \!:*) >> $dayfile;'\
'teststatus'
alias total_exec 'output \!:*;'\
'exec \!:*;'\
'cleandayfile;'\
'testerror \!:1;'\
'testerror up\!:1;'\
'testerror dn\!:1;'\
'teststop \!:1'
alias TOTtoFOR 'sed "s/TOT/FOR/" \!:1 > $tmp;'\
'mv $tmp \!:1'
alias FORtoTOT 'sed "s/FOR/TOT/" \!:1 > $tmp;'\
'mv $tmp \!:1'
alias IPRINT_inc 'sed "s/0 NUMBER/1 NUMBER/g" \!:1 > $tmp;'\
'mv $tmp \!:1'
#---> default parameters
set ccut = 0.0000 #upper limit for charge convergence
set fcut = 0 #upper limit for force convergence
set ecut = 0.0001 #upper limit for energy convergence
unset ec_conv
set cc_conv
set fc_conv
set ec_test
unset ec_test1
unset cc_test
unset fc_test
set iter = 40 #maximum number of iterations
set riter = 99 #restart after $riter iterations
set stopafter #stop after $stopafter
set next #set -> start cycle with $next
set qlimit = 0.05 #set -> writes E-L in new in1 when qlimit is fulfilled
set in1new = 999
set write_all = -ef # new default: -in1ef is activated (version 10.1)
set para
set nohns
set nohns1 = 0
set it
set readHinv
unset vec2pratt
set it0
set itnum=0
set itnum1=0
set complex
set complex2
set cmplx
set cmplx2
set so
set orb
set broyd
set eece1
unset eece
unset orbc
unset orbdu
unset dm
set ctest=(0 0 0)
set etest=(0 0 0)
set msrcount=0
# QDMFT
set qdmft
set hf
set diaghf
set nonself
set noibz
set newklist
set redklist
set NSLOTS = 1
# END QDMFT
#---> default flags
unset renorm
set in1orig
unset force #set -> force-calculation after self-consistency
unset f_not_conv
unset help #set -> help output
#unset complex #set -> complex calculation
unset init #set -> switches initially set to total energy calc.
unset lcore #set -> core density superposition
#---> handling of input options
echo "> ($name) options: $argv" >> $logfile
alias sb 'shift; breaksw' #definition used in switch
while ($#argv)
switch ($1)
case -[H|h]:
set help; sb
case -so:
set complex2 = c
set cmplx2 = -c
set so = -so; sb
case -nohns:
set nohns = -nohns; shift; set nohns1 = $1;sb
case -dm:
set dm; sb
case -orb:
set orb = -orb; sb
case -orbc:
set orbc
set orb = -orb; sb
case -eece:
set eece
set eece1 = -eece
set orbc
set orb = -orb; sb
case -orbdu:
set orbdu
set orb = -orb; sb
case -it:
set itnum = 99; set it = -it; set it0 = -it; sb
case -it1:
set itnum = 99; set it = -it; set it0 = -it; touch .noHinv; sb
case -it2:
set itnum = 99; set it = -it; set it0 = -it; touch .fulldiag; sb
case -noHinv:
set itnum = 99; set it = -it; set it0 = -it; set readHinv = -noHinv; sb
case -vec2pratt:
set vec2pratt; sb
case -p:
set para = -p; sb
case -I:
set init; sb
case -NI:
unset broyd; sb
case -e:
shift; set stopafter = $1; sb
case -cc:
shift; set ccut = $1; set cc_test;unset cc_conv; sb
case -ec:
shift; set ecut = $1; set ec_test1;unset ec_conv; sb
case -fc:
shift; set f_not_conv; set fcut = $1; set fc_test;unset fc_conv; sb
case -ql:
shift; set qlimit = $1; sb
case -in1ef:
set in1new = -1;set write_all = -ef; sb
case -in1new:
shift; set in1new = $1;set write_all; sb
case -in1orig:
set in1orig = -in1orig; set in1new = 999; sb
case -renorm:
set renorm; set next=scf1; sb
case -i:
shift; set iter = $1; sb
case -r:
shift; set riter = $1; sb
case -s:
shift; set next = $1; sb
# QDMFT
case -qdmft:
set qdmft=-qdmft; shift; set NSLOTS = $1; sb
# END QDMFT
case -hf:
set hf = -hf; sb
case -diaghf:
set diaghf = -diaghf; set hf = -hf; set iter = 1; sb
case -nonself:
set nonself = -nonself; set hf = -hf; set iter = 1; sb
case -noibz:
set noibz = -noibz; sb
case -newklist:
set newklist = -newklist; set hf = -hf; sb
case -redklist:
set redklist = -redklist; set hf = -hf; sb
default:
echo "ERROR: option $1 does not exist\!"; sb
endsw
end
if ($?help) goto help
if($?cc_test) then
unset ec_test;set ec_conv
endif
if($?fc_test) then
unset ec_test;set ec_conv
endif
if($?ec_test1) then
set ec_test;unset ec_conv
endif
if(! $?ec_test) then
set ecut=0
endif
#---> path- and file-names
set file = `pwd`
set file = $file:t #tail of file-names
set dayfile = $file.dayfile #main output-file
#---> starting out
printf "\nCalculating $file in `pwd`\non `hostname` with PID $$\n" > $dayfile
echo "using `cat $WIENROOT/VERSION` in $WIENROOT" >> $dayfile
printf "\n:LABEL1: Calculations in `pwd`\n:LABEL2: on `hostname` at `date`\n" >> $file.scf
echo ":LABEL3: using `cat $WIENROOT/VERSION` in $WIENROOT" >> $file.scf
if ( "$so" == "-so" && "$hf" == "-hf") then
echo "Hartree-Fock and spin-orbit coupling not supported yet. STOP"
echo "Hartree-Fock and spin-orbit coupling not supported yet. STOP" >> $file.dayfile
exit 9
endif
if ( "$hf" == "-hf") then
if (-e $file.corewfup) rm $file.corewfup
if (-e $file.corewfdn) rm $file.corewfdn
IPRINT_inc $file.inc # modify IPRINT switch in case.inc
if ( ! -z $file.incup && -e $file.incup ) then
IPRINT_inc $file.incup
IPRINT_inc $file.incdn
endif
endif
#---> complex
if ((-e $file.in1c) && !(-z $file.in1c)) then
set complex = c
set complex2 = c
set cmplx = -c
set cmplx2 = -c
endif
set vresp
testinput $file.inm_vresp no_vresp
set vresp=-vresp
no_vresp:
# set iter/riter to 999 when MSR1a/MSECa is used
set testmsr=`head -1 $file.inm | grep "MSR[12]a" | cut -c1-3`
set testmsr1=`head -1 $file.inm | grep "MSECa" | cut -c1-5`
if($testmsr1 == 'MSECa') set testmsr=MSR
if ($testmsr == 'MSR') then
if($riter == "99") set riter=999
if($iter == "40") set iter=999
foreach i ($file.in2*)
TOTtoFOR $i #switch FOR-label
echo changing $i
end
if (! -e $file.inM && ! -z $file.inM ) then
x pairhess
echo $file.inM and .minrestart have been created by pairhess >>$dayfile
endif
endif
if ($next != "") goto start #start with optional program
set next = lapw0 #default start with lstart
if !(-e $file.clmsum) then
if (-e $file.clmsum_old) then
cp $file.clmsum_old $file.clmsum
else
echo 'no' $file'.clmsum(_old) file found, which is necessary for lapw0 \!'
echo 'no' $file'.clmsum(_old) file found, which is necessary for lapw0 \!'\
>>$dayfile
goto error
endif
endif
if ($?broyd) then
if (-e $file.broyd1) then
echo "$file.broyd* files present \! You did not save_lapw a previous clculation."
echo "You have 60 seconds to kill this job ( ^C or kill $$ )"
echo "or the script will rm *.broyd* and continue (use -NI to avoid automatic rm)"
sleep 60
rm *.broyd*
echo "$file.broyd* files removed \!" >> $dayfile
endif
endif
start: #initalization of in2-files
if ($?init && $testmsr != 'MSR') then
foreach i ($file.in2*)
sed "1s/[A-Z]..../TOT /" $i > $tmp
mv $tmp $i
end
endif
set icycle=1
set riter_save=$riter
printf "\n\n start \t(%s) " "`date`" >> $dayfile
#goto mixer only if clmval file is present
if ($next == "scf1") then
if !(-e $file.clmvalup) then
set next = lapw0
endif
endif
echo "with $next ($iter/$riter to go)" >> $dayfile
goto $next
cycle: #begin of sc-cycle
nohup echo in cycle $icycle " ETEST: $etest[3] CTEST: $ctest[3]"
hup
if ($it == '-it' ) then
set ittest=`echo "$icycle / $itnum * $itnum "| bc`
if ( $ittest == $icycle ) touch .fulldiag
endif
lapw0:
printf "\n cycle $icycle \t(%s) \t(%s)\n\n" "`date`" "$iter/$riter to go" >> $dayfile
testinput $file.in0_grr cont_lapw0
total_exec lapw0 -grr $para
cont_lapw0:
testinput $file.in0 error_input
#fix for NFS bug
touch $file.vspup $file.vspdn $file.vnsup $file.vnsdn
rm $file.vspup $file.vspdn $file.vnsup $file.vnsdn
total_exec lapw0 $para
if ($fcut == "0") goto orb
set f_exist=`grep :FHF $file.scf0`
if ($#f_exist == 0 ) then
set fcut=0
set fc_conv
echo Force-convergence not possible. Forces not present.
echo Force-convergence not possible. Forces not present.>> $dayfile
if($?ec_test) goto orb
if($?cc_test) goto orb
goto error
endif
#---> test of force-convergence for all forces
if !(-e $file.scf) goto orb
if(! $?ec_conv) goto orb
if(! $?cc_conv) goto orb
set natom=`head -2 $file.struct |tail -1 |cut -c28-30`
#set natom = `grep UNITCELL $file.output0 |awk '{print $NF}'`
set iatom = 1
set ftest = (1 0)
grep :FOR $file.scf >test_forces.scf
while ($iatom <= $natom) #cycle over all atoms
set itest=$iatom
@ itest ++
testinput $file.inM cont_force_test
set atest=`head -$itest $file.inM |tail -1`
set itest=`echo " $atest[1] + $atest[2] + $atest[3]"|bc`
if ( $itest == '0' ) goto skipforce
cont_force_test:
if ($iatom <= 9) then
set test = (`$bin/testconv -p :FOR00$iatom -c $fcut -f test_forces`)
else if ($iatom <= 99) then
set test = (`$bin/testconv -p :FOR0$iatom -c $fcut -f test_forces`)
else
set test = (`$bin/testconv -p :FOR$iatom -c $fcut -f test_forces`)
endif
if !($test[1]) set ftest[1] = 0
set ftest[2] = $test[2]
set ftest = ($ftest $test[3] $test[4])
skipforce:
@ iatom ++
end
rm test_forces.scf
echo ":FORCE convergence:" $ftest[1-] >> $dayfile
if ($ftest[1]) then #force convergenced
if ($nohns == '-nohns') then #force convergenced
set nohns
echo "NOHNS deactivated by FORCE convergence" >> $dayfile
else
# set iter = 1
if(! $?ec_conv) goto orb
if(! $?cc_conv) goto orb
set fc_conv
unset f_not_conv
foreach i ($file.in2*)
TOTtoFOR $i #switch FOR-label
end
endif
else
unset fc_conv
endif
orb:
foreach i (dmatup dmatdn dmatud )
if (-e $file.$i"_old" ) rm $file.$i"_old"
if (-e $file.$i ) cp $file.$i $file.$i"_old" #save this cycle for next
end
if ( -e $file.scforbup ) rm $file.scforbup
if ( -e $file.scforbdn ) rm $file.scforbdn
if ( -e $file.scforbdu ) rm $file.scforbdu
if ( -e $file.vorbdu ) rm $file.vorbdu
if ( "$orb" != "-orb" ) goto lapw1
if ( $?orbc ) goto lapw1
if (! -e $file.dmatup || -z $file.dmatup ) then
set renorm
goto lapw1
endif
testinput $file.inorb error_input
total_exec orb -up $para
total_exec orb -dn $para
if ( "$so" == "-so" && ! -z $file.dmatud && -e $file.dmatud ) then
if( $?orbdu ) then
total_exec orb -du $para
# vorbdu seems unphysical large, so we use it only with -orbdu switch)
endif
endif
lapw1:
testinput $file.in1$complex error_input
set readHinv0 = $readHinv
if (-e .noHinv) then
echo " case.storeHinv files removed"
set readHinv0 = -noHinv0
rm .noHinv
endif
if (-e .fulldiag) then
echo " full diagonalization forced"
set it0
set readHinv0
rm .fulldiag
touch ${scratch}$file.vector.old
rm ${scratch}$file.vector*.old
endif
if ( $it0 == "-it" ) then
touch ${scratch}$file.vector.old
if( ! $?vec2pratt ) then
foreach i (${scratch}$file.vector*.old)
rm $i
end
vec2old_lapw $para -up >> $dayfile
vec2old_lapw $para -dn >> $dayfile
else
vec2pratt_lapw $para -up >> $dayfile
vec2pratt_lapw $para -dn >> $dayfile
endif
endif
if ( -e dnlapw1.error ) rm dnlapw1.error
if ( $hf == "-hf" ) then
if ((-e $file.vectorhfup) && !(-z $file.vectorhfup) && \
(-e $file.vectorhfdn) && !(-z $file.vectorhfdn)) then
mv $file.vectorhfup $file.vectorhfup_old
mv $file.vectorhfdn $file.vectorhfdn_old
if (!(-e $file.weighhfup) || (-z $file.weighhfup) || \
!(-e $file.weighhfdn) || (-z $file.weighhfdn)) then
mv $file.energyhfup $file.tmp_energyhfup
mv $file.energyhfdn $file.tmp_energyhfdn
endif
else if ((-e $file.vectorhfup_old) && !(-z $file.vectorhfup_old) && \
(-e $file.vectorhfdn_old) && !(-z $file.vectorhfdn_old)) then
if (!(-e $file.weighhfup) || (-z $file.weighhfup) || \
!(-e $file.weighhfdn) || (-z $file.weighhfdn)) then
mv $file.energyhfup $file.tmp_energyhfup
mv $file.energyhfdn $file.tmp_energyhfdn
endif
else
cp $file.kgen_fbz $file.kgen
cp $file.klist_fbz $file.klist
total_exec lapw1 $it0 -up $nohns $readHinv0 $cmplx
total_exec lapw1 $it0 -dn $nohns $readHinv0 $cmplx
mv $file.vectorup $file.vectorhfup_old
mv $file.vectordn $file.vectorhfdn_old
mv $file.energyup $file.tmp_energyhfup
mv $file.energydn $file.tmp_energyhfdn
if (-e $file.weighhfup) rm $file.weighhfup
if (-e $file.weighhfdn) rm $file.weighhfdn
endif
cp $file.kgen_ibz $file.kgen
cp $file.klist_ibz $file.klist
if (!(-e $file.vspup_old) || (-z $file.vspup_old) || \
!(-e $file.vspdn_old) || (-z $file.vspdn_old)) then
cp $file.vspup $file.vspup_old
cp $file.vspdn $file.vspdn_old
endif
endif
#generates in1-file from :EPL/EPH in case.scf2
# if ($icycle == $in1new) rm $file.broyd1 $file.broyd2
if ($icycle >= $in1new ) then
if (! -e $file.in1${complex}_orig ) cp $file.in1${complex} $file.in1${complex}_orig
write_in1_lapw $write_all -up -ql $qlimit ${cmplx} >> $dayfile
if($status == 0 ) cp $file.in1${complex}new $file.in1${complex}
endif
if($?in1orig == '-in1orig') then
if ( -e $file.in1${complex}_orig ) mv $file.in1${complex}_orig $file.in1${complex}
# unset in1orig
endif
if ( "$so" == "-so" ) then
total_exec lapw1 $it0 -up $para $nohns $readHinv0 $cmplx
else
total_exec lapw1 $it0 -up $para $nohns $orb $readHinv0 $cmplx
endif
if ($icycle >= $in1new ) then
write_in1_lapw $write_all -dn -ql $qlimit ${cmplx}>> $dayfile
if($status == 0 ) cp $file.in1${complex}new $file.in1${complex}
endif
if ( "$so" == "-so" ) then
total_exec lapw1 $it0 -dn $para $nohns $readHinv0 $cmplx
else
total_exec lapw1 $it0 -dn $para $nohns $orb $readHinv0 $cmplx
endif
set it0 = $it
set readHinv0 = $readHinv
lapwso:
if ( -e $file.scfso ) rm $file.scfso
if ( "$so" == "-so" ) then
testinput $file.inso error_input
total_exec lapwso -up $orb $para $cmplx
endif
lapw2:
testinput $file.in2$complex2 error_input
if ( -e dnlapw2.error ) rm dnlapw2.error
if ( $hf == "-hf" ) then
if (!(-e $file.weighhfup) || (-z $file.weighhfup) || \
!(-e $file.weighhfdn) || (-z $file.weighhfdn)) then
cp $file.kgen_fbz $file.kgen
cp $file.klist_fbz $file.klist
if (-e $file.vectorup) mv $file.vectorup $file.vectorup_save
if (-e $file.vectordn) mv $file.vectordn $file.vectordn_save
mv $file.vectorhfup_old $file.vectorup
mv $file.vectorhfdn_old $file.vectordn
if (-e $file.energyup) mv $file.energyup $file.energyup_save
if (-e $file.energydn) mv $file.energydn $file.energydn_save
mv $file.tmp_energyhfup $file.energyup
mv $file.tmp_energyhfdn $file.energydn
total_exec lapw2 -up $vresp $in1orig $cmplx2
total_exec lapw2 -dn $vresp $in1orig $cmplx2
mv $file.weighup $file.weighhfup
mv $file.weighdn $file.weighhfdn
mv $file.vectorup $file.vectorhfup_old
mv $file.vectordn $file.vectorhfdn_old
if (-e $file.vectorup_save) mv $file.vectorup_save $file.vectorup
if (-e $file.vectordn_save) mv $file.vectordn_save $file.vectordn
mv $file.energyup $file.energyhfup
mv $file.energydn $file.energyhfdn
if (-e $file.energyup_save) mv $file.energyup_save $file.energyup
if (-e $file.energydn_save) mv $file.energydn_save $file.energydn
cp $file.kgen_ibz $file.kgen
cp $file.klist_ibz $file.klist
endif
endif
#QDMFT
if ( "$qdmft" == "-qdmft" ) then
total_exec lapw2 -up $para $vresp -almd $cmplx2 $so
total_exec lapw2 -dn $para $vresp -almd $cmplx2 $so
dmftproj $so -sp
# pytriqs call
printf "\n> ERROR: Insert a correct call of pytriqs (with mpi wrapper, if needed) in runsp_triqs Wien2k script\n" >> $dayfile
printf "\n> stop\n" >> $dayfile
printf "\n> ERROR: Insert a correct call of pytriqs (with mpi wrapper, if needed) in runsp_triqs Wien2k script\n"
exit 0
# to call pytriqs uncomment and modify the line below to adapt it to your system
# the number of core is in NSLOTS variable
#mpprun --force-mpi=openmpi/1.3.2-i110074 /home/x_leopo/TRIQS_segment/triqs_install/bin/pytriqs $file.py
total_exec lapw2 -up $para $vresp -qdmft $cmplx2 $so
total_exec lapw2 -dn $para $vresp -qdmft $cmplx2 $so
else
total_exec lapw2 -up $para $vresp $in1orig $cmplx2 $so
total_exec lapw2 -dn $para $vresp $in1orig $cmplx2 $so
if ( $hf == "-hf" ) then
sed 's/:SUM/:SLSUM/g' < $file.scf2up > $file.scf2up_tmp
mv $file.scf2up_tmp $file.scf2up
mv $file.clmvalup $file.clmvalslup
if ( -e $file.scfhfup_1 ) rm $file.scfhfup_*
sed 's/:SUM/:SLSUM/g' < $file.scf2dn > $file.scf2dn_tmp
mv $file.scf2dn_tmp $file.scf2dn
mv $file.clmvaldn $file.clmvalsldn
if ( -e $file.scfhfdn_1 ) rm $file.scfhfdn_*
endif
endif
# END QDMFT
rm -f $file.clmscup $file.clmscdn
if ( $hf == "-hf" ) goto hf
lapwdm:
if ( -e $file.scfdmup ) rm $file.scfdmup
if ( -e $file.scfdmdn ) rm $file.scfdmdn
if ( ! $?dm ) then
if ( "$orb" != "-orb" ) goto lapw1s
if ( $?orbc ) goto lapw1s
endif
#if ( "$so" == "-so" ) goto lapwdmc
testinput $file.indm$complex2 error_input
if ( -e dnlapwdm.error ) rm dnlapwdm.error
total_exec lapwdm -up $para $cmplx2 $so
if ( "$so" != "-so" ) then
total_exec lapwdm -dn $para $cmplx2 $so
endif
lapw1s:
testinput $file.in1${complex}s lcore
total_exec lapw1 -sc -up $para $nohns $orb $readHinv0 $cmplx
total_exec lapw1 -sc -dn $para $nohns $orb $readHinv0 $cmplx
lapw2s:
testinput $file.in2${complex2}s error_input
total_exec lapw2 -sc -up $para $vresp $in1orig $cmplx2
total_exec lapw2 -sc -dn $para $vresp $in1orig $cmplx2
goto lcore
hf:
testinput $file.inhf error_input
if (-e dnhf.error) rm dnhf.error
if (!(-e $file.corewfup) || (-z $file.corewfup)) then
total_exec lcore -up
total_exec lcore -dn
endif
total_exec hf -up $diaghf $nonself $noibz $newklist $redklist $para $cmplx
total_exec hf -dn $diaghf $nonself $noibz $newklist $redklist $para $cmplx
lapw2hf:
testinput $file.in2$complex2 error_input
cp $file.kgen_fbz $file.kgen
cp $file.klist_fbz $file.klist
total_exec lapw2 -up -hf $vresp $in1orig $cmplx2
total_exec lapw2 -dn -hf $vresp $in1orig $cmplx2
cp $file.kgen_ibz $file.kgen
cp $file.klist_ibz $file.klist
lcore:
testinput $file.inc scf
if ( ! -z $file.incup && -e $file.incup ) then
cp $file.incup $file.inc
echo "spinpolarized $file.incup/dn used" >> $dayfile
endif
if ( -e dnlcore.error ) rm dnlcore.error
total_exec lcore -up
if ( ! -z $file.incdn && -e $file.incdn ) then
cp $file.incdn $file.inc
endif
total_exec lcore -dn
coresuper:
if ( ! -e .lcore) goto scf
total_exec dstart -lcore -up
total_exec dstart -lcore -dn
rm $file.clmcorup $file.clmcordn
scf:
if ( $hf == "-hf" ) then
foreach i ( 0 0_grr orbup orbdn orbdu 1up 1dn so 2up 2dn dmup dmdn 1sup 1sdn 2sup 2sdn cup cdn hfup hfdn 2hfup 2hfdn )
if (-e $file.scf$i) then
if ("$i" != "dmdn" || "$so" != "-so") cat $file.scf$i >> $file.scf
endif
end
else
foreach i ( 0 orbup orbdn orbdu 1up 1dn so 2up 2dn dmup dmdn 1sup 1sdn 2sup 2sdn cup cdn )
if (-e $file.scf$i) then
if ("$i" != "dmdn" || "$so" != "-so") cat $file.scf$i >> $file.scf
endif
end
endif
if ( $?eece ) then
mv $file.scf2up $file.scf2up-tmp
mv $file.scf2dn $file.scf2dn-tmp
if( $vresp == '-vresp' ) then
mv $file.vrespvalup $file.vrespvalup-tmp
mv $file.vrespvaldn $file.vrespvaldn-tmp
mv $file.vrespcorup $file.vrespcorup-tmp
mv $file.vrespcordn $file.vrespcordn-tmp
endif
foreach i ( vorbup vorbdn vorbdu )
if (-e $file.$i"_old" ) rm $file.$i"_old"
if (-e $file.$i ) cp $file.$i $file.$i"_old" #save last cycle
end
runeece_lapw $so $para $vresp
teststatus
foreach i (vorbup vorbdn vorbud )
if (-e $file.$i"_unmixed" ) rm $file.$i"_unmixed"
if (-e $file.$i ) cp $file.$i $file.$i"_unmixed" #save unmixed dmat
end
mv $file.scf2up $file.scf2upeece
mv $file.scf2dn $file.scf2dneece
mv $file.scf2up-tmp $file.scf2up
mv $file.scf2dn-tmp $file.scf2dn
if( $vresp == '-vresp' ) then
mv $file.vrespvalup $file.vrespvaleeceup
mv $file.vrespvaldn $file.vrespvaleecedn
mv $file.vrespvalup-tmp $file.vrespvalup
mv $file.vrespvaldn-tmp $file.vrespvaldn
mv $file.vrespcorup-tmp $file.vrespcorup
mv $file.vrespcordn-tmp $file.vrespcordn
endif
goto scf1
endif
foreach i (dmatup dmatdn dmatud )
if (-e $file.$i"_unmixed" ) rm $file.$i"_unmixed"
if (-e $file.$i ) cp $file.$i $file.$i"_unmixed" #save the unmixed dmat
end
scf1:
foreach i (clmsum clmup clmdn vspup vspdn vnsup vnsdn )
if (-e $file.$i ) cp $file.$i $file.$i"_old" #save last cycle
end
mixer:
testinput $file.inm error_input
if ( $?orbc ) then
total_exec mixer
else
total_exec mixer $eece1 $orb
endif
cat $file.scfm >> $file.scf
if($?renorm) then
unset renorm
rm $file.broy*
endif
mixer_vresp:
testinput $file.inm_vresp energytest
total_exec mixer_vresp
grep -e "CTO " -e NEC $file.outputm_vresp | sed 's/:/:VRESP/' >> $file.scf
#total_exec int16
energytest:
#---> output energies
#set EF = `grep 'F E R' $file.scf2 |awk '{printf("%.5f", $NF)}'`
#set ET = `grep 'AL EN' $file.outputm |awk '{printf("%.5f", $NF)}'`
#cat << theend >> $dayfile
#EF $EF
#ET $ET
#theend
#echo $ET > $file.finM
#---> test of energy convergence
#if ($ecut == "0") goto chargetest
set etest = (`$bin/testconv -p :ENE -c $ecut`)
teststatus
echo ":ENERGY convergence: $etest[1-3]" >> $dayfile
if (! $?ec_test) goto chargetest
if ($etest[1]) then
if ($nohns == '-nohns') then
set nohns
echo "NOHNS deactivated by ENERGY convergence" >> $dayfile
else
# set iter = 1
set ec_conv
endif
else
unset ec_conv
endif
chargetest:
#if ($ccut == "0") goto nextiter
set ctest = (`$bin/testconv -p :DIS -c $ccut`)
teststatus
echo ":CHARGE convergence: $ctest[1-3]" >> $dayfile
if (! $?cc_test) goto nextiter
if ($ctest[1]) then
if ($nohns == '-nohns') then
set nohns
echo "NOHNS deactivated by CHARGE convergence" >> $dayfile
else
# set iter = 1
set cc_conv
endif
else
unset cc_conv
endif
# check F-condition for MSR1a mode
if ($testmsr == 'MSR') then
set msrtest =(`grep :FRMS $file.scf |tail -1` )
if ($#msrtest >= 13 ) then
echo msrcount $msrcount msrtest $msrtest[13]
# Trap silly early convergene with "minimum-requests"
set etest2 = (`$bin/testconv -p :ENE -c 0.001`)
if ( $etest2[1] == '0')set msrtest[13]='F'
set ctest2 = (`$bin/testconv -p :DIS -c 0.01`)
if ( $ctest2[1] == '0')set msrtest[13]='F'
#
if ($msrtest[13] == 'T') then
#change in case.inm MSR1a/MSECa to MSR1/MSEC3, rm *.bro*, unset testmsr
@ msrcount ++
if($msrcount == 3) then
sed "1s/MSR1a/MSR1 /" $file.inm >$file.inm_tmp
sed "1s/MSECa/MSEC3/" $file.inm_tmp >$file.inm
rm *.broy* $file.inm_tmp
set a=`grep -e GREED *scfm | tail -1 | cut -c 50-55`
set b=`echo "scale=5; if( $a/2 > 0.05) $a/2 else 0.05 " |bc -l`
echo $b > .msec
echo "MSR1a/MSECa changed to MSR1/MSEC3 in $file.inm, relaxing only electrons" >> $dayfile
set testmsr
endif
else
set msrcount=0
endif
endif
endif
#---> output forces
#grep 'FTOT' $file.outputm|awk '{print "FT ",$2,$4,$5,$6}'\
# >> $dayfile
#grep 'FTOT' $file.outputm|awk '{print $4,$5,$6}' \
# >> $file.finM
nextiter:
@ iter --
@ riter --
@ nohns1 --
@ icycle ++
if ($icycle == 2) set newklist
#---> nohns
if (! $nohns1 ) then
set nohns
echo "NOHNS deactivated" >> $dayfile
endif
#---> restart
if (! $riter && -e $file.broyd1) then
echo " restart" >> $dayfile
rm $file.broyd1 $file.broyd2
set riter=$riter_save
endif
foreach i ($tmp) #delete temporary files
if (-e $i) rm $i
end
#output cycle
#printf "%s\n\n" "$iter/$riter to go" >> $dayfile
if (-e .stop) goto stop1
if ($testmsr == 'MSR' && -e .minstop) then
sed "1s/MSR1a/MSR1 /" $file.inm >$file.inm_tmp
sed "1s/MSECa/MSEC3/" $file.inm_tmp >$file.inm
rm *.broy* $file.inm_tmp
set a=`grep -e GREED *scfm | tail -1 | cut -c 50-55`
set b=`echo "scale=5; if( $a/2 > 0.05) $a/2 else 0.05 " |bc -l`
echo $b > .msec
echo "MSR1a/MSECa changed to MSR1/MSEC3 in $file.inm, relaxing only electrons" >> $dayfile
set testmsr
endif
if($?ec_conv && $?cc_conv && $?fc_conv && ($testmsr == '')) goto stop
if ($iter) goto cycle #end of sc-cycle
if ( $?f_not_conv ) then
printf "\n> FORCES NOT CONVERGED\n" >> $dayfile
printf "\n> stop\n" >> $dayfile
printf "\n> FORCES NOT CONVERGED\n"
exit 3
endif
if ( ! $?ec_conv ) then
printf "\n> energy in SCF NOT CONVERGED\n" >> $dayfile
printf "\n> stop\n" >> $dayfile
printf "\n> energy in SCF NOT CONVERGED\n"
exit 0
endif
if ( ! $?cc_conv ) then
printf "\n> charge in SCF NOT CONVERGED\n" >> $dayfile
printf "\n> stop\n" >> $dayfile
printf "\n> charge in SCF NOT CONVERGED\n"
exit 0
endif
stop: #normal exit
printf "\n> stop\n" >> $dayfile
printf "\n> stop\n"
exit 0
stop1: #normal exit
printf "\n> stop due to .stop file\n" >> $dayfile
if (-e .stop) rm .stop
printf "\n> stop due to .stop file\n"
exit 1
error_input: #error exit
printf "\n> stop error: the required input file $errin for the next step could not be found\n" >> $dayfile
printf "\n> stop error: the required input file $errin for the next step could not be found\n"
exit 9
error: #error exit
printf "\n> stop error\n" >> $dayfile
printf "\n> stop error\n"
exit 9
help: #help exit
cat << theend
PROGRAM: $0
PURPOSE: running the spinpolarized scf-cycle in WIEN
to be called within the case-directory
has to be located in '$WIENROOT' directory
USAGE: $name [OPTIONS] [FLAGS]
OPTIONS:
-cc LIMIT -> charge convergence LIMIT (0.0001 e)
-ec LIMIT -> energy convergence LIMIT ($ecut Ry)
-fc LIMIT -> force convergence LIMIT (1.0 mRy/a.u.)
default is -ec 0.0001; multiple convergence tests possible
-e PROGRAM -> exit after PROGRAM ($stopafter)
-i NUMBER -> max. NUMBER ($iter) of iterations
-s PROGRAM -> start with PROGRAM ($next)
-r NUMBER -> restart after NUMBER ($riter) iterations (rm *.broyd*)
-nohns NUMBER ->do not use HNS for NUMBER iterations
-in1new N -> create "new" in1 file after N iter (write_in1 using scf2 info)
-ql LIMIT -> select LIMIT ($qlimit) as min.charge for E-L setting in new in1
-qdmft NP -> including DMFT from Aichhorn/Georges/Biermann running on NP proc
FLAGS:
-h/-H -> help
-I -> with initialization of in2-files to "TOT"
-NI -> does NOT remove case.broyd* (default: rm *.broyd* after 60 sec)
-p -> run k-points in parallel (needs .machine file [speed:name])
-it -> use iterative diagonalization
-it1 -> use iterative diag. with recreating H_inv (after basis change)
-it2 -> use iterative diag. with reinitialization (after basis change)
-noHinv -> use iterative diag. without H_inv
-vec2pratt -> use vec2pratt instead of vec2old for iterative diag.
-so -> run SCF including spin-orbit coupling
-dm -> calculate the density matrix (when -so is set, but -orb is not)
-eece -> use "ecact exchange+hybrid" methods
-orb -> use LDA+U, OP or B-ext correction
-orbc -> use LDA+U correction, but with constant V-matrix
-orbdu -> use LDA+U with crossterms up-dn (needs also -so)
-renorm-> start with mixer and renormalize density
-in1orig-> if present, use case.in1_orig file; do not modify case.in1
-hf -> HF/hybrid-DFT calculation
-diaghf -> non-selfconsistent HF with diagonal HF only (only e_i)
-nonself -> non-selfconsistent HF/hybrid-DFT calculation (only E_x(HF))
-newklist -> HF/hybrid-DFT calculation starting from a different k-mesh
-redklist -> HF/hybrid-DFT calculation with a reduced k-mesh for the potential
CONTROL FILES:
.lcore runs core density superposition producing case.clmsc
.stop stop after SCF cycle
.minstop stops MSR1a minimization and changes to MSR1
.fulldiag force full diagonalization
.noHinv remove case.storeHinv files
case.inm_vresp activates calculation of vresp files for meta-GGAs
case.in0_grr activates a second call of lapw0 (mBJ pot., or E_xc analysis)
ENVIRONMENT VARIBLES:
SCRATCH directory where vectors and help files should go
theend
exit 1

1109
fortran/dmftproj/density.f Normal file

File diff suppressed because it is too large Load Diff

764
fortran/dmftproj/dmftproj.f Normal file
View File

@ -0,0 +1,764 @@
c ******************************************************************************
c
c TRIQS: a Toolbox for Research in Interacting Quantum Systems
c
c Copyright (C) 2011 by L. Pourovskii, V. Vildosola, C. Martins, M. Aichhorn
c
c TRIQS is free software: you can redistribute it and/or modify it under the
c terms of the GNU General Public License as published by the Free Software
c Foundation, either version 3 of the License, or (at your option) any later
c version.
c
c TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
c WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
c FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
c details.
c
c You should have received a copy of the GNU General Public License along with
c TRIQS. If not, see <http://www.gnu.org/licenses/>.
c
c *****************************************************************************/
PROGRAM dmftproj
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This prgm computes projections to a local (correlated) set of %%
C %% orbitals from the set of eigenfunctions obtained with Wien2k. %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE almblm_data
USE common_data
USE file_names
USE prnt
USE symm
USE reps
IMPLICIT NONE
C
REAL(KIND=8) :: e_win, e_sum, elecn, qtot, qdum
REAL(KIND=8), DIMENSION(:,:), ALLOCATABLE :: Alm_sum, Qlm_sum
COMPLEX(KIND=8), DIMENSION(:,:,:,:), ALLOCATABLE :: occ_mat
COMPLEX(KIND=8), DIMENSION(:,:,:,:), ALLOCATABLE :: occ_mat_sym
C
COMPLEX(KIND=8) :: coff
COMPLEX(KIND=8),DIMENSION(-3:3,-3:3) :: tmpmat
INTEGER, DIMENSION(:,:), ALLOCATABLE :: lnreps
INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: correps
INTEGER :: isrt, ie, l, m, isym, jatom
INTEGER :: lm, ik, ilo, ib, iatom, imu
INTEGER :: idum, i1, i2
INTEGER :: m1, m2, lm1, lm2
INTEGER :: is, irep, nbrep
INTEGER :: iorb, icrorb, nmaxrep
INTEGER :: paramflag, lcorr
LOGICAL :: ifcorr
REAL(KIND=8) :: fdum, rtetr
REAL(KIND=8),PARAMETER :: Elarge=1d6
C ================================
C Processing of the command line :
C ================================
CALL readcomline
C ====================================================
C Initialization of the variable ns (number of spin) :
C ====================================================
C If the computation uses spin-polarized input files, ns=2
ns=1
IF(ifSP) ns=2
C ===================================
C Opening of the input/output files :
C ===================================
CALL openfiles
C =========================================
C Reading of the input file case.indmftpr :
C =========================================
READ(iuinp,*)nsort
C nsort = number of sorts of atom
ALLOCATE(nmult(0:nsort))
nmult(0)=0
READ(iuinp,*)nmult(1:nsort)
C nmult = multiplicity for each sort of atom, table from 1 to nsort
natom=SUM(nmult(1:nsort))
C natom = total number of atoms in the unit cell
ALLOCATE(isort(natom))
iatom=0
DO isrt=1,nsort
DO imu=1,nmult(isrt)
iatom=iatom+1
isort(iatom)=isrt
ENDDO
ENDDO
C isort = table of correspondance iatom -> isort (from 1 to natom)
READ(iuinp,*)lmax
C lmax = maximal orbital number l for all the atoms
IF(ifSO) THEN
nlm=(lmax+1)*(lmax+1)*2
ELSE
nlm=(lmax+1)*(lmax+1)
ENDIF
C nlm = maximal number of matrix elements for an l-orbital
C only doubled when SO because of the up and down independent parts...
ALLOCATE(lsort(0:lmax,nsort))
ALLOCATE(defbasis(nsort))
ALLOCATE(lnreps(0:lmax,nsort))
IF(.not.ifSO) THEN
C Spin is a good quantum number and ireps are considered in orbital space only.
ALLOCATE(correps(2*lmax+1,0:lmax,nsort))
ELSE
C Spin is not a good quantum number anymore (possibility of basis which mixes up and dn states)
C the ireps are considered in spin+orbital space.
ALLOCATE(correps(2*(2*lmax+1),0:lmax,nsort))
ENDIF
ALLOCATE(ifSOflag(nsort))
DO isrt=1,nsort
READ(iuinp,*) defbasis(isrt)%typebasis
IF (defbasis(isrt)%typebasis(1:8)=='fromfile') THEN
READ(iuinp,*) defbasis(isrt)%sourcefile
ELSE
defbasis(isrt)%sourcefile = 'null'
ENDIF
C defbasis = table of correspondance isort -> "basistrans" element, table from 1 to nsort
C defbasis(isrt)%typebasis = "cubic", "complex" or "fromfile"
C defbasis(isrt)%sourcefile = the name of the file to read if typebasis="fromfile"
READ(iuinp,*)lsort(0:lmax,isrt)
READ(iuinp,*)lnreps(0:lmax,isrt)
C ifcorr is a flag who states if the atomic sort isrt has correlated orbitals.
ifcorr=.FALSE.
DO l=0,lmax
IF (lsort(l,isrt)==2) THEN
ifcorr=.TRUE.
C If lnreps(l,isrt)=1, the treatment is the same as a 0 value.
C because if the number of irep is 1, this irep will be the correlated one.
C
C ---------------------------------------------------------------------------------------
C Interruption of the prgm if the number of irep is not correct.
C -------------------------
C
IF (ifSO) THEN
C With SO, the number of ireps must not exceed 2*(2*l+1).
IF(lnreps(l,isrt).gt.(2*(2*l+1))) THEN
WRITE(buf,'(a,a,i2,a,i2,a)')' The number of ireps ',
& 'considered for l=',l,' and isrt=',isrt,
& ' is not possible.'
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
STOP
END IF
ELSE
C Without SO, the number of ireps must not exceed (2*l+1).
IF(lnreps(l,isrt).gt.(2*l+1)) THEN
WRITE(buf,'(a,a,i2,a,i2,a)')' The number of ireps ',
& 'considered for l=',l,' and isrt=',isrt,
& ' is not possible.'
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
STOP
END IF
ENDIF
C ---------------------------------------------------------------------------------------
C
C The description of the different ireps is considered only if there are more than 1 irep.
C that is to say if lnreps(l,isrt)=2, 3,...
IF(lnreps(l,isrt)>0) THEN
READ(iuinp,'(14i1)') correps(1:lnreps(l,isrt),l,isrt)
ENDIF
ENDIF
ENDDO
C The ifSO_flag is read only if there is a correlated orbital for the sort isrt.
IF (ifcorr) THEN
READ(iuinp,'(i1)') ifSOflag(isrt)
ENDIF
ENDDO
C lsort = index for each orbital (0 : not include / 1 : include / 2 : correlated), table from 0 to lmax, from 1 to nsort
C lnreps = number of irreducible representations for each orbital, table from 0 to lmax, from 1 to nsort (temporary variables)
C correps = index for each irreducible representations of the correlated orbital, table from 1 to lnreps(l,isrt), from 0 to lmax, from 1 to nsort (temporary variable)
C ifSOflag = table of correspondance isort -> optionSO (1 or 0). Only used for isort with correlated orbitals
READ(iuinp,*) e_bot,e_top
C e_bot, e_top : lower and upper limits of the energy window
C
C ---------------------------------------------------------------------------------------
C Interruption of the prgm if the energy window is not well-defined.
C -------------------------
C
IF(e_bot.gt.e_top) THEN
WRITE(buf,'(a,a)')' The energy window ',
& ' is ill-defined.'
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
STOP
END IF
C ---------------------------------------------------------------------------------------
C
C =====================================================================
C Writing in the output file case.outdmftpr the previous informations :
C =====================================================================
WRITE(buf,'(a,a)')'Welcome in DMFTPROJ: ',
& 'PROJECTION TO LOCALIZED BASIS'
CALL printout(1)
WRITE(buf,'(a,a)')'This prgm will build',
& ' the Wannier projectors to the'
CALL printout(0)
WRITE(buf,'(a,a)')'localized orbitals of an atom',
& ' onto which DMFT will be applied.'
CALL printout(1)
WRITE(buf,'(a)')'You are performing a computation'
CALL printout(0)
C Spin orbit option
IF(ifSO) THEN
WRITE(buf,'(a)')'in which Spin-Orbit is included.'
ELSE
WRITE(buf,'(a)')'without Spin-Orbit.'
ENDIF
CALL printout(0)
C Spin polarized option
IF(ifSP) THEN
WRITE(buf,'(a)')'using Spin-Polarized Wien2k input files.'
ELSE
WRITE(buf,'(a)')'using Paramagnetic Wien2k input files.'
ENDIF
CALL printout(0)
IF (ifSO.AND.(.not.ifSP)) THEN
WRITE(buf,'(a,a)')'You must use Spin-Polarized input files',
& ' to perform Spin-Orbit computation, with this version.'
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
STOP
ENDIF
C Printing nsort, nmult
WRITE(buf,'(a)')'======================================='
CALL printout(0)
WRITE(buf,'(a,i3)')'Sorts of atoms = ',nsort
CALL printout(0)
WRITE(buf,'(a,50i2)')'Equivalent sites per each sort:',
& nmult(1:nsort)
CALL printout(1)
C
norb=0
ncrorb=0
ALLOCATE(notinclude(1:nsort))
DO isrt=1,nsort
WRITE(buf,'(a)')'-------------------------------------'
CALL printout(0)
WRITE(buf,'(a,i2,a)')'For the sort ',isrt,' :'
CALL printout(0)
notinclude(isrt)=.TRUE.
C Printing the name of the included orbitals for each sort
DO l=0,lmax
IF(lsort(l,isrt).NE.0) THEN
WRITE(buf,'(a,i2,a)')'The orbital l=',l,' is included.'
CALL printout(0)
norb=norb+nmult(isrt)
notinclude(isrt)=.FALSE.
ENDIF
ENDDO
C The variable notinclude(isrt) is a boolean which precises whether the sort isrt
C is considered in the pbm. (whether there is at least one lsort(l,isrt) not 0.)
IF (notinclude(isrt)) THEN
WRITE(buf,'(a)')'No orbital is included.'
CALL printout(0)
CALL printout(0)
cycle
C If no orbital of isrt is included, they can't be correlated orbitals.
END IF
CALL printout(0)
C Determination of the total number of correlated orbitals for each sort
DO l=0,lmax
IF(lsort(l,isrt)==2) THEN
ncrorb=ncrorb+nmult(isrt)
ENDIF ! End of the lsort=2 if-then-else
ENDDO ! End of the l loop
ENDDO ! End of the isrt loop
C norb = total number of included orbitals in the system
C ncrorb = total number of correlated orbitals in the system
C
C ---------------------------------------------------------------------------------------
C Interruption of the prgm if no orbital is included.
C -------------------------
C
IF (norb==0) THEN
WRITE(buf,'(a,a)')'You must include at least one orbital.'
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
STOP
ENDIF
C ---------------------------------------------------------------------------------------
C
C ===========================================================================================
C Initialization of the "orbital-type" tables orb and crorb, tables of size norb and ncrorb :
C ===========================================================================================
ALLOCATE(orb(norb),crorb(ncrorb))
iorb=0
icrorb=0
DO isrt=1,nsort
IF (notinclude(isrt)) cycle
DO l=0,lmax
IF(lsort(l,isrt).NE.0) THEN
C -------------------------------
C For all the included orbitals :
C -------------------------------
DO imu=1,nmult(isrt)
iatom=SUM(nmult(0:isrt-1))+imu
iorb=iorb+1
orb(iorb)%atom=iatom
C the field orb%atom = number of the atom when classified in the order (isort,imult)
orb(iorb)%sort=isrt
C the field orb%sort = sort of the associated atom
orb(iorb)%l=l
C the field orb%l = the orbital number l
IF(imu==1) THEN
orb(iorb)%first=.TRUE.
ELSE
orb(iorb)%first=.FALSE.
ENDIF
C the field orb%first = boolean (if first_atom of the sort isort or not)
IF(lnreps(l,isrt).NE.0) THEN
orb(iorb)%ifsplit=.TRUE.
ELSE
orb(iorb)%ifsplit=.FALSE.
ENDIF
C the field orb%ifsplit = boolean (if ireps are used or not)
ENDDO
C
IF(lsort(l,isrt)==2) THEN
C ---------------------------------
C For all the correlated orbitals :
C ---------------------------------
DO imu=1,nmult(isrt)
iatom=SUM(nmult(0:isrt-1))+imu
icrorb=icrorb+1
crorb(icrorb)%atom=iatom
C the field crorb%atom = number of the atom when classified in the order (isort,imult)
crorb(icrorb)%sort=isrt
C the field crorb%sort = sort of the associated atom
crorb(icrorb)%l=l
C the field crorb%l = the orbital number l
IF(imu==1) THEN
crorb(icrorb)%first=.TRUE.
ELSE
crorb(icrorb)%first=.FALSE.
ENDIF
C the field orb%first = boolean (if first_atom of the sort isort or not)
IF(lnreps(l,isrt).NE.0) THEN
crorb(icrorb)%ifsplit=.TRUE.
ALLOCATE(crorb(icrorb)%correp(lnreps(l,isrt)))
crorb(icrorb)%correp=.FALSE.
DO irep=1,lnreps(l,isrt)
IF(correps(irep,l,isrt)==1)
& crorb(icrorb)%correp(irep)=.TRUE.
ENDDO
C the field crorb%correp is defined only when crorb%ifsplit= true
C the field orb%correp = boolean table of size lnreps(l,isrt) : True if the ireps is correlated, False otherwise
ELSE
crorb(icrorb)%ifsplit=.FALSE.
ENDIF
C the field orb%ifsplit = boolean (if ireps are used or not)
IF (ifSOflag(isrt)==1) THEN
crorb(icrorb)%ifSOat=1
ELSE
crorb(icrorb)%ifSOat=0
ENDIF
C the field crorb%ifSOflag = boolean (if SO are used or not)
ENDDO
ENDIF ! End of the lsort=2 if-then-else
ENDIF ! End of the lsort>0 if-then-else
ENDDO ! End of the l loop
ENDDO ! End of the isrt loop
C
C Printing the size of the Energy window
CALL printout(0)
WRITE(buf,'(2(a,f10.5),a)')
& 'The Eigenstates are projected in an energy window from ',
& e_bot,' Ry to ',e_top,' Ry around the Fermi level.'
CALL printout(1)
C
C =======================================================================================
C Reading of the transformation matrices from the complex to the required angular basis :
C =======================================================================================
CALL set_ang_trans
C
C ======================================================================================
C Comparing data about correlated ireps and the description of transformation matrices :
C ======================================================================================
C
CALL printout(0)
CALL printout(0)
WRITE(buf,'(a)')'======================================='
CALL printout(0)
WRITE(buf,'(a)')'Precisions about correlated orbitals.'
CALL printout(0)
CALL printout(0)
DO isrt=1,nsort
IF (notinclude(isrt)) cycle
WRITE(buf,'(a)')'-------------------------------------'
CALL printout(0)
WRITE(buf,'(a,i2,a)')'For the sort ',isrt,' :'
CALL printout(0)
lcorr=0
DO l=0,lmax
C Only correlated orbital l of isrt are considered here.
IF (lsort(l,isrt)==2) THEN
lcorr=lcorr+1
C If the whole orbital is correlated (lnreps=0 in this case)
IF (lnreps(l,isrt)==0) THEN
WRITE(buf,'(a,i2,a)')'The whole orbital l=',l,
& ' is included as correlated.'
CALL printout(0)
C If only one particular irep of the orbital is correlated
ELSE
C
C For a computation without spin-orbit or a computation with SO and with a basis which mixes up and dn states.
C ------------------------------------------------------------------------------------------------------------
IF ((.not.ifSO).OR.
& (ifSO.AND.(l.NE.0).AND.reptrans(l,isrt)%ifmixing))
& THEN
C without SO, the case l=0 can not occur since lnreps(0,isrt)=0.
C
C ---------------------------------------------------------------------------------------
C Interruption of the prgm if the data about ireps are conflicting.
C -------------------------
C
IF (lnreps(l,isrt).NE.reptrans(l,isrt)%nreps) THEN
WRITE(buf,'(a,a,i2,a)')
& 'The number of ireps considered ',
& 'for the orbital l= ', l ,' is wrong.'
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
STOP
C ---------------------------------------------------------------------------------------
C
C Writing in the output file case.outdmftpr the irep considered as correlated.
ELSE
nbrep=0
DO irep=1,lnreps(l,isrt)
IF (correps(irep,l,isrt)==1) THEN
WRITE(buf,'(a,i2,a,i2,a)')
& 'The irep ',irep,' of orbital l= ', l,
& ' is considered as correlated.'
CALL printout(0)
nbrep=nbrep+1
ENDIF
ENDDO
C ---------------------------------------------------------------------------------------
C Printing a Warning if more than one irep for one value of l is considered.
C -------------------
C
IF (nbrep.gt.1) THEN
CALL printout(0)
WRITE(buf,'(a,a)') 'WARNING : ',
& 'more than 1 irep is included as correlated.'
CALL printout(0)
WRITE(buf,'(a,a,a)') ' ',
& 'The calculation may not be correct ',
& 'in this case.'
CALL printout(1)
ENDIF
ENDIF ! End of the data-conflict if-then-else
C
C For a computation with spin-orbit with basis which doesn't mix up and dn states.
C --------------------------------------------------------------------------------
ELSE
WRITE(buf,'(a,i2,a)')'The whole orbital l=',l,
& ' is included as correlated.'
CALL printout(0)
WRITE(buf,'(a,a)')'because this computation ',
& 'includes Spin-Orbit coupling.'
CALL printout(0)
ENDIF ! End of the ifSo if-then-else
ENDIF ! End of the lnreps=0 if-then-else
ENDIF ! End of the lsort=2 if-then-else
C In the case of no correlated orbitals are considered for the atomic sort isrt :
ENDDO ! End of the l loop
IF (lcorr==0) THEN
WRITE(buf,'(a,a)')'No orbital is included as correlated.'
CALL printout(0)
ENDIF ! End of the lcorr=0 if-then-else
ENDDO ! End of the isrt loop
CALL printout(0)
DEALLOCATE(lnreps,correps)
C lnreps and correps can not be used anymore...
C
C ==================================
C Setting of the symmetry matrices :
C ==================================
CALL setsym
C
C =========================================================================================
C Reading of the Wien2k informations in the case.almblm file (generated by x lapw2 -almd) :
C =========================================================================================
C
CALL printout(0)
CALL printout(0)
WRITE(buf,'(a)')'======================================='
CALL printout(0)
CALL printout(0)
WRITE(buf,'(a,a)')'Reading of the file ',almblm_file
CALL printout(0)
C Reading of the klist_band file if the computation if band oriented (option -band)
IF(ifBAND) CALL read_k_list
DO is=1,ns
C If the computation is spin-polarized, there are two differents file (up and down)
IF(is==2) THEN
CLOSE(iualmblm)
OPEN(iualmblm,file=almblm_file_sp2,status='old')
WRITE(buf,'(a,a)')'Reading of the file ',almblm_file_sp2
CALL printout(0)
ENDIF
C -------------------------------------------------------------
C Reading of the general informations in the case.almblm file :
C -------------------------------------------------------------
READ(iualmblm,*)elecn
READ(iualmblm,*)nk
READ(iualmblm,*)nloat
C elecn = total number of semicore+valence electrons in the system
C nk = total number of k_points
C nloat = maximal number of LO (local orbitals in LAPW expansion)
IF(ifBAND) THEN
IF (is==1) READ(iuinp,*)eferm
READ(iualmblm,*)
ELSE
READ(iualmblm,*)eferm
ENDIF
C eferm = fermi level (if the computation is band-oriented, it is read in case.indmftpr)
IF(is==1) THEN
ALLOCATE(kp(nk,ns),u_dot_norm(0:lmax,nsort,ns))
ALLOCATE(ovl_LO_u(nloat,0:lmax,nsort,ns))
ALLOCATE(ovl_LO_udot(nloat,0:lmax,nsort,ns))
ALLOCATE(nLO(0:lmax,nsort))
ENDIF
nLO=0
DO isrt=1,nsort
C Beginning of the loop on the sort of atoms (isort)
DO l=0,lmax
READ(iualmblm,*)u_dot_norm(l,isrt,is)
READ(iualmblm,*)nLO(l,isrt)
C
C ---------------------------------------------------------------------------------------
C Interruption of the prgm if nLO is more than 1.
C -------------------------
C
IF (nLO(l,isrt) > 1) THEN
WRITE(buf,'(a,a)')'The current version of DMFTproj ',
& ' cannot be used with more than 1 LO orbital by atom. '
CALL printout(0)
WRITE(buf,'(a,i2,a,i2)')
& ' This is not the case for the orbital l= ',l,
& ' of the atomic sort ',isrt
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
STOP
END IF
C ---------------------------------------------------------------------------------------
C
C It is assumed in the following that nLO is 0 or 1.
DO ilo=1,nLO(l,isrt)
READ(iualmblm,*)ovl_LO_u(ilo,l,isrt,is),
& ovl_LO_udot(ilo,l,isrt,is)
ENDDO
ENDDO
C kp = table of "kp_data" elements. It ranges from 1 to nk and from 1 to ns.
C u_dot_norm(isort,l) = norm <u_dotl1|u_dotl1> for the orbital
C nLO(isort,l) = number of LO (local orbitals) for each orbital of each sort (its value is assumed to be 0 or 1)
C ovl_LO_u(isort, l) = overlap element <ul2|ul1> for the LO orbitals
C ovl_LO_udot(isort, l) = overlap element <ul2|u-dotl1> for the LO orbitals
C These informations are relative to the basis set for the atomic eigenstates (LAPW-APW expansion)
C
C --------------------------------------------------------------
C For each kpoints and isrt, the "kp_data" elements are filled :
C --------------------------------------------------------------
DO ik=1,nk
READ(iualmblm,'()')
READ(iualmblm,'()')
READ(iualmblm,*)idum,kp(ik,is)%nbmin,kp(ik,is)%nbmax
C idum = useless variable in case.almblm
C kp(ik,is)%nbmin = index of the lowest band
C kp(ik,is)%nbmzx = index of the uppest band
IF(.NOT.ALLOCATED(kp(ik,is)%Alm)) THEN
ALLOCATE(kp(ik,is)%eband(kp(ik,is)
& %nbmin:kp(ik,is)%nbmax))
ALLOCATE(kp(ik,is)%Alm(nlm,natom,
& kp(ik,is)%nbmin:kp(ik,is)%nbmax))
ALLOCATE(kp(ik,is)%Blm(nlm,natom,
& kp(ik,is)%nbmin:kp(ik,is)%nbmax))
ALLOCATE(kp(ik,is)%Clm(nloat,nlm,natom,
& kp(ik,is)%nbmin:kp(ik,is)%nbmax))
ALLOCATE(kp(ik,is)%tetrweight(kp(ik,is)%nbmin:
& kp(ik,is)%nbmax))
ENDIF
DO ib=kp(ik,is)%nbmin,kp(ik,is)%nbmax
READ(iualmblm,*)rtetr,kp(ik,is)%eband(ib)
kp(ik,is)%tetrweight(ib)=CMPLX(rtetr,0d0)
ENDDO
C rtetr = tetrahedron weights of the band ib at this kpoint
C the field kp(ik,is)%eband(ib) = eigenvalues of the ib band at this kpoint
C the field kp(ik,is)%tetrweight(ib) = the tetrahedron weights are set as complex number to avoid problems with SQRT(tetrweight)
kp(ik,is)%weight=REAL(kp(ik,is)%tetrweight
& (kp(ik,is)%nbmin))
C the field kp(ik,is)%weight = value of the tetrahedron weight of the lowest band (fully occupied) at this kpoint -> "a geometric factor"
kp(ik,is)%eband=kp(ik,is)%eband-eferm
C the eigenvalues kp(ik,is)%eband are shifted with respect to the fermi level.
C
C Reading of the Alm, Blm and Clm coefficient
DO imu=1,nmult(isrt)
iatom=SUM(nmult(0:isrt-1))+imu
READ(iualmblm,'()')
READ(iualmblm,*)idum
DO ib=kp(ik,is)%nbmin,kp(ik,is)%nbmax
lm=0
DO l=0,lmax
DO m=-l,l
lm=lm+1
READ(iualmblm,*)kp(ik,is)%Alm(lm,iatom,ib),
& kp(ik,is)%Blm(lm,iatom,ib)
DO ilo=1,nLO(l,isrt)
READ(iualmblm,*)kp(ik,is)%Clm(ilo,lm,iatom,ib)
ENDDO
ENDDO ! End of the m loop
ENDDO ! End of the l loop
ENDDO ! End of the ib loop
ENDDO ! End of the imu loop
C the field kp(ik,is)%Alm = coefficient A_(lm,ib,iatom)(ik,is) as defined in equation (2.34) of my thesis (equation (??) of the tutorial)
C the field kp(ik,is)%Blm = coefficient B_(lm,ib,iatom)(ik,is) as defined in equation (2.34) of my thesis (equation (??) of the tutorial)
C the field kp(ik,is)%Clm = coefficient C_(ilo,lm,ib,iatom)(ik,is) as defined in equation (2.34) of my thesis (equation (??) of the tutorial)
C Their explicit expression depends of the representation (LAPW or APW). They enable to compute the projectors.
C These values are given for all the orbitals (even those which are not included in the study)
ENDDO ! End of the loop on kp
ENDDO ! End of the loop on isort
ENDDO ! End of the loop on ns (spin)
C End of reading the case.almblm.file
C Printing in the file case.outdmftpr the fermi level (in Rydberg)
CALL printout(0)
WRITE(buf,'(a,f10.5,a)')'The value of the Fermi Energy is ',
& eferm,' Ry.'
CALL printout(0)
WRITE(buf,'(a,a)')'All the considered energies are now given ',
& 'with respect to this value. (E_Fermi is now 0 Ry)'
CALL printout(1)
C
C
C ==============================================================
C Computation of the density matrices up to the Fermi level Ef :
C ==============================================================
C
WRITE(buf,'(a)')'======================================='
CALL printout(0)
WRITE(buf,'(a,a)')'Computation of the Occupancies ',
& 'and Density Matrices up to E_Fermi'
CALL printout(1)
C ----------------------------------------
C Setting up the projections for all bands
C ----------------------------------------
CALL set_projections(-Elarge,Elarge)
C Elarge is an energy variable equal to 1.d6 Rydberg (very large !!!)
C
C ---------------------------------------------------------
C Computation of the density matrices and the total charges
C ---------------------------------------------------------
C
IF(.NOT.ifBAND) CALL density(.TRUE.,.FALSE.,qdum,.TRUE.)
C For the integration, tetrahedron weights are used.
C The computation is performed for all the included orbitals
C and the density matrices are printed in the file case.outdmftpr
C qdum is the total charge density. (unused variable)
C
C The calculation of Wannier projectors is performed only if correlated orbitals are included.
IF(ncrorb.NE.0) THEN
C
C =====================================================================
C Computation of the charge below the lower limit e_bot of the window :
C =====================================================================
C
WRITE(buf,'(a)')'======================================='
CALL printout(0)
WRITE(buf,'(a,a,f10.5,a)')'Computation of the total ',
& 'Charge below the lower limit of the energy window :',
& e_bot,' Ry'
CALL printout(1)
C
C ----------------------------------------
C Setting up the projections for all bands
C ----------------------------------------
CALL set_projections(-Elarge,e_bot)
C
C ---------------------------------------------------------
C Computation of the density matrices and the total charges
C ---------------------------------------------------------
C
IF(.NOT.ifBAND) CALL density(.FAlSE.,.FALSE.,qtot,.FALSE.)
C A simple point integration is used.
C The computation is performed for all the included orbitals.
C qtot is the total charge density below e_bot.
C Nothing will be printed in the file case.outdmftpr apart from the total charge qtot.
C
C
C ============================================================
C Computation of the Wannier projectors in the energy window :
C ============================================================
C
WRITE(buf,'(a)')'======================================='
CALL printout(0)
WRITE(buf,'(a,a,a,f10.5,a,f10.5,a)')'Computation of the ',
& 'Occupancies and Density Matrices in the desired ',
& 'energy window [ ',e_bot,'; ',e_top,']'
CALL printout(1)
C
C ----------------------------------------
C Setting up the projections for all bands
C ----------------------------------------
CALL set_projections(e_bot,e_top)
C
C ------------------------------------------------------------------------------
C Orthonormalization of the projectors for correlated orbitals P(icrorb,ik,is) :
C ------------------------------------------------------------------------------
IF(ifSO) THEN
C In this case, up and dn states must be orthogonalized together
C because the spin is not a good quantum number anymore.
CALL orthogonal_wannier_SO
ELSE
C In this case, up and dn states can be orthogonalized separately
CALL orthogonal_wannier
ENDIF
C
C ---------------------------------------------------------
C Computation of the density matrices and the total charges
C ---------------------------------------------------------
C Tetrahedron weights are used, the computation are done for correlated orbitals only and are printed in the outputfile.
IF(.NOT.ifBAND) CALL density(.TRUE.,.TRUE.,qdum,.TRUE.)
C For the integration, tetrahedron weights are used.
C The computation is performed for the correlated orbitals only
C and the density matrices are printed in the file case.outdmftpr
C qdum is the total charge density in the energy window. (unused variable)
C
C
C Writing the output files for DMFT computations :
C ------------------------------------------------
IF(.NOT.ifBAND) THEN
CALL outqmc(elecn,qtot)
ELSE
CALL outband
ENDIF
CALL outbwin
ENDIF
C End of the prgm
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
C
END

410
fortran/dmftproj/modules.f Normal file
View File

@ -0,0 +1,410 @@
c ******************************************************************************
c
c TRIQS: a Toolbox for Research in Interacting Quantum Systems
c
c Copyright (C) 2011 by L. Pourovskii, V. Vildosola, C. Martins, M. Aichhorn
c
c TRIQS is free software: you can redistribute it and/or modify it under the
c terms of the GNU General Public License as published by the Free Software
c Foundation, either version 3 of the License, or (at your option) any later
c version.
c
c TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
c WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
c FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
c details.
c
c You should have received a copy of the GNU General Public License along with
c TRIQS. If not, see <http://www.gnu.org/licenses/>.
c
c *****************************************************************************/
C--------------------
C MODULE almblm_data
C--------------------
MODULE almblm_data
INTEGER :: nk, nloat
INTEGER, DIMENSION(:,:), ALLOCATABLE :: nLO
REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: u_dot_norm
REAL(KIND=8), DIMENSION(:,:,:,:), ALLOCATABLE :: ovl_LO_u
REAL(KIND=8), DIMENSION(:,:,:,:), ALLOCATABLE :: ovl_LO_udot
TYPE kp_data
LOGICAL :: included
INTEGER :: nb_bot, nb_top
INTEGER :: nbmin,nbmax
REAL(KIND=8) :: weight
COMPLEX(KIND=8), DIMENSION(:), ALLOCATABLE :: tetrweight
REAL(KIND=8),DIMENSION(:), ALLOCATABLE :: eband
COMPLEX(KIND=8),DIMENSION(:,:,:), ALLOCATABLE :: Alm, Blm
COMPLEX(KIND=8),DIMENSION(:,:,:,:), ALLOCATABLE :: Clm
ENDTYPE
TYPE(kp_data), DIMENSION(:,:), ALLOCATABLE :: kp
ENDMODULE almblm_data
C
C--------------
C MODULE bands
C--------------
MODULE bands
INTEGER :: nlab, nkband
TYPE label
CHARACTER(len=20) :: kname
INTEGER :: pos
ENDTYPE
TYPE(label), DIMENSION(:), ALLOCATABLE :: labels
ENDMODULE
C
C--------------------
C MODULE common_data
C--------------------
MODULE common_data
C 11/03/10 : Modification of the fullpath for myDMFTproj-2
C CHARACTER(len=*), PARAMETER :: wien_path=
C & '/workpmc/martins/DMFTprojectors/newDMFTproj'
CHARACTER(len=250) :: wien_path
INTEGER :: natom, nsort, lmax, nlm, ns, nsp
INTEGER, DIMENSION(:), ALLOCATABLE :: isort
INTEGER, DIMENSION(:), ALLOCATABLE :: nmult
INTEGER, DIMENSION(:,:), ALLOCATABLE :: lsort
INTEGER, DIMENSION(:), ALLOCATABLE :: ifSOflag
INTEGER, DIMENSION(:), ALLOCATABLE :: timeflag
LOGICAL :: ifSO, ifSP, ifBAND
LOGICAL, DIMENSION(:), ALLOCATABLE :: notinclude
REAL(KIND=8) :: eferm
REAL(KIND=8) :: e_bot, e_top
REAL(KIND=8), PARAMETER :: PI=3.1415926535898d0
C New type structure basistrans
TYPE deftrans
CHARACTER(len=8) :: typebasis
C The size of typebasis is limited to 8 characters !
CHARACTER(len=25) :: sourcefile
C The size of sourcefile is limited to 25 characters !
ENDTYPE
TYPE(deftrans), DIMENSION(:), ALLOCATABLE :: defbasis
C Type structure orbital
TYPE orbital
INTEGER :: atom
INTEGER :: sort
INTEGER :: l
LOGICAL :: first
LOGICAL :: ifsplit
INTEGER :: ifSOat
LOGICAL,DIMENSION(:), ALLOCATABLE :: correp
ENDTYPE
TYPE(orbital), DIMENSION(:), ALLOCATABLE :: orb, crorb
INTEGER :: norb, ncrorb
ENDMODULE common_data
C
C------------------
C MODULE factorial
C------------------
MODULE factorial
REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: fac
INTEGER :: nfctrl
CONTAINS
SUBROUTINE setfact(n)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine sets the factorial array %%
C %% FAC(I+1) = I! for I=0,...,N-1 %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
IMPLICIT NONE
INTEGER :: n, i
C
nfctrl=n
ALLOCATE(fac(nfctrl))
C I! = FAC(I+1)
fac(1)=1.0d00
DO i=1,nfctrl-1
fac(i+1)=i*fac(i)
ENDDO
RETURN
END SUBROUTINE setfact
END MODULE factorial
C
C-------------------
C MODULE file_names
C-------------------
MODULE file_names
INTEGER :: iudef, iuinp, iusym, iualmblm, iumatfile, iuradwf
INTEGER :: iuklist
INTEGER :: ouproj, ouprn, ouctqmc, oupartial,ousymqmc, ousympar
INTEGER :: ouband, oubwinup, oubwindn, oubwin
INTEGER :: outw2kpath
CHARACTER(len=25) :: jobname
CHARACTER(len=35) :: inp_file, sym_file, almblm_file
CHARACTER(len=35) :: almblm_file_sp2
CHARACTER(len=35) :: radwf_file, radwf_file_sp2
CHARACTER(len=35) :: prn_file, ctqmc_file, partial_file
CHARACTER(len=35) :: klist_file
CHARACTER(len=35) :: symqmc_file, sympar_file, outband_file
CHARACTER(len=35) :: oubwin_file, oubwinup_file, oubwindn_file
CHARACTER(len=8), PARAMETER :: inp_ext='indmftpr'
CHARACTER(len=7), PARAMETER :: sym_ext='dmftsym'
CHARACTER(len=6), PARAMETER :: almblm_ext='almblm'
CHARACTER(len=8), PARAMETER :: almblmup_ext='almblmup'
CHARACTER(len=8), PARAMETER :: almblmdn_ext='almblmdn'
CHARACTER(len=9), PARAMETER :: prn_ext='outdmftpr'
CHARACTER(len=8), PARAMETER :: ctqmc_ext='ctqmcout'
CHARACTER(len=7), PARAMETER :: partial_ext='parproj'
CHARACTER(len=6), PARAMETER :: symqmc_ext='symqmc'
CHARACTER(len=6), PARAMETER :: sympar_ext='sympar'
CHARACTER(len=7), PARAMETER :: radwfup_ext='radwfup'
CHARACTER(len=7), PARAMETER :: radwfdn_ext='radwfdn'
CHARACTER(len=10), PARAMETER :: klist_ext='klist_band'
CHARACTER(len=7), PARAMETER :: outband_ext='outband'
CHARACTER(len=6), PARAMETER :: oubwin_ext='oubwin'
CHARACTER(len=8), PARAMETER :: oubwinup_ext='oubwinup'
CHARACTER(len=8), PARAMETER :: oubwindn_ext='oubwindn'
CONTAINS
SUBROUTINE set_file_name(filename,exten)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine sets the file name %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
IMPLICIT NONE
CHARACTER(len=*) :: filename, exten
INTEGER :: i1, i2, i
i1=LEN_TRIM(jobname)
i2=LEN(exten)
i=i1+i2+1
IF(LEN(filename) < i) THEN
WRITE(*,'(i3,3a)')
& i,' characters required for the $case.',exten,
& ' filename, too long'
STOP
ENDIF
filename=' '
filename(1:i)=jobname(1:i1)//'.'//exten(1:i2)
END SUBROUTINE set_file_name
C
SUBROUTINE openfiles
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine opens the input and output units for dmftproj %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE common_data, ONLY: ifSP, ifSO, ifBAND, wien_path
IMPLICIT NONE
CHARACTER(len=120) :: buf
INTEGER :: i1, i2
C initialize input/output channels
CALL setchannels
C Get working directory name:
CALL system('pwd > dir_name.tmp')
OPEN(outw2kpath,file='dir_name.tmp',status='old')
READ(outw2kpath,'(a)')buf
CLOSE(outw2kpath,status='delete')
i1=INDEX(buf,'/',.TRUE.)
i2=LEN_TRIM(buf)
jobname(1:i2-i1)=buf(i1+1:i2)
jobname(i2-i1+1:)=' '
C Construct file names
CALL set_file_name(inp_file,inp_ext)
CALL set_file_name(sym_file,sym_ext)
IF(.NOT.ifSP) THEN
CALL set_file_name(almblm_file,almblm_ext)
ELSE
CALL set_file_name(almblm_file,almblmup_ext)
CALL set_file_name(almblm_file_sp2,almblmdn_ext)
ENDIF
CALL set_file_name(prn_file,prn_ext)
CALL set_file_name(ctqmc_file,ctqmc_ext)
CALL set_file_name(partial_file,partial_ext)
CALL set_file_name(symqmc_file,symqmc_ext)
CALL set_file_name(sympar_file,sympar_ext)
IF(ifSP.AND.ifSO) THEN
CALL set_file_name(radwf_file,radwfup_ext)
CALL set_file_name(radwf_file_sp2,radwfdn_ext)
ENDIF
IF(ifBAND) THEN
CALL set_file_name(klist_file,klist_ext)
CALL set_file_name(outband_file,outband_ext)
ENDIF
IF(ifSP) THEN
CALL set_file_name(oubwinup_file,oubwinup_ext)
CALL set_file_name(oubwindn_file,oubwindn_ext)
ELSE
CALL set_file_name(oubwin_file,oubwin_ext)
ENDIF
C Open units
OPEN(iuinp,file=inp_file,status='old')
OPEN(iusym,file=sym_file,status='old')
OPEN(iualmblm,file=almblm_file,status='old')
OPEN(ouprn,file=prn_file)
OPEN(ouctqmc,file=ctqmc_file)
OPEN(oupartial,file=partial_file)
OPEN(ousymqmc,file=symqmc_file)
OPEN(ousympar,file=sympar_file)
IF(ifBAND) THEN
OPEN(iuklist,file=klist_file,status='old')
OPEN(ouband,file=outband_file)
ENDIF
IF(ifSP) THEN
OPEN(oubwinup,file=oubwinup_file)
OPEN(oubwindn,file=oubwindn_file)
ELSE
OPEN(oubwin,file=oubwin_file)
ENDIF
C
C Set path to Wien2k
CALL system('echo $WIENROOT > path_wienroot.tmp')
OPEN(outw2kpath,file='path_wienroot.tmp',status='old')
READ(outw2kpath,'(a)')wien_path
CLOSE(outw2kpath,status='delete')
C
RETURN
END SUBROUTINE
C
SUBROUTINE setchannels
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine opens the input and output channels %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE common_data, ONLY: ifSP
IMPLICIT NONE
C Channels
C input
iudef=5 ! def-file
iuinp=7 ! input data
iusym=8 ! symmetries
iualmblm=9 ! almblm matrices from Wien
iumatfile=15 !transformation matrices between different angular basises
iuradwf=16 !radial mesh and wave functions
iuklist=20 !bands
C output
ouprn=10 ! print-out file
ouproj=11 ! projection matrices and other data for DMFT run
ouctqmc=12 ! output for ctqmc
oupartial=13 ! output for partial charges projectors for ctqmc
ousymqmc=14 ! output for permutations and rotation matrices
ousympar=19 ! output for permutations and rotation matrices
! for partial charges analisis
ouband=21 ! bands
IF(ifSP) THEN
oubwinup=22 ! included bands information for lapw2(up)
oubwindn=23 ! included bands information for lapw2(dn)
ELSE
oubwin=22 ! included bands information for lapw2
ENDIF
C
RETURN
END SUBROUTINE
C
C
ENDMODULE file_names
C
MODULE prnt
CHARACTER(len=250) :: buf
CONTAINS
SUBROUTINE printout(newline)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine prints the string in buf to the screen %%
C %% and to the output file and renitializes buf %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE file_names
IMPLICIT NONE
INTEGER :: newline, i
i=LEN_TRIM(buf)
WRITE(ouprn,'(a)')buf(1:i)
WRITE(*,'(a)')buf(1:i)
buf=' '
IF(newline==1) THEN
WRITE(ouprn,'(/)')
WRITE(*,'(/)')
ENDIF
RETURN
END subroutine
ENDMODULE prnt
C
C--------------------
C MODULE projections
C--------------------
MODULE projections
TYPE proj_mat
COMPLEX(KIND=8), DIMENSION(:,:), ALLOCATABLE :: mat
COMPLEX(KIND=8), DIMENSION(:,:), ALLOCATABLE :: mat_rep
ENDTYPE
TYPE(proj_mat), DIMENSION(:,:,:), ALLOCATABLE :: pr_crorb
C
TYPE proj_mat_n
COMPLEX(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: matn
COMPLEX(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: matn_rep
ENDTYPE
TYPE(proj_mat_n), DIMENSION(:,:,:), ALLOCATABLE :: pr_orb
C
TYPE ortfunc
INTEGER :: n
REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: s12
ENDTYPE
TYPE(ortfunc), DIMENSION(:), ALLOCATABLE :: norm_radf
ENDMODULE projections
C
C-------------
C MODULE reps
C-------------
MODULE reps
TYPE ang_bas
INTEGER :: nreps
INTEGER, DIMENSION(:), ALLOCATABLE :: dreps
LOGICAL :: ifmixing
COMPLEX(KIND=8),DIMENSION(:,:), ALLOCATABLE :: transmat
ENDTYPE
TYPE(ang_bas), DIMENSION(:,:), ALLOCATABLE :: reptrans
ENDMODULE
C
C-------------
C MODULE symm
C-------------
MODULE symm
TYPE matrix
COMPLEX(KIND=8),DIMENSION(:,:),ALLOCATABLE :: mat
ENDTYPE
TYPE symop
LOGICAL :: timeinv
INTEGER, DIMENSION(:), ALLOCATABLE :: perm
INTEGER :: iprop
REAL(KIND=8) :: a, b, g
REAL(KIND=8) :: phase
REAL(KIND=8) :: krotm(3,3)
COMPLEX(KIND=8),DIMENSION(:,:,:),ALLOCATABLE ::rotl
TYPE(matrix),DIMENSION(:,:),ALLOCATABLE ::rotrep
ENDTYPE
TYPE symoploc
LOGICAL :: timeinv
INTEGER :: iprop
INTEGER :: srotnum
REAL(KIND=8) :: a, b, g
REAL(KIND=8) :: phase
REAL(KIND=8) :: krotm(3,3)
COMPLEX(KIND=8),DIMENSION(:,:,:),ALLOCATABLE ::rotl
TYPE(matrix),DIMENSION(:),ALLOCATABLE ::rotrep
ENDTYPE
INTEGER :: nsym
INTEGER :: lsym, nlmsym
TYPE(symop), DIMENSION(:), ALLOCATABLE :: srot
TYPE(symoploc), DIMENSION(:), ALLOCATABLE :: rotloc
TYPE(matrix), DIMENSION(:,:), ALLOCATABLE :: densmat
TYPE(matrix), DIMENSION(:,:), ALLOCATABLE :: crdensmat
END MODULE symm

View File

@ -0,0 +1,225 @@
c ******************************************************************************
c
c TRIQS: a Toolbox for Research in Interacting Quantum Systems
c
c Copyright (C) 2011 by L. Pourovskii, V. Vildosola, C. Martins, M. Aichhorn
c
c TRIQS is free software: you can redistribute it and/or modify it under the
c terms of the GNU General Public License as published by the Free Software
c Foundation, either version 3 of the License, or (at your option) any later
c version.
c
c TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
c WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
c FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
c details.
c
c You should have received a copy of the GNU General Public License along with
c TRIQS. If not, see <http://www.gnu.org/licenses/>.
c
c *****************************************************************************/
SUBROUTINE orthogonal_h(s1,ndim,inv)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine computes : %%
C %% - if inv = .FALSE. the square root of the Hermitian matrix s1 %%
C %% - if inv = .TRUE. the inverse of the square root of the %%
C %% Hermitian matrix s1 %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE prnt
IMPLICIT NONE
INTEGER :: ndim, INFO, lm, lm1
COMPLEX(KIND=8), DIMENSION(ndim) :: WORK
COMPLEX(KIND=8), DIMENSION(ndim,ndim) :: s1
INTEGER, DIMENSION(ndim,ndim) :: IPIV
LOGICAL :: inv
C
C Calculation of S1^(1/2) or S1^(-1/2):
C -------------------------------------
CALL sqrtm(s1,ndim,inv)
C The resulting matrix is stored in s1.
RETURN
END
SUBROUTINE orthogonal_r(s2,ndim,inv)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine computes : %%
C %% - if inv = .FALSE. the square root of s1 %%
C %% - if inv = .TRUE. the inverse of the square root of s2 %%
C %% where s2 is a real symmetric matrix. %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE prnt
IMPLICIT NONE
INTEGER :: ndim, INFO, lm, lm1
COMPLEX(KIND=8), DIMENSION(ndim) :: WORK
COMPLEX(KIND=8), DIMENSION(ndim,ndim) :: s1
REAL(KIND=8), DIMENSION(ndim,ndim) :: s2
INTEGER, DIMENSION(ndim,ndim) :: IPIV
LOGICAL :: inv
C
C Calculation of S2^(1/2) or S2^(-1/2):
C -------------------------------------
s1=s2
CALL sqrtm(s1,ndim,inv)
s2=REAL(s1)
C The resulting matrix is stored in s2.
RETURN
END
SUBROUTINE sqrtm(cmat,m,inv)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine calculates the square root of a positively %%
C %% defined Hermitian matrix A=cmat using the decomposition %%
C %% A=Z*D*Z^H %%
C %% where D is a diagonal matrix of eigenvalues of A, %%
C %% Z is matrix of orthonormal eigenvectors of A, %%
C %% Z^H is its Hermitian conjugate. %%
C %% Then A^(1/2)=Z*D^(1/2)*Z^H. %%
C %% Correction: the matrix A is allowed to be negatively defined. %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
IMPLICIT NONE
INTEGER :: m
COMPLEX(KIND=8), DIMENSION(m,m):: cmat, D, D1
LOGICAL :: inv
C Calculation of Z*D^(1/2):
C -------------------------
CALL sqrt_eigenvec(cmat,D1,m,inv)
WRITE(95,*) cmat
WRITE(95,*) ' '
WRITE(95,*) D1
WRITE(95,*) ' '
C Calculation of A^(1/2)=Z*D^(1/2)*Z^H:
C -------------------------------------
D=CONJG(cmat)
call ZGEMM('N','T',m,m,m,DCMPLX(1.D0,0.D0),D1,
& m,D,m,DCMPLX(0.D0,0.D0),cmat,m)
C The resulting matrix is stored in cmat.
RETURN
END
SUBROUTINE sqrt_eigenvec(cmat,D1,m,inv)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine computes : %%
C %% - if inv = .FALSE. Z*D^(1/2) %%
C %% - if inv = .TRUE. Z*D^(-1/2) %%
C %% where Z is a matrix of orthonormal eigenvectors of cmat and %%
C %% D is the diagonal matrix of cmat's eigenvalues. %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE prnt
IMPLICIT NONE
LOGICAL :: inv, ifwrite
INTEGER :: m, INFO, i, j
INTEGER, PARAMETER :: nwork=40
C
COMPLEX(KIND=8), allocatable, DIMENSION(:) :: WORK
COMPLEX(KIND=8), DIMENSION(m,m) :: cmat, D1
REAL(KIND=8), DIMENSION(m) :: W
COMPLEX(KIND=8), DIMENSION(m) :: W_comp
REAL(KIND=8), allocatable, DIMENSION(:) :: RWORK
C
C Finding the eigenvalues and the eigenvectors of cmat :
C ------------------------------------------------------
ALLOCATE(rwork(3*m-2))
ALLOCATE(work(2*m-1))
CALL ZHEEV('V', 'U', m, cmat, m, W, WORK,2*m-1,RWORK,INFO)
IF (info.ne.0) THEN
WRITE(buf,'(a)')
& 'The subroutine zheev ends with info = ',info
CALL printout(0)
WRITE(buf,'(a)')'In sqrt_eigenvec, a pbm occurs in zheev.'
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
STOP
ENDIF
C W contains the eigenvalues of cmat.
W_comp=CMPLX(W,0d0)
C
C Checking of the validity of the computation :
C ---------------------------------------------
ifwrite=.FALSE.
DO j=1,m
C The warning is written only once in the file case.outdmftpr
IF (ifwrite) EXIT
C Checking if the eigenvalues are not negative.
IF (W(j).lt.0.d0) THEN
WRITE(buf,'(a,i2,a,a)')
& 'WARNING : An eigenvalue (',j,') of the ',
& 'overlap matrix is negative.'
CALL printout(0)
WRITE(buf,'(a,a)')' The result ',
& 'of the calculation may thus be wrong.'
CALL printout(1)
ifwrite=.TRUE.
ENDIF
IF (ABS(W(j)).lt.1.d-12) THEN
WRITE(buf,'(a,i2,a,a)')
& 'WARNING : An eigenvalue (',j,') of the ',
& 'overlap matrix is almost zero.'
CALL printout(0)
WRITE(buf,'(a,a)')' The result ',
& 'of the calculation may thus be wrong.'
CALL printout(1)
ifwrite=.TRUE.
ENDIF
ENDDO
C
C Calculation of Z*D^(1/2) :
C --------------------------
C The result is stored in D1.
IF(.NOT.inv) THEN
DO i=1,m
DO j=1,m
D1(i,j)=cmat(i,j)*SQRT(W_comp(j))
ENDDO
ENDDO
ELSE
C Calculation of Z*D^(-1/2) :
C ---------------------------
C The result is stored in D1.
DO i=1,m
DO j=1,m
IF (ABS(W(j))==0.d0) THEN
WRITE(buf,'(a,i2,a)')
& 'An eigenvalue (',j,') of the ',
& 'overlap matrix has the value 0.'
CALL printout(0)
WRITE(buf,'(a)')
& 'The calculation can not be performed further.'
CALL printout(0)
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
STOP
ENDIF
D1(i,j)=cmat(i,j)/SQRT(W_comp(j))
ENDDO
ENDDO
ENDIF
C The resulting matrix is stored in D1 and cmat is now Z.
RETURN
END

View File

@ -0,0 +1,593 @@
c ******************************************************************************
c
c TRIQS: a Toolbox for Research in Interacting Quantum Systems
c
c Copyright (C) 2011 by L. Pourovskii, V. Vildosola, C. Martins, M. Aichhorn
c
c TRIQS is free software: you can redistribute it and/or modify it under the
c terms of the GNU General Public License as published by the Free Software
c Foundation, either version 3 of the License, or (at your option) any later
c version.
c
c TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
c WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
c FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
c details.
c
c You should have received a copy of the GNU General Public License along with
c TRIQS. If not, see <http://www.gnu.org/licenses/>.
c
c *****************************************************************************/
SUBROUTINE orthogonal_wannier
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine orthonormalizes the Wannier-like functions %%
C %% obtained with the projectors P(icrorb,ik,is), in order to %%
C %% get a set of "true" Wannier orbitals. %%
C %% %%
C %% Only the correlated orbitals are treated here. %%
C %% %%
C %% THIS VERSION CAN NOT BE USED WITH SPIN-ORBIT %%
C %% (since the calculation is made independently for up/dn states) %%
C %% THIS VERSION CAN BE USED WITH SPIN-POLARIZED INPUT FILES. %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE almblm_data
USE common_data
USE prnt
USE projections
USE reps
IMPLICIT NONE
COMPLEX(KIND=8), DIMENSION(:,:), ALLOCATABLE :: Dmat, D_orth, D
INTEGER :: is, ik, l, nbnd, ndim, isrt, nbbot, nbtop
INTEGER :: icrorb, ind1, ind2, ib, iatom
INTEGER :: m1, m2, irep
C
WRITE(buf,'(a)')'Orthonormalization of the projectors...'
CALL printout(0)
CALL printout(0)
C
IF(ncrorb==0) RETURN
C
C =====================================
C Creation of the overlap matrix Dmat :
C =====================================
C
C -----------------------------------------------------------
C Determination of the dimension ndim of the overlap matrix :
C -----------------------------------------------------------
ndim=0
C Loop on the correlated orbitals
DO icrorb=1,ncrorb
isrt=crorb(icrorb)%sort
l=crorb(icrorb)%l
C Since this subroutine is used only in the case without SO,
C the correlated ireps can be considered if there are any. (ifsplit=.TRUE.)
IF(crorb(icrorb)%ifsplit) THEN
C the value of l can not be 0 here, because ifsplit is necessary .FALSE.
C for s-orbital (restriction in dmftproj.f)
DO irep=1,reptrans(l,isrt)%nreps
IF(crorb(icrorb)%correp(irep))
& ndim=ndim+reptrans(l,isrt)%dreps(irep)
C The dimension of the irep is added to ndim.
ENDDO
ELSE
C If no particular irep is considered (ifsplit=.FALSE.),
C The whole matrix of the representation is considered.
ndim=ndim+2*l+1
ENDIF
ENDDO
C ------------------
C Creation of Dmat :
C ------------------
ALLOCATE(Dmat(1:ndim,1:ndim))
C
C =====================================================================
C Computation of the orthonormalized Wannier functions and projectors :
C =====================================================================
C The computation is performed for each k_point and each spin-value independently
C because they are good quantum numbers.
DO ik=1,nk
DO is=1,ns
C Only the k-points with inlcuded bands are considered for the projectors.
IF(.NOT.kp(ik,is)%included) CYCLE
nbnd=kp(ik,is)%nb_top-kp(ik,is)%nb_bot+1
nbbot=kp(ik,is)%nb_bot
nbtop=kp(ik,is)%nb_top
ALLOCATE(D(1:ndim,1:nbnd))
C
C --------------------------------
C Initialization of the D matrix :
C --------------------------------
C This D matrix of size ndim*nbnd is the complete "projector matrix"
C which enables to go from the Wannier-like basis |u_orb> to the Bloch states |ik,ib>.
ind1=0
DO icrorb=1,ncrorb
isrt=crorb(icrorb)%sort
l=crorb(icrorb)%l
C If l=0, there only possible irep is the whole matrix itself.
IF (l==0) THEN
D(ind1+1,1:nbnd)=pr_crorb(icrorb,ik,is)%
& mat_rep(1,nbbot:nbtop)
ind1=ind1+1
ELSE
C the projectors of the correlated ireps are considered if there are any. (ifsplit=.TRUE.)
IF(crorb(icrorb)%ifsplit) THEN
C the value of l can not be 0 here, because ifsplit is necessary .FALSE.
C for s-orbital (restriction in dmftproj.f)
m1=-l-1
DO irep=1,reptrans(l,isrt)%nreps
IF(crorb(icrorb)%correp(irep)) THEN
m2=m1+reptrans(l,isrt)%dreps(irep)
ind2=ind1+reptrans(l,isrt)%dreps(irep)
C Since there is no SO, prcrorb%matrep is of size 2*l+1, from -l to l
C (the basis which mix up/dn states are not possible here.)
C The states range from m1+1 to m2 in the irep.
C The corresponding projector is stored from the line (ind1+1) to the line ind2, in the D matrix.
D(ind1+1:ind2,1:nbnd)=pr_crorb(icrorb,ik,is)%
& mat_rep(m1+1:m2,nbbot:nbtop)
ind1=ind2
ENDIF
m1=m1+reptrans(l,isrt)%dreps(irep)
ENDDO
ELSE
C The projectors of the whole correlated representation is considered. (ifsplit=.FALSE.)
ind2=ind1+2*l+1
C Since there is no SO, prcrorb%matrep is of size 2*l+1, from -l to l.
C (the basis which mix up/dn states are not possible here.)
C The corresponding projection matrix is stored from the line (ind1+1) to the line ind2, in the D matrix.
D(ind1+1:ind2,1:nbnd)=pr_crorb(icrorb,ik,is)%
& mat_rep(-l:l,nbbot:nbtop)
ind1=ind2
ENDIF ! End of the ifsplit if-then-else
ENDIF ! End of the l=0 if-then-else
ENDDO ! End of the icrorb loop
C
C ----------------------------------------
C Computation of the overlap matrix Dmat :
C ----------------------------------------
C The overlap matrix is stored in Dmat = D*transpose(conjugate(D))
CALL ZGEMM('N','C',ndim,ndim,nbnd,DCMPLX(1.D0,0.D0),
& D,ndim,D,ndim,DCMPLX(0.D0,0.D0),Dmat,ndim)
C
C -------------------------------------------
C Computation of the matrix S = Dmat^{-1/2} :
C -------------------------------------------
CALL orthogonal_h(Dmat,ndim,.TRUE.)
C This matrix is stored in Dmat.
C
C -----------------------------------------------
C Computation of the orthonormalized projectors :
C -----------------------------------------------
C The calculation performed is the following : P=O^(-1/2)*P_tilde.
C Its value is stored in the matrix D_orth (of size ndim*nbnd)
ALLOCATE(D_orth(1:ndim,1:nbnd))
CALL ZGEMM('N','N',ndim,nbnd,ndim,DCMPLX(1.D0,0.D0),
& Dmat,ndim,D,ndim,DCMPLX(0.D0,0.D0),D_orth,ndim)
DEALLOCATE(D)
C
C --------------------------------------------------------------------------------
C Storing the value of the orthonormalized projectors in the pr_crorb structures :
C --------------------------------------------------------------------------------
ind1=0
DO icrorb=1,ncrorb
isrt=crorb(icrorb)%sort
l=crorb(icrorb)%l
C If l=0, there only possible irep is the whole matrix itself.
IF (l==0) THEN
pr_crorb(icrorb,ik,is)%mat_rep
& (1,nbbot:nbtop)=D_orth(ind1+1,1:nbnd)
ind1=ind1+1
ELSE
C the projectors of the correlated ireps are considered if there are any. (ifsplit=.TRUE.)
IF(crorb(icrorb)%ifsplit) THEN
C the value of l can not be 0 here, because ifsplit is necessary .FALSE.
C for s-orbital (restriction in dmftproj.f)
m1=-l-1
DO irep=1,reptrans(l,isrt)%nreps
IF(crorb(icrorb)%correp(irep)) THEN
m2=m1+reptrans(l,isrt)%dreps(irep)
ind2=ind1+reptrans(l,isrt)%dreps(irep)
C prcrorb%matrep is of size 2*l+1, from -l to l (the basis which mix up/dn states are not possible here.)
C In the D_orth matrix, the corresponding part of the projection matrix ranges from the line (ind1+1) to the line ind2.
C The projector associated to the ireps is stored in the prcrorb%matrep from m1+1 to m2.
pr_crorb(icrorb,ik,is)%
& mat_rep(m1+1:m2,nbbot:nbtop)=
& D_orth(ind1+1:ind2,1:nbnd)
ind1=ind2
ENDIF
m1=m1+reptrans(l,isrt)%dreps(irep)
ENDDO
ELSE
C The projectors of the whole correlated representation is considered. (ifsplit=.FALSE.)
ind2=ind1+2*l+1
C Since there is no SO, prcrorb%matrep is of size 2*l+1, from -l to l.
C (the basis which mix up/dn states are not possible here.)
C In the D_orth matrix, the projection matrix ranges from the line (ind1+1) to the line ind2.
C The projector is stored in the pr_crorb%matrep (from -l to l).
pr_crorb(icrorb,ik,is)%mat_rep
& (-l:l,nbbot:nbtop)=D_orth(ind1+1:ind2,1:nbnd)
ind1=ind2
ENDIF ! End of the ifsplit if-then-else
ENDIF ! End of the l=0 if-then-else
ENDDO ! End of the icrorb loop
C prcrorb%matrep contains now the orthonormalized projectors.
DEALLOCATE(D_orth)
ENDDO ! End of the loop on is
ENDDO ! End of the loop on ik
DEALLOCATE(Dmat)
C
C =============================================================================
C Printing the projectors with k-points 1 and nk in the file fort.18 for test :
C =============================================================================
DO icrorb=1,ncrorb
iatom=crorb(icrorb)%atom
isrt=crorb(icrorb)%sort
l=crorb(icrorb)%l
WRITE(18,'()')
WRITE(18,'(a)') 'apres othonormalizsation'
WRITE(18,'(a,i4)') 'icrorb = ', icrorb
WRITE(18,'(a,i4,a,i4)') 'isrt = ', isrt, ' l = ', l
IF (l==0) THEN
WRITE(18,'(a,i4)') 'ik = ', 1
DO ib = kp(1,1)%nb_bot,kp(1,1)%nb_top
WRITE(18,*) pr_crorb(icrorb,1,1)%mat_rep(:,ib)
IF (ifSP)
& WRITE(18,*) pr_crorb(icrorb,1,2)%mat_rep(:,ib)
WRITE(18,'()')
ENDDO
WRITE(18,'(a,i4)') 'ik = ', nk
DO ib = kp(nk,1)%nb_bot,kp(nk,1)%nb_top
WRITE(18,*) pr_crorb(icrorb,nk,1)%mat_rep(:,ib)
IF (ifSP)
& WRITE(18,*) pr_crorb(icrorb,nk,2)%mat_rep(:,ib)
WRITE(18,'()')
ENDDO
ELSEIF (reptrans(l,isrt)%ifmixing) THEN
WRITE(18,'(a,i4)') 'ik = ', 1
DO ib = kp(1,1)%nb_bot,kp(1,1)%nb_top
WRITE(18,*) pr_crorb(icrorb,1,1)%mat_rep(:,ib)
WRITE(18,'()')
ENDDO
WRITE(18,'(a,i4)') 'ik = ', nk
DO ib = kp(nk,1)%nb_bot,kp(nk,1)%nb_top
WRITE(18,*) pr_crorb(icrorb,nk,1)%mat_rep(:,ib)
WRITE(18,'()')
ENDDO
ELSE
WRITE(18,'(a,i4)') 'ik = ', 1
DO ib = kp(1,1)%nb_bot,kp(1,1)%nb_top
WRITE(18,*) pr_crorb(icrorb,1,1)%mat_rep(:,ib)
IF (ifSP)
& WRITE(18,*) pr_crorb(icrorb,1,2)%mat_rep(:,ib)
WRITE(18,'()')
ENDDO
WRITE(18,'(a,i4)') 'ik = ', nk
DO ib = kp(nk,1)%nb_bot,kp(nk,1)%nb_top
WRITE(18,*) pr_crorb(icrorb,nk,1)%mat_rep(:,ib)
IF (ifSP)
& WRITE(18,*) pr_crorb(icrorb,nk,2)%mat_rep(:,ib)
WRITE(18,'()')
ENDDO
ENDIF
ENDDO
C
RETURN
END
SUBROUTINE orthogonal_wannier_SO
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine orthonormalizes the Wannier-like functions %%
C %% obtained with the projectors P(icrorb,ik,is), in order to %%
C %% get a set of "true" Wannier orbitals. %%
C %% %%
C %% Only the correlated orbitals are treated here. %%
C %% %%
C %% THIS VERSION MUST BE USED WITH SPIN-ORBIT %%
C %% (since the calculation for up/dn states is made simultaneously) %%
C %% THIS VERSION CAN NOT BE USED WITHOUT SPIN-POLARIZED INPUT FILES.%%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE almblm_data
USE common_data
USE prnt
USE projections
USE reps
IMPLICIT NONE
COMPLEX(KIND=8), DIMENSION(:,:), ALLOCATABLE :: Dmat, D_orth, D
INTEGER :: is, ik, l, nbnd, ndim, isrt, nbbot, nbtop
INTEGER :: icrorb, ind1, ind2, iatom, ib
INTEGER :: m1, m2, irep
C
WRITE(buf,'(a)')'Orthonormalization of the projectors...'
CALL printout(0)
CALL printout(0)
C ---------------------------------------------------------------------------------------
C Interruption of the prgm if there is no dn part of pr_crorb.
C -------------------------
C
IF(.not.ifSP) THEN
WRITE(buf,'(a,a,i2,a)')'The projectors on ',
& 'the dn states are required for isrt = ',isrt,
& ' but there is no spin-polarized input files.'
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
STOP
ENDIF
C ---------------------------------------------------------------------------------------
C
C =====================================
C Creation of the overlap matrix Dmat :
C =====================================
C
C -----------------------------------------------------------
C Determination of the dimension ndim of the overlap matrix :
C -----------------------------------------------------------
ndim=0
C Loop on the correlated orbitals
DO icrorb=1,ncrorb
isrt=crorb(icrorb)%sort
l=crorb(icrorb)%l
C The case l=0 is a particular case of "non-mixing" basis.
C --------------------------------------------------------
IF (l==0) THEN
C Since this subroutine is used only in the case with SO,
C the only irep possible for s-orbital is the matrix itself.
ndim=ndim+2
C If the basis representation needs a complete spinor rotation approach (basis with "mixing" ).
C ---------------------------------------------------------------------------------------------
ELSEIF (reptrans(l,isrt)%ifmixing) THEN
C the projectors of the correlated ireps are considered if there are any. (ifsplit=.TRUE.)
IF(crorb(icrorb)%ifsplit) THEN
DO irep=1,reptrans(l,isrt)%nreps
IF(crorb(icrorb)%correp(irep)) THEN
ndim=ndim+reptrans(l,isrt)%dreps(irep)
ENDIF
C The dimension of the irep is added to ndim.
ENDDO
ELSE
C If no particular irep is considered (ifsplit=.FALSE.),
C The whole matrix of the representation is considered.
ndim=ndim+2*(2*l+1)
ENDIF
C If the basis representation can be reduce to the up/up block (basis without "mixing").
C --------------------------------------------------------------------------------------
ELSE
C Since this subroutine is used only in the case with SO,
C the only irep possible for this orbital is the matrix itself.
ndim=ndim+2*(2*l+1)
ENDIF
ENDDO
C ------------------
C Creation of Dmat :
C ------------------
ALLOCATE(Dmat(1:ndim,1:ndim))
C
C =====================================================================
C Computation of the orthonormalized Wannier functions and projectors :
C =====================================================================
C The computation is performed for each k_point independently
C because they are still good quantum numbers.
DO ik=1,nk
C Only the k-points with inlcuded bands are considered for the projectors.
IF(.NOT.kp(ik,1)%included) CYCLE
nbnd=kp(ik,1)%nb_top-kp(ik,1)%nb_bot+1
nbbot=kp(ik,1)%nb_bot
nbtop=kp(ik,1)%nb_top
C it was checked that nbtop(up)=nbtop(dn) and nbbot(up)=nbbot(dn)
C for a computation with SO [in set_projections.f]
ALLOCATE(D(1:ndim,1:nbnd))
C
C --------------------------------
C Initialization of the D matrix :
C --------------------------------
C This D matrix of size ndim*nbnd is the complete "projector matrix"
C which enables to go from the Wannier-like basis |u_orb> to the Bloch states |ik,ib>.
ind1=0
DO icrorb=1,ncrorb
isrt=crorb(icrorb)%sort
l=crorb(icrorb)%l
C The case l=0 is a particular case of "non-mixing" basis.
C --------------------------------------------------------
IF (l==0) THEN
C the only irep possible for s-orbital is the matrix itself.
DO is=1,ns
C D(ind1,1:nbnd)=
C Bug correction 8.11.2012
D(ind1+1,1:nbnd)=
& pr_crorb(icrorb,ik,is)%mat_rep(1,nbbot:nbtop)
ind1=ind1+1
ENDDO
C If the basis representation needs a complete spinor rotation approach (basis with "mixing" ).
C ---------------------------------------------------------------------------------------------
ELSEIF (reptrans(l,isrt)%ifmixing) THEN
C In this case, the projection matrix is stored in prcrorb%matrep with is=1.
C the projectors of the correlated ireps are considered if there are any. (ifsplit=.TRUE.)
IF (crorb(icrorb)%ifsplit) THEN
m1=0
DO irep=1,reptrans(l,isrt)%nreps
IF (crorb(icrorb)%correp(irep)) THEN
m2=m1+reptrans(l,isrt)%dreps(irep)
ind2=ind1+reptrans(l,isrt)%dreps(irep)
C The states range from m1+1 to m2 in the irep.
C The corresponding projector is stored from the line (ind1+1) to the line ind2, in the D matrix.
D(ind1+1:ind2,1:nbnd)=pr_crorb(icrorb,ik,1)%
& mat_rep(m1+1:m2,nbbot:nbtop)
ind1=ind2
ENDIF
m1=m1+reptrans(l,isrt)%dreps(irep)
ENDDO
ELSE
C The projectors of the whole correlated representation is considered. (ifsplit=.FALSE.)
ind2=ind1+2*(2*l+1)
C The corresponding projection matrix is stored from the line (ind1+1) to the line ind2, in the D matrix.
D(ind1+1:ind2,1:nbnd)=pr_crorb(icrorb,ik,1)%
& mat_rep(1:2*(2*l+1),nbbot:nbtop)
ind1=ind2
ENDIF ! End of the ifsplit if-then-else
C If the basis representation can be reduce to the up/up block (basis without "mixing").
C --------------------------------------------------------------------------------------
ELSE
C the only irep possible for such an orbital is the matrix itself.
DO is=1,ns
ind2=ind1+2*l+1
D(ind1+1:ind2,1:nbnd)=
& pr_crorb(icrorb,ik,is)%mat_rep(-l:l,nbbot:nbtop)
ind1=ind2
ENDDO
ENDIF ! End of the ifmixing if-then-else
ENDDO ! End of the icrorb loop
C
C ----------------------------------------
C Computation of the overlap matrix Dmat :
C ----------------------------------------
C The overlap matrix is stored in Dmat = D*transpose(conjugate(D))
CALL ZGEMM('N','C',ndim,ndim,nbnd,DCMPLX(1.D0,0.D0),
& D,ndim,D,ndim,DCMPLX(0.D0,0.D0),Dmat,ndim)
C
C -------------------------------------------
C Computation of the matrix S = Dmat^{-1/2} :
C -------------------------------------------
CALL orthogonal_h(Dmat,ndim,.TRUE.)
C This matrix is stored in Dmat.
C
C -----------------------------------------------
C Computation of the orthonormalized projectors :
C -----------------------------------------------
C The calculation performed is the following : P=O^(-1/2)*P_tilde.
C Its value is stored in the matrix D_orth (of size ndim*nbnd)
ALLOCATE(D_orth(1:ndim,1:nbnd))
CALL ZGEMM('N','N',ndim,nbnd,ndim,DCMPLX(1.D0,0.D0),
& Dmat,ndim,D,ndim,DCMPLX(0.D0,0.D0),D_orth,ndim)
DEALLOCATE(D)
C
C --------------------------------------------------------------------------------
C Storing the value of the orthonormalized projectors in the pr_crorb structures :
C --------------------------------------------------------------------------------
ind1=0
DO icrorb=1,ncrorb
isrt=crorb(icrorb)%sort
l=crorb(icrorb)%l
C The case l=0 is a particular case of "non-mixing" basis.
C --------------------------------------------------------
IF (l==0) THEN
C the only irep possible for s-orbital is the matrix itself.
DO is=1,ns
pr_crorb(icrorb,ik,is)%mat_rep(1,nbbot:nbtop)=
& D_orth(ind1+1,1:nbnd)
ind1=ind1+1
ENDDO
C If the basis representation needs a complete spinor rotation approach (basis with "mixing" ).
C ---------------------------------------------------------------------------------------------
ELSEIF (reptrans(l,isrt)%ifmixing) THEN
C the projectors of the correlated ireps are considered if there are any. (ifsplit=.TRUE.)
IF(crorb(icrorb)%ifsplit) THEN
m1=0
DO irep=1,reptrans(l,isrt)%nreps
IF (crorb(icrorb)%correp(irep)) THEN
m2=m1+reptrans(l,isrt)%dreps(irep)
ind2=ind1+reptrans(l,isrt)%dreps(irep)
C In the D_orth matrix, the corresponding part of the projection matrix ranges from the line (ind1+1) to the line ind2.
C The projector associated to the ireps is stored in the prcrorb%matrep from m1+1 to m2.
pr_crorb(icrorb,ik,1)%mat_rep(m1+1:m2,nbbot:nbtop)
& =D_orth(ind1+1:ind2,1:nbnd)
ind1=ind2
ENDIF
m1=m1+reptrans(l,isrt)%dreps(irep)
ENDDO
ELSE
C The projectors of the whole correlated representation is considered. (ifsplit=.FALSE.)
ind2=ind1+2*(2*l+1)
C The corresponding projection matrix is stored from the line (ind1+1) to the line ind2, in the D matrix.
pr_crorb(icrorb,ik,1)%mat_rep(1:2*(2*l+1),nbbot:nbtop)
& =D_orth(ind1+1:ind2,1:nbnd)
ind1=ind2
ENDIF ! End of the ifsplit if-then-else
C If the basis representation can be reduce to the up/up block (basis without "mixing").
C --------------------------------------------------------------------------------------
ELSE
C the only irep possible for this orbital is the matrix itself.
DO is=1,ns
ind2=ind1+2*l+1
pr_crorb(icrorb,ik,is)%mat_rep(-l:l,nbbot:nbtop)
& =D_orth(ind1+1:ind2,1:nbnd)
ind1=ind2
ENDDO
ENDIF ! End of the ifmixing if-then-else
ENDDO ! End of the icrorb loop
DEALLOCATE(D_orth)
ENDDO ! End of the loop on ik
DEALLOCATE(Dmat)
C
C =============================================================================
C Printing the projectors with k-points 1 and nk in the file fort.18 for test :
C =============================================================================
DO icrorb=1,ncrorb
iatom=crorb(icrorb)%atom
isrt=crorb(icrorb)%sort
l=crorb(icrorb)%l
WRITE(18,'()')
WRITE(18,'(a)') 'apres othonormalizsation'
WRITE(18,'(a,i4)') 'icrorb = ', icrorb
WRITE(18,'(a,i4,a,i4)') 'isrt = ', isrt, ' l = ', l
IF (l==0) THEN
WRITE(18,'(a,i4)') 'ik = ', 1
DO ib = kp(1,1)%nb_bot,kp(1,1)%nb_top
WRITE(18,*) pr_crorb(icrorb,1,1)%mat_rep(:,ib)
IF (ifSP)
& WRITE(18,*) pr_crorb(icrorb,1,2)%mat_rep(:,ib)
WRITE(18,'()')
ENDDO
WRITE(18,'(a,i4)') 'ik = ', nk
DO ib = kp(nk,1)%nb_bot,kp(nk,1)%nb_top
WRITE(18,*) pr_crorb(icrorb,nk,1)%mat_rep(:,ib)
IF (ifSP)
& WRITE(18,*) pr_crorb(icrorb,nk,2)%mat_rep(:,ib)
WRITE(18,'()')
ENDDO
ELSEIF (reptrans(l,isrt)%ifmixing) THEN
WRITE(18,'(a,i4)') 'ik = ', 1
DO ib = kp(1,1)%nb_bot,kp(1,1)%nb_top
WRITE(18,*) pr_crorb(icrorb,1,1)%mat_rep(:,ib)
WRITE(18,'()')
ENDDO
WRITE(18,'(a,i4)') 'ik = ', nk
DO ib = kp(nk,1)%nb_bot,kp(nk,1)%nb_top
WRITE(18,*) pr_crorb(icrorb,nk,1)%mat_rep(:,ib)
WRITE(18,'()')
ENDDO
ELSE
WRITE(18,'(a,i4)') 'ik = ', 1
DO ib = kp(1,1)%nb_bot,kp(1,1)%nb_top
WRITE(18,*) pr_crorb(icrorb,1,1)%mat_rep(:,ib)
IF (ifSP)
& WRITE(18,*) pr_crorb(icrorb,1,2)%mat_rep(:,ib)
WRITE(18,'()')
ENDDO
WRITE(18,'(a,i4)') 'ik = ', nk
DO ib = kp(nk,1)%nb_bot,kp(nk,1)%nb_top
WRITE(18,*) pr_crorb(icrorb,nk,1)%mat_rep(:,ib)
IF (ifSP)
& WRITE(18,*) pr_crorb(icrorb,nk,2)%mat_rep(:,ib)
WRITE(18,'()')
ENDDO
ENDIF
ENDDO
C
RETURN
END

287
fortran/dmftproj/outband.f Normal file
View File

@ -0,0 +1,287 @@
c ******************************************************************************
c
c TRIQS: a Toolbox for Research in Interacting Quantum Systems
c
c Copyright (C) 2011 by L. Pourovskii, V. Vildosola, C. Martins, M. Aichhorn
c
c TRIQS is free software: you can redistribute it and/or modify it under the
c terms of the GNU General Public License as published by the Free Software
c Foundation, either version 3 of the License, or (at your option) any later
c version.
c
c TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
c WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
c FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
c details.
c
c You should have received a copy of the GNU General Public License along with
c TRIQS. If not, see <http://www.gnu.org/licenses/>.
c
c *****************************************************************************/
SUBROUTINE outband
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine creates the output file case.outband, with all %%
C %% the informations necessary for the computation of the spectral %%
C %% function of the system. %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definition of the variables :
C -----------------------------
USE almblm_data
USE bands
USE common_data
USE file_names
USE prnt
USE projections
USE reps
IMPLICIT NONE
C
INTEGER :: iorb, icrorb, irep, isrt
INTEGER :: l, m, is, i1, i2, i
INTEGER :: ik, il, ib, ir, n
INTEGER :: ind1, ind2, iatom
C
WRITE(buf,'(a)')'Writing the file case.outband...'
CALL printout(0)
C
C ======================================
C Informations about the chosen k-path :
C ======================================
C
C Number of k-points along the chosen k-path
WRITE(ouband,'(i6)') nkband
C Description of the number of bands in the energy window at each k_point
C
DO is=1,ns
C If SO is considered, the number of up and dn bands are the same.
IF ((ifSP.AND.ifSO).and.(is.eq.2)) cycle
DO ik=1,nk
WRITE(ouband,'(i6)')
& ABS(kp(ik,is)%nb_top-kp(ik,is)%nb_bot+1)
ENDDO ! End of the ik loop
ENDDO ! End of the is loop
C for each k-point, the number of band included in the energy window is written.
C ===========================================================
C Description of the projectors for the correlated orbitals :
C ===========================================================
DO ik=1,nk
DO icrorb=1,ncrorb
l=crorb(icrorb)%l
isrt=crorb(icrorb)%sort
C
C The case l=0 is a particular case of "non-mixing" basis.
C --------------------------------------------------------
IF (l==0) THEN
C For the s-orbitals, the only irep possible is the matrix itself.
DO is=1,ns
WRITE(ouband,*)
& REAL(pr_crorb(icrorb,ik,is)%mat_rep(1,
& kp(ik,is)%nb_bot:kp(ik,is)%nb_top))
ENDDO
DO is=1,ns
WRITE(ouband,*)
& AIMAG(pr_crorb(icrorb,ik,is)%mat_rep(1,
& kp(ik,is)%nb_bot:kp(ik,is)%nb_top))
ENDDO
C
C If the basis representation needs a complete spinor rotation approach (basis with "mixing" ).
C ---------------------------------------------------------------------------------------------
ELSEIF (reptrans(l,isrt)%ifmixing) THEN
C In this case, the SO is necessary considered, spinor rotation matrices are used.
IF(crorb(icrorb)%ifsplit) THEN
C If only 1 irep is correlated
ind1=1
DO irep=1,reptrans(l,isrt)%nreps
IF(crorb(icrorb)%correp(irep)) THEN
ind2=ind1+reptrans(l,isrt)%dreps(irep)-1
DO m=ind1,ind2
WRITE(ouband,*)
& REAL(pr_crorb(icrorb,ik,1)%mat_rep(m,
& kp(ik,1)%nb_bot:kp(ik,1)%nb_top))
ENDDO
DO m=ind1,ind2
WRITE(ouband,*)
& AIMAG(pr_crorb(icrorb,ik,1)%mat_rep(m,
& kp(ik,1)%nb_bot:kp(ik,1)%nb_top))
ENDDO
ENDIF
ind1=ind1+reptrans(l,isrt)%dreps(irep)
ENDDO
ELSE
C If no particular irep is correlated
DO m=1,2*(2*l+1)
WRITE(ouband,*)
& REAL(pr_crorb(icrorb,ik,1)%mat_rep(m,
& kp(ik,1)%nb_bot:kp(ik,1)%nb_top))
ENDDO
DO m=1,2*(2*l+1)
WRITE(ouband,*)
& AIMAG(pr_crorb(icrorb,ik,1)%mat_rep(m,
& kp(ik,1)%nb_bot:kp(ik,1)%nb_top))
ENDDO
ENDIF
C
C If the basis representation can be reduce to the up/up block (basis without "mixing").
C --------------------------------------------------------------------------------------
ELSE
IF ((.not.(ifSP.AND.ifSO)).AND.crorb(icrorb)%ifsplit) THEN
C If only 1 irep is correlated (case without SO)
ind1=-l
DO irep=1,reptrans(l,isrt)%nreps
IF(crorb(icrorb)%correp(irep)) THEN
ind2=ind1+reptrans(l,isrt)%dreps(irep)-1
DO is=1,ns
DO m=ind1,ind2
WRITE(ouband,*)
& REAL(pr_crorb(icrorb,ik,is)%mat_rep(m,
& kp(ik,is)%nb_bot:kp(ik,is)%nb_top))
ENDDO
ENDDO
DO is=1,ns
DO m=ind1,ind2
WRITE(ouband,*)
& AIMAG(pr_crorb(icrorb,ik,is)%mat_rep(m,
& kp(ik,is)%nb_bot:kp(ik,is)%nb_top))
ENDDO
ENDDO
ENDIF
ind1=ind1+reptrans(l,isrt)%dreps(irep)
ENDDO
ELSE
C If no particular irep is correlated (case with and without SO)
DO is=1,ns
DO m=-l,l
WRITE(ouband,*)
& REAL(pr_crorb(icrorb,ik,is)%mat_rep(m,
& kp(ik,is)%nb_bot:kp(ik,is)%nb_top))
ENDDO
ENDDO
DO is=1,ns
DO m=-l,l
WRITE(ouband,*)
& AIMAG(pr_crorb(icrorb,ik,is)%mat_rep(m,
& kp(ik,is)%nb_bot:kp(ik,is)%nb_top))
ENDDO
ENDDO
END IF ! End of the ifsplit if-then-else
END IF ! End of the ifmixing if-then-else
END DO ! End of the icrorb loop
END DO ! End of the ik loop
C for each k-point and each correlated orbital, the corresponding projector is described by :
C - the real part of the "correlated" submatrix
C - the imaginary part of the "correlated" submatrix
C
C ======================================================
C Description of the Hamiltonian H(k) at each k_point :
C ======================================================
DO is=1,ns
DO ik=1,nk
C If SO is considered, the numbers of up and dn bands are the same.
IF (ifSO.and.is.eq.2) cycle
DO ib=kp(ik,is)%nb_bot,kp(ik,is)%nb_top
WRITE(ouband,*) kp(ik,is)%eband(ib)
ENDDO
ENDDO ! End of the ik loop
ENDDO ! End of the is loop
C for each spin value is and each k-point,
C - the energies of the band with spin is at point k
C
C ================================================================
C Description of the size of the basis for each included orbital :
C ================================================================
DO iorb=1,norb
WRITE(ouband,'(3(i6))') norm_radf(iorb)%n
ENDDO
C There is not more than 1 LO for each orbital (hence n < 4 )
C
C ====================================
C Description of the Theta projector :
C ====================================
DO iorb=1,norb
l=orb(iorb)%l
isrt=orb(iorb)%sort
C
C The case l=0 is a particular case of "non-mixing" basis.
C --------------------------------------------------------
IF (l==0) THEN
DO ik=1,nk
DO ir=1,norm_radf(iorb)%n
DO is=1,ns
WRITE(ouband,*)
& REAL(pr_orb(iorb,ik,is)%matn_rep(1,
& kp(ik,is)%nb_bot:kp(ik,is)%nb_top,ir))
ENDDO
DO is=1,ns
WRITE(ouband,*)
& AIMAG(pr_orb(iorb,ik,is)%matn_rep(1,
& kp(ik,is)%nb_bot:kp(ik,is)%nb_top,ir))
ENDDO
ENDDO ! End of the ir loop
ENDDO ! End of the ik loop
C
C If the basis representation needs a complete spinor rotation approach (basis with "mixing" ).
C ---------------------------------------------------------------------------------------------
ELSEIF (reptrans(l,isrt)%ifmixing) THEN
C In this case, the calculation is necessary spin-polarized with SO, spinor rotation matrices are used.
DO ik=1,nk
DO ir=1,norm_radf(iorb)%n
DO m=1,2*(2*l+1)
WRITE(ouband,*)
& REAL(pr_orb(iorb,ik,1)%matn_rep(m,
& kp(ik,1)%nb_bot:kp(ik,1)%nb_top,ir))
ENDDO
DO m=1,2*(2*l+1)
WRITE(ouband,*)
& AIMAG(pr_orb(iorb,ik,1)%matn_rep(m,
& kp(ik,1)%nb_bot:kp(ik,1)%nb_top,ir))
ENDDO
ENDDO ! End of the ir loop
ENDDO ! End of the ik loop
C
C If the basis representation can be reduce to the up/up block (basis without "mixing").
C --------------------------------------------------------------------------------------
ELSE
DO ik=1,nk
DO ir=1,norm_radf(iorb)%n
DO is=1,ns
DO m=-l,l
WRITE(ouband,*)
& REAL(pr_orb(iorb,ik,is)%matn_rep(m,
& kp(ik,is)%nb_bot:kp(ik,is)%nb_top,ir))
ENDDO
ENDDO ! End of the is loop
DO is=1,ns
DO m=-l,l
WRITE(ouband,*)
& AIMAG(pr_orb(iorb,ik,is)%matn_rep(m,
& kp(ik,is)%nb_bot:kp(ik,is)%nb_top,ir))
ENDDO
ENDDO ! End of the is loop
ENDDO ! End of the ir loop
ENDDO ! End of the ik loop
ENDIF ! End of the ifmixing if-then-else
ENDDO ! End of the iorb loop
C for each included orbital, for each k-point and each |phi_j> elmt,
C the corresponding Thetaprojector is described by :
C - the real part of the matrix
C - the imaginary part of the matrix
C
C =============================
C Description of the k-labels :
C =============================
DO i=1,nlab
WRITE(ouband,'(2i6,a)') i,labels(i)%pos,labels(i)%kname
ENDDO
C for each label, are written :
C - the number of the corresponding k-point in the k-path
C - the name associated to this label
C
RETURN
END

View File

@ -0,0 +1,92 @@
c ******************************************************************************
c
c TRIQS: a Toolbox for Research in Interacting Quantum Systems
c
c Copyright (C) 2011 by L. Pourovskii, V. Vildosola, C. Martins, M. Aichhorn
c
c TRIQS is free software: you can redistribute it and/or modify it under the
c terms of the GNU General Public License as published by the Free Software
c Foundation, either version 3 of the License, or (at your option) any later
c version.
c
c TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
c WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
c FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
c details.
c
c You should have received a copy of the GNU General Public License along with
c TRIQS. If not, see <http://www.gnu.org/licenses/>.
c
c *****************************************************************************/
SUBROUTINE outbwin
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine creates the output file case.oubwin %%
C %% which contains all the informations for the charge density %%
C %% self-consistency. %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definition of the variables :
C ----------------------------
USE almblm_data
USE common_data
USE file_names
USE prnt
IMPLICIT NONE
INTEGER :: is, ik, ou
C
WRITE(buf,'(a)')'Writing the file case.outbwin...'
CALL printout(0)
C
DO is=1,ns
C ====================================
C Definition of the file case.oubwin :
C ====================================
C If the computations is spin-polarized, the output file is divided
C in two files : case.oubwinup and case.oubwindn
IF(ifSP.AND.is==1) THEN
ou=oubwinup
ELSEIF(ifSP.AND.is==2) THEN
ou=oubwindn
ELSE
ou=oubwin
ENDIF
C =======================================
C General informations about the system :
C =======================================
C
C Number of k-points in the I-BZ
WRITE(ou,'(i6)') nk
C Definition of the Spin-orbit flag ifSO
IF(ifSO) THEN
WRITE(ou,'(i6)') 1
ELSE
WRITE(ou,'(i6)') 0
ENDIF
C ====================================================
C Description of the main properties of each k-point :
C ====================================================
DO ik=1,nk
C Description of the if-included flag
IF(kp(ik,is)%included) THEN
WRITE(ou,'(i6)') 1
ELSE
WRITE(ou,'(i6)') 0
ENDIF
IF(kp(ik,is)%included) THEN
C Range of bands included at each k-point
WRITE(ou,'(2(i6))') kp(ik,is)%nb_bot,kp(ik,is)%nb_top
C Weight associated to each k-point (for the simple point integration)
WRITE(ou,*) kp(ik,is)%weight
ENDIF
ENDDO ! End of the ik loop
ENDDO ! End of the is loop
C
RETURN
END

1405
fortran/dmftproj/outputqmc.f Normal file

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,98 @@
c ******************************************************************************
c
c TRIQS: a Toolbox for Research in Interacting Quantum Systems
c
c Copyright (C) 2011 by L. Pourovskii, V. Vildosola, C. Martins, M. Aichhorn
c
c TRIQS is free software: you can redistribute it and/or modify it under the
c terms of the GNU General Public License as published by the Free Software
c Foundation, either version 3 of the License, or (at your option) any later
c version.
c
c TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
c WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
c FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
c details.
c
c You should have received a copy of the GNU General Public License along with
c TRIQS. If not, see <http://www.gnu.org/licenses/>.
c
c *****************************************************************************/
SUBROUTINE read_k_list
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine reads the labels of high-symmetry points %%
C %% along the k-path chosen for plotting the k-resolved spectral %%
C %% function. %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ---------------------------
USE bands
USE file_names
IMPLICIT NONE
CHARACTER(len=100) :: buf
INTEGER :: ilab, pos, i
C
C ========================================================================
C Determination of the total number of labels and the number of k-points :
C ========================================================================
buf=' '
nlab=0
pos=0
C nlab will count the number of labels met.
C pos will count the number of lines
C (which is also the number of k-points along the k-path)
DO WHILE (buf(1:3).NE.'END')
READ(iuklist,'(a)') buf
pos=pos+1
IF(buf(1:1).NE.' ') THEN
nlab=nlab+1
ENDIF
ENDDO
C pos is now the number of line of the file.
C nlab is the number of labels, includind the label 'END'
C
C nkband = number of k-points along the k-path.
nkband=pos-1
C The label 'END' must not be taken into account
nlab=nlab-1
C The last line of the file case.klist_band contains "END".
C So the while loop can have an end too.
C
C =============================
C Determination of the labels :
C =============================
ALLOCATE(labels(nlab))
C The file case.klist_band is read again.
REWIND(iuklist)
ilab=0
DO pos=1,nkband
READ(iuklist,'(a)') buf
IF(buf(1:1).NE.' ') THEN
ilab=ilab+1
labels(ilab)%pos=pos
C labels(ilab)%pos is the number of the corresponding k-point
i=INDEX(buf,' ')
C determination of the size of buf
C (index is a function which finds the index of ' ' in buf)
labels(ilab)%kname=' '
labels(ilab)%kname(1:i)=buf(1:i)
C labels(ilab)%kname is the corresponding label
ENDIF
ENDDO
C ======================================
C Printing the labels read for testing :
C ======================================
WRITE(*,*) nkband
WRITE(*,*)'nlab = ', nlab
DO i=1,nlab
WRITE(*,*) i, labels(i)%pos, labels(i)%kname
ENDDO
C
RETURN
END

View File

@ -0,0 +1,105 @@
c ******************************************************************************
c
c TRIQS: a Toolbox for Research in Interacting Quantum Systems
c
c Copyright (C) 2011 by L. Pourovskii, V. Vildosola, C. Martins, M. Aichhorn
c
c TRIQS is free software: you can redistribute it and/or modify it under the
c terms of the GNU General Public License as published by the Free Software
c Foundation, either version 3 of the License, or (at your option) any later
c version.
c
c TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
c WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
c FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
c details.
c
c You should have received a copy of the GNU General Public License along with
c TRIQS. If not, see <http://www.gnu.org/licenses/>.
c
c *****************************************************************************/
SUBROUTINE readcomline
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine reads and process the command line options %%
C %% (Only -so, -sp and -band are the possible ones). %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE common_data
USE prnt
IMPLICIT NONE
CHARACTER(len=100) :: buf1
CHARACTER(len=100), DIMENSION(:), ALLOCATABLE :: flags
INTEGER :: i1, iargc, iarg
LOGICAL :: ifError
C Process the command line :
C ---------------------------
iarg=iargc()
ALLOCATE(flags(iarg))
ifSP=.FALSE.
ifSO=.FALSE.
ifBAND=.FALSE.
ifError=.FALSE.
DO i1=1,iarg
CALL getarg(i1,buf1)
READ(buf1,*)flags(i1)
flags(i1)=ADJUSTL(flags(i1))
CALL makelowcase(flags(i1))
SELECT CASE(flags(i1)(1:5))
CASE('-sp ')
ifSP=.TRUE.
CASE('-so ')
ifSO=.TRUE.
CASE('-band')
ifBAND=.TRUE.
CASE DEFAULT
ifError=.TRUE.
EXIT
END SELECT
ENDDO
C ---------------------------------------------------------------------------------------
C Interruption of the prgm if the options are not recognized.
C -------------------------
C
IF (ifError) THEN
WRITE(6,'(a,a,a)')'Command line option: ',flags(i1)(1:5),
& ' is not recognized.'
WRITE(6,'(a)')'END OF THE PRGM'
STOP
ENDIF
C ---------------------------------------------------------------------------------------
DEALLOCATE(flags)
C
RETURN
END
SUBROUTINE makelowcase(string)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine modifies the input string into low case %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
IMPLICIT NONE
CHARACTER*26 :: upperabc
CHARACTER*26 :: lowabc
CHARACTER* (*) string
INTEGER :: i,k
PARAMETER(upperabc='ABCDEFHGIJKLMNOPQRSTUVWXYZ')
PARAMETER(lowabc='abcdefhgijklmnopqrstuvwxyz')
DO i=1,len(string)
DO k=1,26
IF(string(i:i)==upperabc(k:k)) string(i:i)=lowabc(k:k)
ENDDO
ENDDO
RETURN
END

239
fortran/dmftproj/rot_dens.f Normal file
View File

@ -0,0 +1,239 @@
c ******************************************************************************
c
c TRIQS: a Toolbox for Research in Interacting Quantum Systems
c
c Copyright (C) 2011 by L. Pourovskii, V. Vildosola, C. Martins, M. Aichhorn
c
c TRIQS is free software: you can redistribute it and/or modify it under the
c terms of the GNU General Public License as published by the Free Software
c Foundation, either version 3 of the License, or (at your option) any later
c version.
c
c TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
c WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
c FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
c details.
c
c You should have received a copy of the GNU General Public License along with
c TRIQS. If not, see <http://www.gnu.org/licenses/>.
c
c *****************************************************************************/
SUBROUTINE rotdens_mat(Dmat,orbit,norbit)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine applies to each density matrix in Dmat %%
C %% the transformation to go from the global coordinates to the %%
C %% local coordinates associated to the considered orbital. %%
C %% %%
C %% This version can be used for SO computations. %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definition of the variables :
C ----------------------------
USE common_data
USE projections
USE symm
USE reps
IMPLICIT NONE
INTEGER :: norbit
TYPE(matrix), DIMENSION(nsp,norbit) :: Dmat
COMPLEX(KIND=8),DIMENSION(:,:), ALLOCATABLE :: rot_dmat
COMPLEX(KIND=8),DIMENSION(:,:), ALLOCATABLE :: tmp_mat
COMPLEX(KIND=8):: ephase
REAL(KIND=8):: factor
TYPE(orbital), DIMENSION(norbit) :: orbit
INTEGER :: iatom, isrt, iorb, is, is1, l, i, m
C
C
DO iorb=1,norbit
l=orbit(iorb)%l
isrt=orbit(iorb)%sort
iatom=orbit(iorb)%atom
C
IF(ifSP.AND.ifSO) THEN
C In this case, the complete spinor rotation approach (matrices of size 2*(2*l+1) ) is used for rotloc.
IF (l==0) THEN
C ------------------------------------------------------------------------------------------------------------
C For the s orbital, the spinor rotation matrix will be constructed directly from the Euler angles a,b and c :
C ------------------------------------------------------------------------------------------------------------
C Up/dn and Dn/up terms
ALLOCATE(tmp_mat(1:2,1:2))
ALLOCATE(rot_dmat(1:2,1:2))
IF (rotloc(iatom)%timeinv) THEN
factor=(rotloc(iatom)%a+rotloc(iatom)%g)/2.d0
tmp_mat(2,1)=EXP(CMPLX(0.d0,factor))*
& DCOS(rotloc(iatom)%b/2.d0)
tmp_mat(1,2)=-CONJG(tmp_mat(2,1))
C Up/dn and Dn/up terms
factor=-(rotloc(iatom)%a-rotloc(iatom)%g)/2.d0
tmp_mat(2,2)=-EXP(CMPLX(0.d0,factor))*
& DSIN(rotloc(iatom)%b/2.d0)
tmp_mat(1,1)=CONJG(tmp_mat(2,2))
C definition of the total density matrix
rot_dmat(1,1)=Dmat(1,iorb)%mat(1,1)
rot_dmat(2,2)=Dmat(2,iorb)%mat(1,1)
rot_dmat(1,2)=Dmat(3,iorb)%mat(1,1)
rot_dmat(2,1)=Dmat(4,iorb)%mat(1,1)
C going to the local basis
rot_dmat(1:2,1:2)=CONJG(MATMUl(
& rot_dmat(1:2,1:2),tmp_mat(1:2,1:2)))
rot_dmat(1:2,1:2)=MATMUl(
& TRANSPOSE(tmp_mat(1:2,1:2)),
& rot_dmat(1:2,1:2))
ELSE
factor=(rotloc(iatom)%a+rotloc(iatom)%g)/2.d0
tmp_mat(1,1)=EXP(CMPLX(0.d0,factor))*
& DCOS(rotloc(iatom)%b/2.d0)
tmp_mat(2,2)=CONJG(tmp_mat(1,1))
C Up/dn and Dn/up terms
factor=-(rotloc(iatom)%a-rotloc(iatom)%g)/2.d0
tmp_mat(1,2)=EXP(CMPLX(0.d0,factor))*
& DSIN(rotloc(iatom)%b/2.d0)
tmp_mat(2,1)=-CONJG(tmp_mat(1,2))
C definition of the total density matrix
rot_dmat(1,1)=Dmat(1,iorb)%mat(1,1)
rot_dmat(2,2)=Dmat(2,iorb)%mat(1,1)
rot_dmat(1,2)=Dmat(3,iorb)%mat(1,1)
rot_dmat(2,1)=Dmat(4,iorb)%mat(1,1)
C going to the local basis
rot_dmat(1:2,1:2)=MATMUl(
& TRANSPOSE(CONJG(tmp_mat(1:2,1:2))),
& rot_dmat(1:2,1:2))
rot_dmat(1:2,1:2)=MATMUl(
& rot_dmat(1:2,1:2),tmp_mat(1:2,1:2))
ENDIF
DEALLOCATE(tmp_mat)
C storing in Dmat
Dmat(1,iorb)%mat(1,1)=rot_dmat(1,1)
Dmat(2,iorb)%mat(1,1)=rot_dmat(2,2)
Dmat(3,iorb)%mat(1,1)=rot_dmat(1,2)
Dmat(4,iorb)%mat(1,1)=rot_dmat(2,1)
DEALLOCATE(rot_dmat)
ELSE
C -----------------------------------------------------------------------------------------------------
C If the basis representation needs a complete spinor rotation approach (matrices of size 2*(2*l+1) ) :
C -----------------------------------------------------------------------------------------------------
IF (reptrans(l,isrt)%ifmixing) THEN
C We use the complete spin-space representation, so no trick on indices is necessary.
C
C Application of the operation inverse(Rloc).Dmat.(Rloc) :
C -------------------------------------------------------
IF (rotloc(iatom)%timeinv) THEN
C In this case, the operators is antiunitary [ inverse(R)=transpose(R) ]
Dmat(1,iorb)%mat(:,:)=CONJG(
= MATMUL(Dmat(1,iorb)%mat(:,:),
& rotloc(iatom)%rotrep(l)%mat(:,:) ))
Dmat(1,iorb)%mat(:,:)=
= MATMUL(TRANSPOSE( rotloc(iatom)%
& rotrep(l)%mat(:,:) ),Dmat(1,iorb)%mat(:,:) )
C Dmat_{local} = inverse(Rloc) Dmat_{global}* Rloc*
C Dmat_{local} = transpose(Rloc) Dmat_{global}* Rloc*
ELSE
C In this case, all the operators are unitary [ inverse(R)=transpose(conjugate(R)) ]
Dmat(1,iorb)%mat(:,:)=
= MATMUL(Dmat(1,iorb)%mat(:,:),
& rotloc(iatom)%rotrep(l)%mat(:,:) )
Dmat(1,iorb)%mat(:,:)=
= MATMUL(TRANSPOSE(CONJG( rotloc(iatom)%
& rotrep(l)%mat(:,:) )),Dmat(1,iorb)%mat(:,:) )
C Dmat_{local} = <x_local | x_global> Dmat_{global} <x_global | x_local>
C Dmat_{local} = inverse(Rloc) Dmat_{global} Rloc
ENDIF
C
ELSE
C ----------------------------------------------------------------------------------------------
C If the basis representation can be reduce to the up/up block (matrices of size (2*l+1) only) :
C ----------------------------------------------------------------------------------------------
C definition of the total density matrix
ALLOCATE(rot_dmat(1:2*(2*l+1),1:2*(2*l+1)))
rot_dmat(1:(2*l+1),1:(2*l+1))=
& Dmat(1,iorb)%mat(-l:l,-l:l)
rot_dmat(2*l+2:2*(2*l+1),2*l+2:2*(2*l+1))=
& Dmat(2,iorb)%mat(-l:l,-l:l)
rot_dmat(1:(2*l+1),2*l+2:2*(2*l+1))=
& Dmat(3,iorb)%mat(-l:l,-l:l)
rot_dmat(2*l+2:2*(2*l+1),1:(2*l+1))=
& Dmat(4,iorb)%mat(-l:l,-l:l)
IF (rotloc(iatom)%timeinv) THEN
C In this case, the operator is antiunitary [ inverse(R)=transpose(R) ]
rot_dmat(1:2*(2*l+1),1:2*(2*l+1))=CONJG(
= MATMUL(rot_dmat(1:2*(2*l+1),1:2*(2*l+1)),
& rotloc(iatom)%rotrep(l)
& %mat(1:2*(2*l+1),1:2*(2*l+1)) ))
rot_dmat(1:2*(2*l+1),1:2*(2*l+1))=
= MATMUL(TRANSPOSE( rotloc(iatom)%
& rotrep(l)%mat(1:2*(2*l+1),1:2*(2*l+1)) ),
& rot_dmat(1:2*(2*l+1),1:2*(2*l+1)) )
C Dmat_{local} = inverse(Rloc) Dmat_{global}* Rloc*
C Dmat_{local} = transpose(Rloc) Dmat_{global}* Rloc*
ELSE
C In this case, all the operators are unitary [ inverse(R)=transpose(conjugate(R)) ]
rot_dmat(1:2*(2*l+1),1:2*(2*l+1))=
= MATMUL(rot_dmat(1:2*(2*l+1),1:2*(2*l+1)),
& rotloc(iatom)%rotrep(l)
& %mat(1:2*(2*l+1),1:2*(2*l+1)) )
rot_dmat(1:2*(2*l+1),1:2*(2*l+1))=
= MATMUL(TRANSPOSE(CONJG( rotloc(iatom)%
& rotrep(l)%mat(1:2*(2*l+1),1:2*(2*l+1)) )),
& rot_dmat(1:2*(2*l+1),1:2*(2*l+1)) )
C Dmat_{local} = <x_local | x_global> Dmat_{global} <x_global | x_local>
C Dmat_{local} = inverse(Rloc) Dmat_{global} Rloc
ENDIF
C storing in dmat again
Dmat(1,iorb)%mat(-l:l,-l:l)=
& rot_dmat(1:(2*l+1),1:(2*l+1))
Dmat(2,iorb)%mat(-l:l,-l:l)=
& rot_dmat(2*l+2:2*(2*l+1),2*l+2:2*(2*l+1))
Dmat(3,iorb)%mat(-l:l,-l:l)=
& rot_dmat(1:(2*l+1),2*l+2:2*(2*l+1))
Dmat(4,iorb)%mat(-l:l,-l:l)=
& rot_dmat(2*l+2:2*(2*l+1),1:(2*l+1))
DEALLOCATE(rot_dmat)
ENDIF ! End of the if mixing if-then-else
ENDIF ! End of the if "l=0" if-then-else
ELSE
C ------------------------------------------------------------------------------
C The s-orbitals are a particular case of a "non-mixing" basis and is invariant.
C ------------------------------------------------------------------------------
IF(l==0) CYCLE
C ----------------------------------------------------------------------------------------------
C If the basis representation can be reduce to the up/up block (matrices of size (2*l+1) only) :
C ----------------------------------------------------------------------------------------------
ALLOCATE(rot_dmat(-l:l,-l:l))
DO is=1,nsp
rot_dmat=0.d0
C
C Application of the operation inverse(Rloc).Dmat.(Rloc) :
C -------------------------------------------------------
C In this case, (either a paramagnetic calculation or a spin-polarized one
C but the symmetry operation does not change the magntization direction)
C all the operators are unitary [ inverse(R)=transpose(conjugate(R)) ]
rot_dmat(-l:l,-l:l)=
= MATMUL(Dmat(is,iorb)%mat(-l:l,-l:l),
& rotloc(iatom)%rotrep(l)%mat(-l:l,-l:l) )
rot_dmat(-l:l,-l:l)=
= MATMUL(TRANSPOSE(CONJG( rotloc(iatom)%
& rotrep(l)%mat(-l:l,-l:l) )),
& rot_dmat(-l:l,-l:l) )
C rotmat_{local} = <x_local | x_global> rotmat_{global} <x_global | x_local>
C rotmat_{local} = inverse(Rloc) rotmat_{global} Rloc
C
C Storing the new value in Dmat :
C -------------------------------
Dmat(is,iorb)%mat(-l:l,-l:l)=rot_dmat(-l:l,-l:l)
ENDDO
DEALLOCATE(rot_dmat)
C
ENDIF ! End of the ifSO-ifSP if-then-else
ENDDO ! End of the iorb loop
C
RETURN
END

View File

@ -0,0 +1,72 @@
c ******************************************************************************
c
c TRIQS: a Toolbox for Research in Interacting Quantum Systems
c
c Copyright (C) 2011 by L. Pourovskii, V. Vildosola, C. Martins, M. Aichhorn
c
c TRIQS is free software: you can redistribute it and/or modify it under the
c terms of the GNU General Public License as published by the Free Software
c Foundation, either version 3 of the License, or (at your option) any later
c version.
c
c TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
c WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
c FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
c details.
c
c You should have received a copy of the GNU General Public License along with
c TRIQS. If not, see <http://www.gnu.org/licenses/>.
c
c *****************************************************************************/
SUBROUTINE rot_projectmat(mat,l,bottom,top,jatom,isrt)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine makes the transformation from local to global %%
C %% frame coordinates for the matrices mat in agreement with %%
C %% the atom j considered. %%
C %% %%
C %% mat SHOULD BE IN THE COMPLEX SPHERICAL HARMONICS BASIS. %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE almblm_data, ONLY : nk
USE common_data
USE symm
IMPLICIT NONE
INTEGER,INTENT(IN) :: l, bottom, top, jatom, isrt
COMPLEX(KIND=8), DIMENSION(-l:l,bottom:top) :: mat
COMPLEX(KIND=8), DIMENSION(-l:l,bottom:top) :: mattmp
COMPLEX(KIND=8), DIMENSION(1:2*l+1,1:2*l+1) :: rot_dmat
INTEGER :: is, ik, isym, lm, lms, ind1, ind2, m
C
DO m=-l,l
mattmp(m,bottom:top)= mat(m,bottom:top)
END DO
C mat is the projector in the local frame (spherical harmonic basis).
C
C The subroutine lapw2 has actually made the computation in the local frame
C BUT with considering the up and the dn elements in the global frame (no rotation in spin-space),
C That's why we have to make the computation only in the spin-space to put entirely the matrix mat in the global frame.
C Moreover, no time-reversal symmetry should be taken into account, since the true "rotloc" matrix is considered in lapw2 (-alm).
C
C The transformation is thus simply achieved by performing the multiplication by rotloc = <x_global | x_local >
C (use of the subroutine dmat)
rot_dmat=0.d0
CALL dmat(l,rotloc(jatom)%a,rotloc(jatom)%b,
& rotloc(jatom)%g,
& REAL(rotloc(jatom)%iprop,KIND=8),rot_dmat,2*l+1)
C Performing the rotation
mattmp(-l:l,bottom:top)=
= MATMUL(rot_dmat(1:2*l+1,1:2*l+1),
& mattmp(-l:l,bottom:top))
C The variable mattmp is then the projector in the global frame (spherical harmonic basis).
C The resulting matrix is stored in mat.
mat(-l:l,bottom:top)=mattmp(-l:l,bottom:top)
C
RETURN
END

View File

@ -0,0 +1,538 @@
c ******************************************************************************
c
c TRIQS: a Toolbox for Research in Interacting Quantum Systems
c
c Copyright (C) 2011 by L. Pourovskii, V. Vildosola, C. Martins, M. Aichhorn
c
c TRIQS is free software: you can redistribute it and/or modify it under the
c terms of the GNU General Public License as published by the Free Software
c Foundation, either version 3 of the License, or (at your option) any later
c version.
c
c TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
c WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
c FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
c details.
c
c You should have received a copy of the GNU General Public License along with
c TRIQS. If not, see <http://www.gnu.org/licenses/>.
c
c *****************************************************************************/
SUBROUTINE set_ang_trans
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine sets up the matrices for transformation between %%
C %% the default complex spherical harmonics used in Wien2k and an %%
C %% angular basis chosen, for each orbital of each atom. %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE common_data
USE file_names
USE reps
USE prnt
IMPLICIT NONE
CHARACTER(len=150) :: fullpath
CHARACTER(len=250) :: buf1
CHARACTER(len=25) :: basis_file
CHARACTER(len=1) :: repsign
INTEGER, DIMENSION(2*(2*lmax+1)) :: degrep
REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: rtrans,itrans
INTEGER :: m, l, m1, irep, isrt, ind, ind1, ind2
COMPLEX(KIND=8),DIMENSION(:,:), ALLOCATABLE :: tempmat
LOGICAL :: flag
C
C
WRITE(buf,'(a)')'======================================='
CALL printout(0)
WRITE(buf,'(a)')'Basis representation for each sort.'
CALL printout(0)
CALL printout(0)
C =================================
C Creation of the reptrans matrix :
C =================================
C
C For the s-electrons : no transformation is necessary (it's always the scalar 1)
ALLOCATE(reptrans(1:lmax,1:nsort))
C Definition of the size of reptrans (size lmax*nsort)
C Each element of this table is an "ang_bas" element, which will be defined below.
DO isrt=1,nsort
C -----------------------------------------------
C Case of a representation in the complex basis :
C -----------------------------------------------
IF (defbasis(isrt)%typebasis(1:7)=='complex') THEN
DO l=1,lmax
IF (lsort(l,isrt)==0) THEN
C The considered orbital is not included, all the fields are set up to default value.
reptrans(l,isrt)%nreps=1
ALLOCATE(reptrans(l,isrt)%dreps(1))
ALLOCATE(reptrans(l,isrt)%transmat(1,1))
reptrans(l,isrt)%transmat=0d0
reptrans(l,isrt)%dreps(1)=0
reptrans(l,isrt)%ifmixing=.FALSE.
ELSE
C The considered orbital is included.
reptrans(l,isrt)%nreps=1
ALLOCATE(reptrans(l,isrt)%dreps(1))
ALLOCATE(reptrans(l,isrt)%transmat(-l:l,-l:l))
reptrans(l,isrt)%transmat=0d0
reptrans(l,isrt)%dreps(1)=2*l+1
reptrans(l,isrt)%ifmixing=.FALSE.
DO m=-l,l
reptrans(l,isrt)%transmat(m,m)=1d0
ENDDO
C In this case, the transformation matrix is just the Identity (hence 1 irep).
C Spin up and Spin down states are not mixed in the basis representation.
ENDIF
ENDDO
C ---------------------------------------------
C Case of a representation in the cubic basis :
C ---------------------------------------------
ELSEIF (defbasis(isrt)%typebasis(1:5)=='cubic') THEN
DO l=1,lmax
IF (lsort(l,isrt)==0) THEN
C The considered orbital is not included, all the fields are set up to default value.
reptrans(l,isrt)%nreps=1
ALLOCATE(reptrans(l,isrt)%dreps(1))
ALLOCATE(reptrans(l,isrt)%transmat(1,1))
reptrans(l,isrt)%transmat=0d0
reptrans(l,isrt)%dreps(1)=0
reptrans(l,isrt)%ifmixing=.FALSE.
ELSE
C The considered orbital is included.
C The cubic basis is described in the format transpose(P) where P is the usual matrix
C of the eigenvectors of a matrix D ( D.P=Delta.P with Delta diagonal or P=<lm|new_i>).
C In other words, each line of the file describes the coefficient of the "new basis vector"
C in the basis { |l,-l,up>,...|l,l,up>,|l,-l,dn>,...|l,l,dn> }.
C The transformation matrices are stored in the directory SRC_templates, the variable "fullpath"
C must be updated if this prgm is copied.
ALLOCATE(reptrans(l,isrt)%transmat(-l:l,-l:l))
ALLOCATE(rtrans(-l:l))
ALLOCATE(itrans(-l:l))
C write(*,*)fullpath
IF (l==1) CALL
& set_harm_file(fullpath,'case.cf_p_cubic')
C standard cubic representation of p electrons : px,py,pz
IF (l==2) CALL
& set_harm_file(fullpath,'case.cf_d_eg_t2g')
C standard cubic representation of d-electrons : dz2, dx2-y2, dxy, dxz,dyz (Wien-convention for the phase)
IF (l==3) CALL
& set_harm_file(fullpath,'case.cf_f_mm2')
C mm2 representation of the f electrons (standard definition with complex coefficients)
C
C Reading of the file
OPEN(iumatfile,file=fullpath,status='old')
ind=-l
irep=0
DO m=-l,l
READ(iumatfile,'(a)')buf1
READ(buf1(1:1),'(a)')repsign
IF(repsign=='*') THEN
C Finding the different ireps in the new basis (a "*" means the end of an irep)
irep=irep+1
degrep(irep)=m-ind+1
ind=m+1
ENDIF
READ(buf1(2:250),*)(rtrans(m1),itrans(m1),m1=-l,l)
C The line of the file is stored in the column of reptrans, which is temporarly "P".
reptrans(l,isrt)%transmat(-l:l,m)=
& CMPLX(rtrans(-l:l),itrans(-l:l))
ENDDO
reptrans(l,isrt)%transmat(-l:l,-l:l)=
= TRANSPOSE(CONJG(reptrans(l,isrt)%transmat(-l:l,-l:l)))
C reptrans%transmat = inverse(P) = <new_i|lm>, the transformation matrix from complex basis to the cubic one.
C ( inverse(P) is the decomposition of the complex basis in the new basis...)
reptrans(l,isrt)%nreps=irep
ALLOCATE(reptrans(l,isrt)%dreps(irep))
reptrans(l,isrt)%dreps(1:irep)=degrep(1:irep)
reptrans(l,isrt)%ifmixing=.FALSE.
C reptrans%nreps = the total number of ireps in the cubic basis
C reptrans%dreps = table of the size of the different ireps
C reptrans%ifmixing = .FALSE. because Spin up and Spin down states are not mixed in the basis representation.
CLOSE(iumatfile)
DEALLOCATE(rtrans)
DEALLOCATE(itrans)
ENDIF
ENDDO
C ---------------------------------------------------------
C Case of a representation defined in an added input file :
C ---------------------------------------------------------
ELSEIF (defbasis(isrt)%typebasis(1:8)=='fromfile') THEN
basis_file=defbasis(isrt)%sourcefile
OPEN(iumatfile,file=basis_file,status='old')
DO l=1,lmax
IF (lsort(l,isrt)==0) THEN
C The considered orbital is not included, all the fields are set up to default value.
reptrans(l,isrt)%nreps=1
ALLOCATE(reptrans(l,isrt)%dreps(1))
ALLOCATE(reptrans(l,isrt)%transmat(1,1))
reptrans(l,isrt)%transmat=0d0
reptrans(l,isrt)%dreps(1)=0
ELSE
C The considered orbital is included.
C The new basis is described in the format transpose(P) where P is the usual matrix
C of the eigenvectors of a matrix D ( D.P=Delta.P with Delta diagonal or P=<lm|new_i>).
C In other words, each line of the file describes the coefficient of the "new basis vector"
C in the basis { |l,-l,up>,...|l,l,up>,|l,-l,dn>,...|l,l,dn> }.
C The transformation matrices are stored in the directory SRC_templates, the variable "fullpath"
C must be updated if this prgm is copied.
ind=1
irep=0
ALLOCATE(tempmat(1:2*(2*l+1),1:2*(2*l+1)))
ALLOCATE(rtrans(1:2*(2*l+1)))
ALLOCATE(itrans(1:2*(2*l+1)))
C
C Reading of the file
DO m=1,2*(2*l+1)
READ(iumatfile,'(a)')buf1
READ(buf1(1:1),'(a)')repsign
IF(repsign=='*') THEN
C Finding the different ireps in the new basis (a "*" means the end of an irep)
irep=irep+1
degrep(irep)=m-ind+1
ind=m+1
ENDIF
READ(buf1(2:250),*)(rtrans(m1),itrans(m1),
& m1=1,2*(2*l+1))
tempmat(1:2*(2*l+1),m)=
= CMPLX(rtrans(1:2*(2*l+1)),itrans(1:2*(2*l+1)))
C The lines of the read matrix are stored in the column of tempmat, which is then P.
ENDDO
C
C Determination if the basis mixes Spin up and Spin down states
flag=.TRUE.
ind1=1
ind2=1
C The "do while" loop stops when flag=FALSE or i=2*(l+1)
DO WHILE (flag.AND.(ind1.lt.2*(l+1)))
flag=flag.AND.
& (tempmat((2*l+1)+ind1,(2*l+1)+ind2)==tempmat(ind1,ind2))
flag=flag.AND.(tempmat((2*l+1)+ind1,ind2)==0.d0)
flag=flag.AND.(tempmat(ind1,(2*l+1)+ind2)==0.d0)
IF (ind2==(2*l+1)) THEN
ind1=ind1+1
ind2=1
ELSE
ind2=ind2+1
END IF
ENDDO
IF (flag) THEN
C If flag=TRUE (then i=2*l+2), the tempmat matrix is block diagonal in spin with
C the condition block up/up = block down/down.
C The Spin up and Spin down states are not mixed in the basis representation.
reptrans(l,isrt)%ifmixing=.FALSE.
C reptrans%ifmixing = .FALSE. because Spin up and Spin down states are not mixed in the basis representation.
C
C ---------------------------------------------------------------------------------------
C Interruption of the prgm if the basis description is not correct.
C -------------------------
C
IF (SUM(degrep(1:irep/2)).ne.(2*l+1)) THEN
WRITE(buf,'(a,a,i2,a,i2,a)')'The basis description ',
& 'for isrt = ',isrt,' and l = ',l,' is not recognized.'
CALL printout(0)
WRITE(buf,'(a,a)')'Check the structure of the file ',
& defbasis(isrt)%sourcefile
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
STOP
END IF
C ---------------------------------------------------------------------------------------
C
ALLOCATE(reptrans(l,isrt)%transmat(-l:l,-l:l))
reptrans(l,isrt)%transmat(-l:l,-l:l)=
= tempmat(1:(2*l+1),1:(2*l+1))
reptrans(l,isrt)%transmat(-l:l,-l:l)=
= TRANSPOSE(CONJG(reptrans(l,isrt)%transmat(-l:l,-l:l)))
C The up/up block is enough to describe the transformation (as for cubic or complex bases)
C reptrans%transmat = inverse(P) = <new_i|lm>
C inverse(P) is indeed the decomposition of the complex basis in the new basis.
reptrans(l,isrt)%nreps=irep/2
ALLOCATE(reptrans(l,isrt)%dreps(reptrans(l,isrt)%nreps))
reptrans(l,isrt)%dreps(1:reptrans(l,isrt)%nreps)=
= degrep(1:reptrans(l,isrt)%nreps)
C reptrans%nreps = the number of ireps in the desired basis for up spin
C reptrans%dreps = table of the size of the different ireps for up spin
ELSE
C If flag=FALSE, either the tempmat matrix either mixes Spin up and Spin down states
C or the representation basis for Spin up and Spin down states differ.
C In this case, it is not possible to reduce the description only to the up/up block.
C The whole tempmat matrix is necessary.
C
C ---------------------------------------------------------------------------------------
C Interruption of the prgm if the basis description is not correct.
C -------------------------
C
IF (SUM(degrep(1:irep)).ne.(2*(2*l+1))) THEN
WRITE(buf,'(a,a,i2,a,i2,a)')'The basis description ',
& 'for isrt = ',isrt,' and l = ',l,' is not recognized.'
CALL printout(0)
WRITE(buf,'(a,a)')'Check the structure of the file ',
& defbasis(isrt)%sourcefile
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
STOP
END IF
C ---------------------------------------------------------------------------------------
C
reptrans(l,isrt)%ifmixing=.TRUE.
C reptrans%ifmixing = .TRUE. because Spin up and Spin down states are mixed in the basis representation.
ALLOCATE(reptrans(l,isrt)%transmat
& (1:2*(2*l+1),1:2*(2*l+1)))
reptrans(l,isrt)%transmat(1:2*(2*l+1),1:2*(2*l+1))=
= tempmat(1:2*(2*l+1),1:2*(2*l+1))
reptrans(l,isrt)%transmat(1:2*(2*l+1),1:2*(2*l+1))=
= TRANSPOSE(CONJG(reptrans(l,isrt)%transmat
& (1:2*(2*l+1),1:2*(2*l+1))))
C In this case, reptrans%transmat is a square matrix which ranges from 1 to 2*(2*l+1).
C reptrans%transmat = inverse(P) = <new_i|lm>
C inverse(P) is indeed the decomposition of the complex basis in the new basis.
reptrans(l,isrt)%nreps=irep
ALLOCATE(reptrans(l,isrt)%dreps(irep))
reptrans(l,isrt)%dreps(1:irep)=degrep(1:irep)
C reptrans%nreps = the total number of ireps in the desired basis
C reptrans%dreps = table of the size of the different ireps
C
C Restriction for simplicity in the following (and for physical reasons) :
C a basis with ifmixing=.TRUE. is allowed only if the computation includes SO.
IF (.not.ifSO) THEN
WRITE(buf,'(a,a,i2,a,i2,a)')'The basis description ',
& 'for isrt = ',isrt,' and l = ',l,
& ' mixes up and down states.'
CALL printout(0)
WRITE(buf,'(a,a)')'This option can not ',
& 'be used in a computation without Spin-Orbit.'
CALL printout(0)
WRITE(buf,'(a,a)')'Modify the structure of the file ',
& defbasis(isrt)%sourcefile
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
STOP
END IF
END IF
DEALLOCATE(tempmat)
DEALLOCATE(rtrans)
DEALLOCATE(itrans)
ENDIF
ENDDO
CLOSE(iumatfile)
C ----------------------------------------------
C Case of a wrong definition in the input file :
C ----------------------------------------------
ELSE
C
C ---------------------------------------------------------------------------------------
C Interruption of the prgm if the file has not the expected structure.
C -------------------------
C
WRITE(buf,'(a,i2,a)')'The basis description for isrt = ',
& isrt,' is not recognized.'
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
STOP
ENDIF
C ---------------------------------------------------------------------------------------
C
ENDDO
C
C
C ===============================================
C Printing the basis representation information :
C ===============================================
C
DO isrt=1,nsort
IF (notinclude(isrt)) cycle
CALL printout(0)
WRITE(buf,'(a)')'-------------------------------------'
CALL printout(0)
WRITE(buf,'(a,i2,a)')'For the sort ',isrt,' :'
CALL printout(0)
IF (defbasis(isrt)%typebasis(1:7)=='complex') THEN
C -----------------------------------------------
C Case of a representation in the complex basis :
C -----------------------------------------------
WRITE(buf,'(a,i2,a)')'The atomic sort', isrt,
& ' is studied in the complex basis representation.'
CALL printout(0)
CALL printout(0)
ELSEIF (defbasis(isrt)%typebasis(1:5)=='cubic') THEN
C ---------------------------------------------
C Case of a representation in the cubic basis :
C ---------------------------------------------
WRITE(buf,'(a,i2,a)')'The atomic sort', isrt,
& ' is studied in the cubic basis representation.'
CALL printout(0)
CALL printout(0)
DO l=0,lmax
C The considered orbital is not included.
IF (lsort(l,isrt)==0) cycle
C Case of the s-electrons
IF (l==0) THEN
WRITE(buf,'(a,a,(F12.6))')'The basis for s-orbital ',
& 'is still',1.d0
CALL printout(0)
ELSE
C Case of the other orbitals
WRITE(buf,'(a,i2,a,a,a)')'The basis for orbital l=',l,
& ' has the following properties :'
CALL printout(0)
WRITE(buf,'(a,i2)')' - number of ireps : ',
& reptrans(l,isrt)%nreps
CALL printout(0)
WRITE(buf,'(a,14(i2,x))')' - degree of each ireps : ',
& reptrans(l,isrt)%dreps(1:reptrans(l,isrt)%nreps)
CALL printout(0)
WRITE(buf,'(a,a,a)')'The transformation matrix is block',
& ' diagonal in the spin-space. The up/up and down/down',
& ' blocks are the same and defined as :'
CALL printout(0)
C The transformation matrix "P = <lm|new_i>" is displayed.
DO m=-l,l
WRITE(buf,'(7(2F12.6),x)')
& CONJG(reptrans(l,isrt)%transmat(-l:l,m))
CALL printout(0)
ENDDO
CALL printout(0)
ENDIF
ENDDO
CALL printout(0)
ELSE
C ---------------------------------------------------------
C Case of a representation defined in an added input file :
C ---------------------------------------------------------
WRITE(buf,'(a,i2,a,a,a)')'The atomic sort', isrt,
& ' is studied in the basis representation',
& ' defined in the file ',
& defbasis(isrt)%sourcefile
CALL printout(0)
CALL printout(0)
DO l=0,lmax
C The considered orbital is not included.
IF (lsort(l,isrt)==0) cycle
C Case of the s-electrons
IF (l==0) THEN
WRITE(buf,'(a,a,(F12.6))')'The basis for s-orbital ',
& 'is still',1.d0
CALL printout(0)
CALL printout(0)
ELSE
C Case of the other orbitals
WRITE(buf,'(a,i2,a)')'The basis for orbital l=',l,
& ' has the following properties :'
CALL printout(0)
WRITE(buf,'(a,i2)')' - number of ireps : ',
& reptrans(l,isrt)%nreps
CALL printout(0)
WRITE(buf,'(a,14(i2,x))')' - degree of each ireps : ',
& reptrans(l,isrt)%dreps(1:reptrans(l,isrt)%nreps)
CALL printout(0)
IF (reptrans(l,isrt)%ifmixing) THEN
C If the whole matrix description is necessary.
WRITE(buf,'(a,a)')'The transformation matrix mixes',
& ' up and down states in the spin-space'
CALL printout(0)
WRITE(buf,'(a,a)') ' and is defined as : ',
& '[ block 1 | block 2 ] with'
CALL printout(0)
WRITE(buf,'(a,a)') ' ',
& '[ block 3 | block 4 ]'
CALL printout(0)
C The transformation matrix "P = <lm|new_i>" is displayed.
WRITE(buf,'(a,i2,a)') 'For the block 1 :'
CALL printout(0)
DO m=1,2*l+1
WRITE(buf,'(7(2F12.6),x)')
& CONJG(reptrans(l,isrt)%transmat(1:(2*l+1),m))
CALL printout(0)
ENDDO
WRITE(buf,'(a,i2,a)') 'For the block 2 :'
CALL printout(0)
DO m=1,2*l+1
WRITE(buf,'(7(2F12.6),x)')
& CONJG(reptrans(l,isrt)%transmat(2*l+2:2*(2*l+1),m))
CALL printout(0)
ENDDO
WRITE(buf,'(a,i2,a)') 'For the block 3 :'
CALL printout(0)
DO m=2*l+2,2*(2*l+1)
WRITE(buf,'(7(2F12.6),x)')
& CONJG(reptrans(l,isrt)%transmat(1:(2*l+1),m))
CALL printout(0)
ENDDO
WRITE(buf,'(a,i2,a)') 'For the block 4 :'
CALL printout(0)
DO m=2*l+2,2*(2*l+1)
WRITE(buf,'(7(2F12.6),x)')
& CONJG(reptrans(l,isrt)%
& transmat(2*l+2:2*(2*l+1),m))
CALL printout(0)
ENDDO
ELSE
C If the matrix description can be reduced to its up/up block.
WRITE(buf,'(a,a,a)')'The transformation matrix is block',
& ' diagonal in the spin-space. The up/up and down/down',
& ' blocks are the same and defined as :'
CALL printout(0)
C The transformation matrix "P = <lm|new_i>" is displayed.
DO m=-l,l
WRITE(buf,'(7(2F12.6),x)')
& CONJG(reptrans(l,isrt)%transmat(-l:l,m))
CALL printout(0)
ENDDO
ENDIF ! End of the ifmixing if-then-else
CALL printout(0)
ENDIF ! End of the l if-then-else
ENDDO ! End of the l loop
CALL printout(0)
ENDIF ! End of the basis description if-then-else
ENDDO ! End of the isrt loop
C
RETURN
END
SUBROUTINE set_harm_file(fullpath,filename)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine sets the fullpath variable %%
C %% Be careful, wien_path is defined in modules.f !!! %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE common_data, ONLY : wien_path
USE prnt
IMPLICIT NONE
CHARACTER(len=*) :: filename, fullpath
CHARACTER(len=*), PARAMETER :: dir='SRC_templates'
INTEGER :: i1, i2, i, i3
C
i1=LEN_TRIM(wien_path)
i2=LEN(dir)
i3=LEN(filename)
i=i1+i2+i3+2
IF(LEN(fullpath) < i) THEN
WRITE(buf,'(a)')
& 'Characters required for the basis transformation ',
& ' filename is too long.'
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
STOP
STOP
ENDIF
fullpath=' '
fullpath(1:i)=wien_path(1:i1)//'/'//dir//'/'//filename(1:i3)
END SUBROUTINE set_harm_file

View File

@ -0,0 +1,724 @@
c ******************************************************************************
c
c TRIQS: a Toolbox for Research in Interacting Quantum Systems
c
c Copyright (C) 2011 by L. Pourovskii, V. Vildosola, C. Martins, M. Aichhorn
c
c TRIQS is free software: you can redistribute it and/or modify it under the
c terms of the GNU General Public License as published by the Free Software
c Foundation, either version 3 of the License, or (at your option) any later
c version.
c
c TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
c WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
c FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
c details.
c
c You should have received a copy of the GNU General Public License along with
c TRIQS. If not, see <http://www.gnu.org/licenses/>.
c
c *****************************************************************************/
SUBROUTINE set_projections(e1,e2)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine sets up the projection matrices in the energy %%
C %% window [e1,e2].Two types of projection can be defined : %%
C %% - The projectors <u_orb|ik,ib,is> for the correlated orbital %%
C %% only. (orb = iatom,is,m) %%
C %% (They are stored in the table pr_crorb) %%
C %% - The Theta projectors <theta_orb|k,ib> for all the orbitals %%
C %% (They are stored in the table pr_orb) %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
C
USE almblm_data
USE common_data
USE prnt
USE projections
USE reps
USE symm
IMPLICIT NONE
C
REAL(KIND=8) :: e1, e2
INTEGER :: iorb, icrorb, ik, is, ib, m, l, lm, nbbot, nbtop
INTEGER :: isrt, n, ilo, iatom, i, imu, jatom, jorb,isym, jcrorb
LOGICAL :: included,param
COMPLEX(KIND=8), DIMENSION(:), ALLOCATABLE :: coeff
COMPLEX(KIND=8), DIMENSION(:,:), ALLOCATABLE :: tmp_mat
COMPLEX(KIND=8), DIMENSION(:,:), ALLOCATABLE :: tmp_matbis
COMPLEX(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: tmp_matn
C
C
C
WRITE(buf,'(a)')'Creation of the projectors...'
CALL printout(0)
C
C
C ======================================================================
C Selection of the bands which lie in the chosen energy window [e1;e2] :
C ======================================================================
C
kp(:,:)%included=.FALSE.
C the field kp%included = boolean which is .TRUE. when there is at least one band
C at this k-point whose energy eignevalue is in the energy window.
DO is=1,ns
DO ik=1,nk
included=.FALSE.
DO ib=kp(ik,is)%nbmin,kp(ik,is)%nbmax
IF(.NOT.included.AND.kp(ik,is)%eband(ib) > e1.AND.
& kp(ik,is)%eband(ib).LE.e2) THEN
C If the energy eigenvalue E of the band ib at the k-point ik is such that e1 < E =< e2,
C then all the band with ib1>ib must be "included" in the computation and kp%nb_bot is initialized at the value ib.
included=.TRUE.
kp(ik,is)%nb_bot=ib
ELSEIF(included.AND.kp(ik,is)%eband(ib) > e2) THEN
C If the energy eigenvalue E of the current band ib at the k-point ik is such that E > e2 and all the previous
C band are "included", then the field kp%included = .TRUE. and kp%nb_top = ib-1 (the index of the previous band)
kp(ik,is)%nb_top=ib-1
kp(ik,is)%included=.TRUE.
EXIT
C The loop on the band ib is stopped, since all the bands after ib have an energy > that of ib.
ELSEIF(ib==kp(ik,is)%nbmax.AND.kp(ik,is)%eband(ib)
& > e1.AND.kp(ik,is)%eband(ib).LE.e2) THEN
C If the energy eigenvalue E of the last band ib=kp%nbmax at the k-point ik is such that e1 < E =< e2 and all the
C previous bands are "included", then the band ib must be "included" and kp%nb_bot is initialized at the value kp%nbmax.
kp(ik,is)%nb_top=ib
kp(ik,is)%included=.TRUE.
ENDIF
C If the eigenvalues of the bands at the k-point ik are < e1 and included=.FALSE.
C of if the eigenvalues of the bands at the k-point ik are in the energy window [e1,e2] and included=.TRUE.,
C nothing is done...
ENDDO ! End of the ib loop
C If all the eigenvalues of the bands at the k-point ik are not in the window,
C then kp%included remains at the value .FALSE. and the field kp%nb_top and kp%nb_bot are set to 0.
IF (.not.kp(ik,is)%included) THEN
kp(ik,is)%nb_bot=0
kp(ik,is)%nb_top=0
ENDIF
ENDDO ! End of the ik loop
ENDDO ! End of the is loop
C ---------------------------------------------------------------------------------------
C Checking of the input files if spin-polarized inputs and SO is taken into account:
C There should not be any difference between up and dn limits for each k-point.
C Printing a Warning if this is not the case.
C -------------------
C
IF (ifSP.AND.ifSO) THEN
param=.TRUE.
DO ik=1,nk
param=param.AND.(kp(ik,1)%included.eqv.kp(ik,2)%included)
param=param.AND.(kp(ik,1)%nb_bot==kp(ik,2)%nb_bot)
param=param.AND.(kp(ik,1)%nb_top==kp(ik,2)%nb_top)
IF (.not.param) EXIT
C For a valid compoutation, the same k-points must be included for up and dn states,
C and the upper and lower limits must be the same in both case.
ENDDO
IF (.not.param) THEN
WRITE(buf,'(a,a)')'A Spin-orbit computation for this',
& ' compound is not possible with these input files.'
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
STOP
ENDIF
ENDIF
C ---------------------------------------------------------------------------------------
C
C
C ==================================================================
C Orthonormalization of the radial wave functions for each orbital :
C ==================================================================
C
C This step is essential for setting the Theta projectors.
IF(.NOT.ALLOCATED(norm_radf)) THEN
ALLOCATE(norm_radf(norb))
C norm_radf is a table of "ortfunc" elements, its size ranges from 1 to norb.
DO iorb=1,norb
l=orb(iorb)%l
isrt=orb(iorb)%sort
norm_radf(iorb)%n=nLO(l,isrt)+2
n=norm_radf(iorb)%n
ALLOCATE(norm_radf(iorb)%s12(n,n,ns))
C norm_radf%n = size of the matrix s12
C norm_radf%s12 = matrix of size n*n (one for spin up, one for spin down, if necessary)
DO is=1,ns
norm_radf(iorb)%s12(1:n,1:n,is)=0d0
norm_radf(iorb)%s12(1,1,is)=1d0
norm_radf(iorb)%s12(2,2,is)=u_dot_norm(l,isrt,is)
C Initialization of the matrix norm_radf%s12 for each orbital (l,isrt).
C We remind tha it is assumed that nLO has the value 0 or 1 only !!
DO ilo=1,nLO(l,isrt)
norm_radf(iorb)%s12(2+ilo,2+ilo,is)=1d0
norm_radf(iorb)%s12(2+ilo,1,is)=
= ovl_LO_u(ilo,l,isrt,is)
norm_radf(iorb)%s12(1,2+ilo,is)=
= ovl_LO_u(ilo,l,isrt,is)
norm_radf(iorb)%s12(2+ilo,2,is)=
= ovl_LO_udot(ilo,l,isrt,is)
norm_radf(iorb)%s12(2,2+ilo,is)=
= ovl_LO_udot(ilo,l,isrt,is)
ENDDO
C Computation of the square root of norm_radf:
CALL orthogonal_r(norm_radf(iorb)%
& s12(1:n,1:n,is),n,.FALSE.)
C the field norm_radf%s12 is finally the C matrix described in the tutorial (or in equation (3.63) in my thesis)
ENDDO
ENDDO
ENDIF
C
C =====================================
C Creation of the projection matrices :
C =====================================
C
IF(.NOT.ALLOCATED(pr_orb)) THEN
ALLOCATE(pr_crorb(ncrorb,nk,ns))
ALLOCATE(pr_orb(norb,nk,ns))
ENDIF
C pr_crorb = table of "proj_mat" elements for the correlated orbitals (size from 1 to ncrorb, from 1 to nk, from 1 to ns)
C pr_orb = table of "proj_mat_n" elements for all the orbitals (size from 1 to norb, from 1 to nk, from 1 to ns)
DO is=1,ns
DO ik=1,nk
C Only the k-points with inlcuded bands are considered for the projectors.
IF(.NOT.kp(ik,is)%included) CYCLE
C ------------------------------------------------
C Wannier Projectors for the correlated orbitals :
C ------------------------------------------------
DO icrorb=1,ncrorb
l=crorb(icrorb)%l
iatom=crorb(icrorb)%atom
isrt=crorb(icrorb)%sort
C Case of l=0 :
C -------------
IF (l==0) THEN
IF(ALLOCATED(pr_crorb(icrorb,ik,is)%mat)) THEN
DEALLOCATE(pr_crorb(icrorb,ik,is)%mat)
ENDIF
ALLOCATE(pr_crorb(icrorb,ik,is)%
% mat(1,kp(ik,is)%nb_bot:kp(ik,is)%nb_top))
C pr_crorb%mat = the projection matrix with 1 line and (nb_top-nb_bot) columns
DO ib=kp(ik,is)%nb_bot,kp(ik,is)%nb_top
pr_crorb(icrorb,ik,is)%mat(1,ib)=
= kp(ik,is)%Alm(1,iatom,ib)
DO ilo=1,nLO(l,isrt)
pr_crorb(icrorb,ik,is)%mat(1,ib)=
= pr_crorb(icrorb,ik,is)%mat(1,ib)+
+ kp(ik,is)%Clm(ilo,1,iatom,ib)*
* ovl_LO_u(ilo,l,isrt,is)
ENDDO ! End of the ilo loop
ENDDO ! End of the ib loop
C prcrorb(icrorb,ik,is)%mat(1,ib)= <ul1(icrorb,1,is)|psi(is,ik,ib)> = Alm+Clm*ovl_LO_u
C
C Case of any other l :
C ---------------------
ELSE
lm=l*l
C Since the correlated orbital is the l orbital, the elements range from l*l+1 to (l+1)^2
C the sum from 0 to (l-1) of m (from -l to l) is l^2.
IF(ALLOCATED(pr_crorb(icrorb,ik,is)%mat)) THEN
DEALLOCATE(pr_crorb(icrorb,ik,is)%mat)
ENDIF
ALLOCATE(pr_crorb(icrorb,ik,is)%
% mat(-l:l,kp(ik,is)%nb_bot:kp(ik,is)%nb_top))
C pr_crorb%mat = the projection matrix with (2*l+1) lines and (nb_top-nb_bot) columns
DO m=-l,l
lm=lm+1
DO ib=kp(ik,is)%nb_bot,kp(ik,is)%nb_top
pr_crorb(icrorb,ik,is)%mat(m,ib)=
= kp(ik,is)%Alm(lm,iatom,ib)
DO ilo=1,nLO(l,isrt)
pr_crorb(icrorb,ik,is)%mat(m,ib)=
= pr_crorb(icrorb,ik,is)%mat(m,ib)+
+ kp(ik,is)%Clm(ilo,lm,iatom,ib)*
* ovl_LO_u(ilo,l,isrt,is)
ENDDO ! End of the ilo loop
ENDDO ! End of the ib loop
ENDDO ! End of the m loop
C prcrorb(icrorb,ik,is)%mat(m,ib)= <ul1(icrorb,m,is)|psi(is,ik,ib)> = Alm+Clm*ovl_LO_u
ENDIF ! End of the if l=0 if-then-else
ENDDO ! End of the icrorb loop
C
C ---------------------------------------
C Theta Projectors for all the orbitals :
C ---------------------------------------
DO iorb=1,norb
l=orb(iorb)%l
n=norm_radf(iorb)%n
iatom=orb(iorb)%atom
C Case of l=0 :
C -------------
IF (l==0) THEN
IF(ALLOCATED(pr_orb(iorb,ik,is)%matn)) THEN
DEALLOCATE(pr_orb(iorb,ik,is)%matn)
ENDIF
ALLOCATE(pr_orb(iorb,ik,is)%
% matn(1,kp(ik,is)%nb_bot:kp(ik,is)%nb_top,n))
ALLOCATE(coeff(1:n))
C pr_orb%matn = the projection matrix with 1 line and (nb_top-nb_bot) columns for the n (size of s12) coefficients
C coeff = table of size n which will contain the decomposition of the Bloch state |psi_ik,ib,is>
C as in equation 22 of the tutorial (Alm, Blm, and Clm )
DO ib=kp(ik,is)%nb_bot,kp(ik,is)%nb_top
coeff(1)=kp(ik,is)%Alm(1,iatom,ib)
coeff(2)=kp(ik,is)%Blm(1,iatom,ib)
coeff(3:n)=kp(ik,is)%Clm(1:n-2,1,iatom,ib)
coeff=MATMUL(coeff,norm_radf(iorb)%s12(1:n,1:n,is))
C coeff = coefficients c_(j,lm) of the decomposition of the state |psi> in the orthogonalized basis |phi_j>
C as defined in the tutorial (equation 25)
pr_orb(iorb,ik,is)%matn(1,ib,1:n)=coeff(1:n)
ENDDO
DEALLOCATE(coeff)
C pr_orb(iorb,ik,is)%matn(m,ib,1:n) is then the Theta projector as defined in equation 26 of the tutorial.
C
C Case of any other l :
C ---------------------
ELSE
lm=l*l
C As the orbital is the l orbital, the elements range from l*l+1 to (l+1)^2
C the sum from 0 to (l-1) of m (from -l to l) is l^2.
IF(ALLOCATED(pr_orb(iorb,ik,is)%matn)) THEN
DEALLOCATE(pr_orb(iorb,ik,is)%matn)
ENDIF
ALLOCATE(pr_orb(iorb,ik,is)%
% matn(-l:l,kp(ik,is)%nb_bot:kp(ik,is)%nb_top,n))
ALLOCATE(coeff(1:n))
C pr_orb%matn = the projection matrix with (2*l+1) lines and (nb_top-nb_bot) columns for the n (size of s12) coefficients
C coeff = table of size n which will contain the decomposition of the Bloch state |psi_ik,ib,is>
C as in equation 22 of the tutorial (Alm, Blm, and Clm )
DO m=-l,l
lm=lm+1
DO ib=kp(ik,is)%nb_bot,kp(ik,is)%nb_top
coeff(1)=kp(ik,is)%Alm(lm,iatom,ib)
coeff(2)=kp(ik,is)%Blm(lm,iatom,ib)
coeff(3:n)=kp(ik,is)%Clm(1:n-2,lm,iatom,ib)
coeff=MATMUL(coeff,
& norm_radf(iorb)%s12(1:n,1:n,is))
C coeff = coefficients c_(j,lm) of the decomposition of the state |psi> in the orthogonalized basis |phi_j>
C as defined in the tutorial (equation 25)
pr_orb(iorb,ik,is)%matn(m,ib,1:n)=coeff(1:n)
ENDDO
ENDDO ! End of the m loop
DEALLOCATE(coeff)
C pr_orb(iorb,ik,is)%matn(m,ib,1:n) is then the Theta projector as defined in equation 26 of the tutorial.
ENDIF ! End of the if l=0 if-then-else
ENDDO ! End of the iorb loop
C
ENDDO ! End of the loop on ik
ENDDO ! End of the loop on is
C
C
C ==========================================================================
C Multiplication of the projection matrices by the local rotation matrices :
C ==========================================================================
C
C ------------------------------------------------
C Wannier Projectors for the correlated orbitals :
C ------------------------------------------------
C
DO jcrorb=1,ncrorb
jatom=crorb(jcrorb)%atom
isrt=crorb(jcrorb)%sort
l=crorb(jcrorb)%l
C
C The case l=0 is a particular case of "non-mixing" basis.
C --------------------------------------------------------
IF (l==0) THEN
C For the s orbital, no multiplication is needed, since the matrix representation of any rotation
C (and thus Rloc) is always 1.
DO ik=1,nk
DO is=1,ns
C Only the k-points with inlcuded bands are considered for the projectors.
IF(.NOT.kp(ik,is)%included) CYCLE
nbtop=kp(ik,is)%nb_top
nbbot=kp(ik,is)%nb_bot
IF(ALLOCATED(pr_crorb(jcrorb,ik,is)%mat_rep)) THEN
DEALLOCATE(pr_crorb(jcrorb,ik,is)%mat_rep)
ENDIF
ALLOCATE(pr_crorb(jcrorb,ik,is)
& %mat_rep(1,nbbot:nbtop))
pr_crorb(jcrorb,ik,is)%mat_rep(1,nbbot:nbtop)=
= pr_crorb(jcrorb,ik,is)%mat(1,nbbot:nbtop)
C As a result, prcrorb%matrep = prcrorb%mat
ENDDO
ENDDO
C
C If the basis representation needs a complete spinor rotation approach (matrices of size 2*(2*l+1) )
C ---------------------------------------------------------------------------------------------------
ELSEIF (reptrans(l,isrt)%ifmixing) THEN
C If this option is used, then ifSO=.TRUE. (because of the restriction in set_ang_trans.f)
C Moreover ifSP=.TRUE. (since ifSO => ifSP in this version)
C As a result, we know that nb_bot(up)=nb_bot(dn) and nb_top(up)=nb_top(dn)
DO ik=1,nk
C Only the k-points with inlcuded bands are considered for the projectors.
IF(.NOT.kp(ik,1)%included) CYCLE
nbbot=kp(ik,1)%nb_bot
nbtop=kp(ik,1)%nb_top
C In this case, the projection matrix will be stored in prcrorb%matrep with is=1.
IF(ALLOCATED(pr_crorb(jcrorb,ik,1)%mat_rep)) THEN
DEALLOCATE(pr_crorb(jcrorb,ik,1)%mat_rep)
ENDIF
ALLOCATE(pr_crorb(jcrorb,ik,1)%
% mat_rep(1:2*(2*l+1),nbbot:nbtop))
C The element prcrorb%matrep for is=2 is set to 0, since all the matrix will be stored in the matrix matrep for is=1
IF(.not.ALLOCATED(pr_crorb(jcrorb,ik,2)%mat_rep)) THEN
ALLOCATE(pr_crorb(jcrorb,ik,2)%mat_rep(1,1))
pr_crorb(jcrorb,ik,2)%mat_rep(1,1)=0.d0
ENDIF
C Creation of a matrix tmp_mat which "concatenates" up and dn parts of pr_crorb.
ALLOCATE(tmp_mat(1:2*(2*l+1),nbbot:nbtop))
tmp_mat(1:(2*l+1),nbbot:nbtop)=
= pr_crorb(jcrorb,ik,1)%mat(-l:l,nbbot:nbtop)
C The first (2l+1) lines are the spin-up part of the projection matrix prcrorb%mat.
C
C ---------------------------------------------------------------------------------------
C Interruption of the prgm if there is no dn part of pr_orb.
C -------------------------
C
IF(.not.ifSP) THEN
WRITE(buf,'(a,a,i2,a)')'The projectors on ',
& 'the dn states are required for isrt = ',isrt,
& ' but there is no spin-polarized input files.'
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
STOP
ENDIF
C ---------------------------------------------------------------------------------------
C
C The last (2l+1) lines are the spin-dn part of the projection matrix prcrorb%mat.
tmp_mat((2*l+2):2*(2*l+1),nbbot:nbtop)=
= pr_crorb(jcrorb,ik,2)%mat(-l:l,nbbot:nbtop)
C
C Multiplication by the local rotation matrix ; Up and dn parts are treated independently
C since in lapw2 (-alm) the coefficients Alm, Blm and Clm were calculated in the local frame
C but without taking into account the spinor-rotation matrix.
ALLOCATE(tmp_matbis(1:(2*l+1),nbbot:nbtop))
tmp_matbis(1:(2*l+1),nbbot:nbtop)=
= tmp_mat(1:(2*l+1),nbbot:nbtop)
CALL rot_projectmat(tmp_matbis,
& l,nbbot,nbtop,jatom,isrt)
tmp_mat(1:(2*l+1),nbbot:nbtop)=
= tmp_matbis(1:(2*l+1),nbbot:nbtop)
tmp_matbis(1:(2*l+1),nbbot:nbtop)=
= tmp_mat(2*l+2:2*(2*l+1),nbbot:nbtop)
CALL rot_projectmat(tmp_matbis,
& l,nbbot,nbtop,jatom,isrt)
tmp_mat(2*l+2:2*(2*l+1),nbbot:nbtop)=
= tmp_matbis(1:(2*l+1),nbbot:nbtop)
DEALLOCATE(tmp_matbis)
C
C Putting pr_crorb in the desired basis associated to (l,isrt)
C
pr_crorb(jcrorb,ik,1)%mat_rep(1:2*(2*l+1),nbbot:nbtop)=
= MATMUL(reptrans(l,isrt)%transmat
& (1:2*(2*l+1),1:2*(2*l+1)),
& tmp_mat(1:2*(2*l+1),nbbot:nbtop))
C pr_crorb%mat_rep = proj_{new_i} = reptrans*proj_{lm} = <new_i|lm>*proj_{lm}
DEALLOCATE(tmp_mat)
ENDDO ! End of the ik loop
C
C If the basis representation can be reduce to the up/up block (matrices of size (2*l+1) only)
C --------------------------------------------------------------------------------------------
ELSE
DO ik=1,nk
DO is=1,ns
C Only the k-points with inlcuded bands are considered for the projectors.
IF(.NOT.kp(ik,is)%included) CYCLE
C In this case, nb_top(up) and nb_bot(up) can differ from nb_top(dn) and nb_bot(dn)
nbbot=kp(ik,is)%nb_bot
nbtop=kp(ik,is)%nb_top
IF(ALLOCATED(pr_crorb(jcrorb,ik,is)%mat_rep)) THEN
DEALLOCATE(pr_crorb(jcrorb,ik,is)%mat_rep)
ENDIF
ALLOCATE(pr_crorb(jcrorb,ik,is)
& %mat_rep(-l:l,nbbot:nbtop))
pr_crorb(jcrorb,ik,is)%mat_rep(-l:l,nbbot:nbtop)=
= pr_crorb(jcrorb,ik,is)%mat(-l:l,nbbot:nbtop)
C
C Multiplication by the local rotation matrix
C since in lapw2 (-alm) the coefficients Alm, Blm and Clm were calculated in the local frame
CALL rot_projectmat(pr_crorb(jcrorb,ik,is)
& %mat_rep(-l:l,nbbot:nbtop),l,nbbot,nbtop,jatom,isrt)
C
C Putting pr_crorb in the desired basis associated to (l,isrt)
pr_crorb(jcrorb,ik,is)%mat_rep(-l:l,nbbot:nbtop)=
= MATMUL(reptrans(l,isrt)%transmat(-l:l,-l:l),
& pr_crorb(jcrorb,ik,is)%mat_rep(-l:l,nbbot:nbtop))
C pr_crorb%mat_rep = proj_{new_i} = reptrans*proj_{lm} = <new_i|lm>*proj_{lm}
ENDDO ! End of the is loop
ENDDO ! End of the ik loop
ENDIF ! End of the if mixing if-then-else
ENDDO ! End of the jcrorb loop
C
C ---------------------------------------
C Theta Projectors for all the orbitals :
C ---------------------------------------
C
DO jorb=1,norb
jatom=orb(jorb)%atom
isrt=orb(jorb)%sort
n=norm_radf(jorb)%n
l=orb(jorb)%l
C
C The case l=0 is a particular case of "non-mixing" basis.
C --------------------------------------------------------
IF (l==0) THEN
C For the s orbital, no multiplication is needed, since the matrix representation of any rotation
C (and therefore Rloc) is always 1.
DO ik=1,nk
DO is=1,ns
C Only the k-points with inlcuded bands are considered for the projectors.
IF(.NOT.kp(ik,is)%included) CYCLE
nbtop=kp(ik,is)%nb_top
nbbot=kp(ik,is)%nb_bot
IF(ALLOCATED(pr_orb(jorb,ik,is)%matn_rep)) THEN
DEALLOCATE(pr_orb(jorb,ik,is)%matn_rep)
ENDIF
ALLOCATE(pr_orb(jorb,ik,is)%matn_rep
& (1,nbbot:nbtop,1:n))
pr_orb(jorb,ik,is)%matn_rep(1,nbbot:nbtop,1:n)=
= pr_orb(jorb,ik,is)%matn(1,nbbot:nbtop,1:n)
C As a result, prorb%matnrep = prorb%matn
ENDDO
ENDDO
C
C If the basis representation needs a complete spinor rotation approach (matrices of size 2*(2*l+1) )
C ---------------------------------------------------------------------------------------------------
ELSEIF (reptrans(l,isrt)%ifmixing) THEN
C If this option is used, then ifSO=.TRUE. (restriction in set_ang_trans.f)
C Moreover ifSP=.TRUE. (since ifSO => ifSP)
C As a result, we know that nb_bot(up)=nb_bot(dn) and nb_top(up)=nb_top(dn)
DO ik=1,nk
C Only the k-points with inlcuded bands are considered for the projectors.
IF(.NOT.kp(ik,1)%included) CYCLE
nbbot=kp(ik,1)%nb_bot
nbtop=kp(ik,1)%nb_top
C In this case, the projection matrix will be stored in prorb%matnrep with is=1.
IF(ALLOCATED(pr_orb(jorb,ik,1)%matn_rep)) THEN
DEALLOCATE(pr_orb(jorb,ik,1)%matn_rep)
ENDIF
ALLOCATE(pr_orb(jorb,ik,1)%
% matn_rep(1:2*(2*l+1),nbbot:nbtop,1:n))
C The element prorb%matnrep for is=2 is set to 0, since all the matrix will be stored in the matrix matnrep for is=1
IF(.not.ALLOCATED(pr_orb(jorb,ik,2)%matn_rep)) THEN
ALLOCATE(pr_orb(jorb,ik,2)%matn_rep(1,1,1))
pr_orb(jorb,ik,2)%matn_rep(1,1,1)=0.d0
ENDIF
C Creation of a matrix tmp_matn which "concatenates" up and dn parts of pr_orb
ALLOCATE(tmp_matn(1:2*(2*l+1),nbbot:nbtop,1:n))
tmp_matn(1:(2*l+1),nbbot:nbtop,1:n)=
= pr_orb(jorb,ik,1)%matn(-l:l,nbbot:nbtop,1:n)
C The first (2l+1) lines are the spin-up part of the projection matrix prorb%matn.
C
C ---------------------------------------------------------------------------------------
C Interruption of the prgm if there is no dn part of pr_orb.
C -------------------------
C
IF(.not.ifSP) THEN
WRITE(buf,'(a,a,i2,a)')'The projectors on ',
& 'the down states are required for isrt = ',isrt,
& ' but there is no spin-polarized input files.'
CALL printout(0)
WRITE(buf,'(a)')'END OF THE PRGM'
CALL printout(0)
STOP
ENDIF
C ---------------------------------------------------------------------------------------
C
C The last (2l+1) lines are the spin-dn part of the projection matrix prorb%matn.
tmp_matn(2*l+2:2*(2*l+1),nbbot:nbtop,1:n)=
= pr_orb(jorb,ik,2)%matn(-l:l,nbbot:nbtop,1:n)
C
DO i=1,n
C Multiplication by the local rotation matrix ; Up and dn parts are treated independently
C since in lapw2 (-alm) the coefficients Alm, Blm and Clm were calculated in the local frame
C but without taking into account the spinor-rotation matrix.
ALLOCATE(tmp_matbis(1:(2*l+1),nbbot:nbtop))
tmp_matbis(1:(2*l+1),nbbot:nbtop)=
= tmp_matn(1:(2*l+1),nbbot:nbtop,i)
CALL rot_projectmat(tmp_matbis,
& l,nbbot,nbtop,jatom,isrt)
tmp_matn(1:(2*l+1),nbbot:nbtop,i)=
= tmp_matbis(1:(2*l+1),nbbot:nbtop)
tmp_matbis(1:(2*l+1),nbbot:nbtop)=
= tmp_matn(2*l+2:2*(2*l+1),nbbot:nbtop,i)
CALL rot_projectmat(tmp_matbis,
& l,nbbot,nbtop,jatom,isrt)
tmp_matn(2*l+2:2*(2*l+1),nbbot:nbtop,i)=
= tmp_matbis(1:(2*l+1),nbbot:nbtop)
DEALLOCATE(tmp_matbis)
C Putting pr_orb in the desired basis associated to (l,isrt)
pr_orb(jorb,ik,1)%matn_rep
& (1:2*(2*l+1),nbbot:nbtop,i)=
= MATMUL(reptrans(l,isrt)%
& transmat(1:2*(2*l+1),1:2*(2*l+1)),
& tmp_matn(1:2*(2*l+1),nbbot:nbtop,i))
C pr_orb%matn_rep = proj_{new_i} = reptrans*proj_{lm} = <new_i|lm>*proj_{lm}
ENDDO ! End of the i-loop
DEALLOCATE(tmp_matn)
ENDDO ! End of the ik loop
C
C If the basis representation can be reduce to the up/up block (matrices of size (2*l+1) only)
C --------------------------------------------------------------------------------------------
ELSE
DO ik=1,nk
DO is=1,ns
C Only the k-points with inlcuded bands are considered for the projectors.
IF(.NOT.kp(ik,is)%included) CYCLE
C In this case, nb_top(up) and nb_bot(up) can differ from nb_top(dn) and nb_bot(dn)
nbbot=kp(ik,is)%nb_bot
nbtop=kp(ik,is)%nb_top
IF(ALLOCATED(pr_orb(jorb,ik,is)%matn_rep)) THEN
DEALLOCATE(pr_orb(jorb,ik,is)%matn_rep)
ENDIF
ALLOCATE(pr_orb(jorb,ik,is)%
& matn_rep(-l:l,nbbot:nbtop,1:n))
pr_orb(jorb,ik,is)%matn_rep(-l:l,nbbot:nbtop,1:n)=
= pr_orb(jorb,ik,is)%matn(-l:l,nbbot:nbtop,1:n)
C
DO i=1,n
C Multiplication by the local rotation matrix
C since in lapw2 (-alm) the coefficients Alm, Blm and Clm were calculated in the local frame
CALL rot_projectmat(pr_orb(jorb,ik,is)
& %matn_rep(-l:l,nbbot:nbtop,i),
& l,nbbot,nbtop,jatom,isrt)
C Putting pr_orb in the desired basis associated to (l,isrt)
pr_orb(jorb,ik,is)%matn_rep(-l:l,nbbot:nbtop,i)=
= MATMUL(reptrans(l,isrt)%transmat(-l:l,-l:l),
& pr_orb(jorb,ik,is)%matn_rep(-l:l,nbbot:nbtop,i))
C pr_orb%matn_rep = proj_{new_i} = reptrans*proj_{lm} = <new_i|lm>*proj_{lm}
ENDDO ! End of the i loop
ENDDO ! End of the is loop
ENDDO ! End of the ik loop
ENDIF ! End of the if mixing if-then-else
ENDDO ! End of the jorb loop
C
C
C =============================================================================
C Printing the projectors with k-points 1 and nk in the file fort.18 for test :
C =============================================================================
DO icrorb=1,ncrorb
iatom=crorb(icrorb)%atom
isrt=crorb(icrorb)%sort
l=crorb(icrorb)%l
WRITE(18,'()')
WRITE(18,'(a,i4)') 'icrorb = ', icrorb
WRITE(18,'(a,i4,a,i4)') 'isrt = ', isrt, ' l = ', l
IF (l==0) THEN
WRITE(18,'(a,i4)') 'ik = ', 1
DO ib = kp(1,1)%nb_bot,kp(1,1)%nb_top
WRITE(18,*) pr_crorb(icrorb,1,1)%mat_rep(:,ib)
IF (ifSP)
& WRITE(18,*) pr_crorb(icrorb,1,2)%mat_rep(:,ib)
WRITE(18,'()')
ENDDO
WRITE(18,'(a,i4)') 'ik = ', nk
DO ib = kp(nk,1)%nb_bot,kp(nk,1)%nb_top
WRITE(18,*) pr_crorb(icrorb,nk,1)%mat_rep(:,ib)
IF (ifSP)
& WRITE(18,*) pr_crorb(icrorb,nk,2)%mat_rep(:,ib)
WRITE(18,'()')
ENDDO
ELSEIF (reptrans(l,isrt)%ifmixing) THEN
WRITE(18,'(a,i4)') 'ik = ', 1
DO ib = kp(1,1)%nb_bot,kp(1,1)%nb_top
WRITE(18,*) pr_crorb(icrorb,1,1)%mat_rep(:,ib)
WRITE(18,'()')
ENDDO
WRITE(18,'(a,i4)') 'ik = ', nk
DO ib = kp(nk,1)%nb_bot,kp(nk,1)%nb_top
WRITE(18,*) pr_crorb(icrorb,nk,1)%mat_rep(:,ib)
WRITE(18,'()')
ENDDO
ELSE
WRITE(18,'(a,i4)') 'ik = ', 1
DO ib = kp(1,1)%nb_bot,kp(1,1)%nb_top
WRITE(18,*) pr_crorb(icrorb,1,1)%mat_rep(:,ib)
IF (ifSP)
& WRITE(18,*) pr_crorb(icrorb,1,2)%mat_rep(:,ib)
WRITE(18,'()')
ENDDO
WRITE(18,'(a,i4)') 'ik = ', nk
DO ib = kp(nk,1)%nb_bot,kp(nk,1)%nb_top
WRITE(18,*) pr_crorb(icrorb,nk,1)%mat_rep(:,ib)
IF (ifSP)
& WRITE(18,*) pr_crorb(icrorb,nk,2)%mat_rep(:,ib)
WRITE(18,'()')
ENDDO
ENDIF
ENDDO
C
DO iorb=1,norb
iatom=orb(iorb)%atom
isrt=orb(iorb)%sort
l=orb(iorb)%l
n=norm_radf(iorb)%n
WRITE(18,'()')
WRITE(18,'(a,i4)') 'iorb = ', iorb
WRITE(18,'(a,i4,a,i4)') 'isrt = ', isrt, ' l = ', l
IF (l==0) THEN
WRITE(18,'(a,i4)') 'ik = ', 1
DO i=1,n
WRITE(18,'(i4)') i
DO ib = kp(1,1)%nb_bot,kp(1,1)%nb_top
WRITE(18,*) pr_orb(iorb,1,1)%matn_rep(:,ib,i)
IF (ifSP)
& WRITE(18,*) pr_orb(iorb,1,2)%matn_rep(:,ib,i)
WRITE(18,'()')
ENDDO
ENDDO
WRITE(18,'(a,i4)') 'ik = ', nk
DO i=1,n
WRITE(18,'(i4)') i
DO ib = kp(nk,1)%nb_bot,kp(nk,1)%nb_top
WRITE(18,*) pr_orb(iorb,nk,1)%matn_rep(:,ib,i)
IF (ifSP)
& WRITE(18,*) pr_orb(iorb,nk,2)%matn_rep(:,ib,i)
WRITE(18,'()')
ENDDO
ENDDO
ELSEIF(reptrans(l,isrt)%ifmixing) THEN
DO i=1,n
WRITE(18,'(i4)') i
DO ib = kp(1,1)%nb_bot,kp(1,1)%nb_top
WRITE(18,*) pr_orb(iorb,1,1)%matn_rep(:,ib,i)
WRITE(18,'()')
ENDDO
ENDDO
WRITE(18,'(a,i4)') 'ik = ', nk
DO i=1,n
WRITE(18,'(i4)') i
DO ib = kp(nk,1)%nb_bot,kp(nk,1)%nb_top
WRITE(18,*) pr_orb(iorb,nk,1)%matn_rep(:,ib,i)
WRITE(18,'()')
ENDDO
ENDDO
ELSE
DO i=1,n
WRITE(18,'(i4)') i
DO ib = kp(1,1)%nb_bot,kp(1,1)%nb_top
WRITE(18,*) pr_orb(iorb,1,1)%matn_rep(:,ib,i)
IF (ifSP)
& WRITE(18,*) pr_orb(iorb,1,2)%matn_rep(:,ib,i)
WRITE(18,'()')
ENDDO
ENDDO
WRITE(18,'(a,i4)') 'ik = ', nk
DO i=1,n
WRITE(18,'(i4)') i
DO ib = kp(nk,1)%nb_bot,kp(nk,1)%nb_top
WRITE(18,*) pr_orb(iorb,nk,1)%matn_rep(:,ib,i)
IF (ifSP)
& WRITE(18,*) pr_orb(iorb,nk,2)%matn_rep(:,ib,i)
WRITE(18,'()')
ENDDO
ENDDO
ENDIF
ENDDO
C
RETURN
END

View File

@ -0,0 +1,368 @@
c ******************************************************************************
c
c TRIQS: a Toolbox for Research in Interacting Quantum Systems
c
c Copyright (C) 2011 by L. Pourovskii, V. Vildosola, C. Martins, M. Aichhorn
c
c TRIQS is free software: you can redistribute it and/or modify it under the
c terms of the GNU General Public License as published by the Free Software
c Foundation, either version 3 of the License, or (at your option) any later
c version.
c
c TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
c WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
c FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
c details.
c
c You should have received a copy of the GNU General Public License along with
c TRIQS. If not, see <http://www.gnu.org/licenses/>.
c
c *****************************************************************************/
SUBROUTINE set_rotloc
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine sets up the Global->local coordinates %%
C %% rotational matrices for each atom of the system. %%
C %% These matrices will be used to create the projectors. %%
C %% (They are the SR matrices defined in the tutorial file.) %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE common_data
USE reps
USE symm
USE prnt
IMPLICIT NONE
COMPLEX(KIND=8), DIMENSION(:,:), ALLOCATABLE :: tmp_rot, spinrot
REAL(KIND=8) :: alpha, beta, gama, factor
INTEGER :: iatom, jatom, imu, isrt
INTEGER :: is, is1, isym, l, lm
INTEGER :: ind1, ind2, inof1, inof2
COMPLEX(KIND=8) :: ephase
C
C ====================================================
C Multiplication by an S matrix for equivalent sites :
C ====================================================
C Up to now, rotloc is the rotloc matrix (from Global to local coordinates rotation : (rotloc)_ij = <x_global_i | x_local_j >)
C The matrix S to go from the representative atom of the sort to another one must be introduced. That's what is done here-after.
DO isrt=1,nsort
iatom=SUM(nmult(0:isrt-1))+1
DO imu=1,nmult(isrt)
jatom=iatom+imu-1
DO isym=1,nsym
C If the symmetry operation isym transforms the representative atom iatom in the jatom,
C the matrix rotloc is multiplied by the corresponding srot matrix, for each orbital number l.
C if R[isym](iatom) = jatom, rotloc is multiplied by R[isym] and Rloc is finally R[isym] X rotloc = <x_global|x_sym><x_sym|x_local>
IF(srot(isym)%perm(iatom)==jatom) THEN
WRITE(17,*) ' For jatom = ',jatom, ', isym =', isym
rotloc(jatom)%srotnum=isym
C Calculation of krotm and iprop.
rotloc(jatom)%krotm(1:3,1:3)=
= MATMUL(srot(isym)%krotm(1:3,1:3),
& rotloc(jatom)%krotm(1:3,1:3))
rotloc(jatom)%iprop=rotloc(jatom)%iprop*
* srot(isym)%iprop
C Evaluation of the Euler angles of the final operation Rloc
CALL euler(TRANSPOSE(rotloc(jatom)%krotm(1:3,1:3)),
& alpha,beta,gama)
C According to Wien convention, euler takes in argument the transpose
C of the matrix rotloc(jatom)%krotm to give a,b anc c of rotloc(jatom).
rotloc(jatom)%a=alpha
rotloc(jatom)%b=beta
rotloc(jatom)%g=gama
C
C =============================================================================================================
C Calculation of the rotational matrices and evaluation of the fields timeinv and phase for the Rloc matrices :
C =============================================================================================================
IF(ifSP.AND.ifSO) THEN
C No time reversal operation is applied to rotloc (alone). If a time reversal operation must be applied,
C it comes from the symmetry operation R[isym]. That is why the field timeinv is the same as the one from srot.
rotloc(jatom)%timeinv=srot(isym)%timeinv
rotloc(jatom)%phase=0.d0
DO l=1,lmax
ALLOCATE(tmp_rot(1:2*(2*l+1),1:2*(2*l+1)))
tmp_rot=0.d0
C Whatever the value of beta (0 or Pi), the spinor rotation matrix of isym is block-diagonal.
C because the time-reversal operation have been applied if necessary.
factor=srot(isym)%phase/2.d0
ephase=EXP(CMPLX(0.d0,factor))
C We remind that the field phase is (g-a) if beta=Pi. As a result, ephase = exp(+i(g-a)/2) = -exp(+i(alpha-gamma)/2)
C We remind that the field phase is (a+g) if beta=0. As a result, ephase = exp(+i(a+g)/2)=-exp(-i(alpha+gamma)/2)
C in good agreement with Wien conventions for the definition of this phase factor.
C Up/up block :
tmp_rot(1:2*l+1,1:2*l+1)=ephase*
& srot(isym)%rotl(-l:l,-l:l,l)
C Dn/dn block :
ephase=CONJG(ephase)
C now, ephase = exp(+i(a-g)/2) = -exp(-i(alpha-gamma)/2) if beta=Pi
C now, ephase = exp(-i(a+g)/2) = -exp(+i(alpha+gamma)/2) if beta=0
tmp_rot(2*l+2:2*(2*l+1),2*l+2:2*(2*l+1))=
& ephase*srot(isym)%rotl(-l:l,-l:l,l)
IF (rotloc(jatom)%timeinv) THEN
C In this case, the time reversal operator was applied to srot.
rotloc(jatom)%rotl(1:2*(2*l+1),1:2*(2*l+1),l)=
& MATMUL(tmp_rot(1:2*(2*l+1),1:2*(2*l+1)),CONJG(
& rotloc(jatom)%rotl(1:2*(2*l+1),1:2*(2*l+1),l)))
C rotloc(jatom)%rotl now contains D(Rloc) = D(R[isym])*transpose[D(rotloc)].
ELSE
C In this case, no time reversal operator was applied to srot.
rotloc(jatom)%rotl(1:2*(2*l+1),1:2*(2*l+1),l)=
& MATMUL(tmp_rot(1:2*(2*l+1),1:2*(2*l+1)),
& rotloc(jatom)%rotl(1:2*(2*l+1),1:2*(2*l+1),l))
C rotloc(jatom)%rotl now contains D(Rloc) = D(R[isym])*D(rotloc).
ENDIF
DEALLOCATE(tmp_rot)
ENDDO
ELSE
C Calculation of the rotational matrices associated to Rloc
ALLOCATE(tmp_rot(1:2*lmax+1,1:2*lmax+1))
DO l=1,lmax
C Use of the subroutine dmat to compute the rotational matrix
C associated to the Rloc operation in a (2*l+1) space :
tmp_rot=0.d0
CALL dmat(l,rotloc(jatom)%a,rotloc(jatom)%b,
& rotloc(jatom)%g,
& REAL(rotloc(jatom)%iprop,KIND=8),tmp_rot,2*lmax+1)
rotloc(jatom)%rotl(-l:l,-l:l,l)=
= tmp_rot(1:2*l+1,1:2*l+1)
C rotloc(jatom)%rotl = table of the rotational matrices of the symmetry operation
C for the different l orbital (from 1 to lmax), in the usual complex basis : dmat = D(R[isym])_l
C rotloc(jatom)%rotl = D(Rloc[jatom])_{lm}
ENDDO
DEALLOCATE(tmp_rot)
ENDIF ! End of the "ifSO-ifSP" if-then-else
C
EXIT
C Only one symmetry operation is necessary to be applied to R to get the complete rotloc matrix.
C This EXIT enables to leave the loop as soon as a symmetry operation which transforms the representative atom in jatom is found.
ENDIF ! End of the "perm" if-then-else
ENDDO ! End of the isym loop
C
C
C ===========================================================
C Computation of the rotational matrices in each sort basis :
C ===========================================================
ALLOCATE(rotloc(jatom)%rotrep(lmax))
C
C Initialization of the rotloc(jatom)%rotrep field = D(Rloc)_{new_i}
C This field is a table of size lmax which contains the rotloc matrices
C in the representation basis associated to each included orbital of the jatom.
DO l=1,lmax
ALLOCATE(rotloc(jatom)%rotrep(l)%mat(1,1))
rotloc(jatom)%rotrep(l)%mat(1,1)=0.d0
ENDDO
C
C Computation of the elements 'mat' in rotloc(jatom)%rotrep(l)
DO l=1,lmax
C The considered orbital is not included, hence no computation
IF (lsort(l,isrt)==0) cycle
C The considered orbital is included
IF (ifSP.AND.ifSO) THEN
C In this case, the basis representation needs a complete spinor rotation approach (matrices of size 2*(2*l+1) )
C --------------------------------------------------------------------------------------------------------------
DEALLOCATE(rotloc(jatom)%rotrep(l)%mat)
ALLOCATE(rotloc(jatom)%rotrep(l)%mat
& (1:2*(2*l+1),1:2*(2*l+1)))
ALLOCATE(tmp_rot(1:2*(2*l+1),1:2*(2*l+1)))
C Computation of rotloc(jatom)%rotrep(l)%mat
IF (reptrans(l,isrt)%ifmixing) THEN
C In this case, the basis representation requires a complete spinor rotation approach too.
IF(rotloc(jatom)%timeinv) THEN
tmp_rot(1:2*(2*l+1),1:2*(2*l+1))=MATMUL(
& reptrans(l,isrt)%transmat(1:2*(2*l+1),1:2*(2*l+1)),
& rotloc(jatom)%rotl(1:2*(2*l+1),1:2*(2*l+1),l))
rotloc(jatom)%rotrep(l)%mat(1:2*(2*l+1),1:2*(2*l+1))=
= MATMUL(tmp_rot(1:2*(2*l+1),1:2*(2*l+1)),
& TRANSPOSE(reptrans(l,isrt)%transmat
& (1:2*(2*l+1),1:2*(2*l+1))))
C Since the operation is antilinear, the field rotloc(jatom)%rotrep(l)%mat = (reptrans)*spinrot(l)*conjugate(inverse(reptrans))
C rotloc(jatom)%rotrep(l)%mat = D(Rloc)_{new_i} = <new_i|lm> D(Rloc)_{lm} [<lm|new_i>]^*
C which is exactly the expression of the spinor rotation matrix in the new basis.
ELSE
tmp_rot(1:2*(2*l+1),1:2*(2*l+1))=MATMUL(
& reptrans(l,isrt)%transmat(1:2*(2*l+1),1:2*(2*l+1)),
& rotloc(jatom)%rotl(1:2*(2*l+1),1:2*(2*l+1),l))
rotloc(jatom)%rotrep(l)%mat(1:2*(2*l+1),1:2*(2*l+1))=
= MATMUL(tmp_rot(1:2*(2*l+1),1:2*(2*l+1)),
& TRANSPOSE(CONJG(reptrans(l,isrt)%transmat
& (1:2*(2*l+1),1:2*(2*l+1)))))
C Since the operation is linear, the field rotloc(jatom)%rotrep(l)%mat = (reptrans)*spinrot(l)*inverse(reptrans)
C rotloc(jatom)%rotrep(l)%mat = D(Rloc)_{new_i} = <new_i|lm> D(Rloc)_{lm} <lm|new_i>
C which is exactly the expression of the spinor rotation matrix in the new basis.
ENDIF
ELSE
C In this case, the basis representation is reduced to the up/up block and must be extended.
ALLOCATE(spinrot(1:2*(2*l+1),1:2*(2*l+1)))
spinrot(1:2*(2*l+1),1:2*(2*l+1))=0.d0
spinrot(1:2*l+1,1:2*l+1)=
& reptrans(l,isrt)%transmat(-l:l,-l:l)
spinrot(2*l+2:2*(2*l+1),2*l+2:2*(2*l+1))=
& reptrans(l,isrt)%transmat(-l:l,-l:l)
IF(rotloc(jatom)%timeinv) THEN
tmp_rot(1:2*(2*l+1),1:2*(2*l+1))=MATMUL(
& spinrot(1:2*(2*l+1),1:2*(2*l+1)),
& rotloc(jatom)%rotl(1:2*(2*l+1),1:2*(2*l+1),l))
rotloc(jatom)%rotrep(l)%mat(1:2*(2*l+1),1:2*(2*l+1))=
= MATMUL(tmp_rot(1:2*(2*l+1),1:2*(2*l+1)),
& TRANSPOSE(spinrot(1:2*(2*l+1),1:2*(2*l+1))))
C Since the operation is antilinear, the field rotloc(jatom)%rotrep(l)%mat = (reptrans)*spinrot(l)*conjugate(inverse(reptrans))
C rotloc(jatom)%rotrep(l)%mat = D(Rloc)_{new_i} = <new_i|lm> D(Rloc)_{lm} [<lm|new_i>]^*
C which is exactly the expression of the spinor rotation matrix in the new basis.
ELSE
tmp_rot(1:2*(2*l+1),1:2*(2*l+1))=MATMUL(
& spinrot(1:2*(2*l+1),1:2*(2*l+1)),
& rotloc(jatom)%rotl(1:2*(2*l+1),1:2*(2*l+1),l))
rotloc(jatom)%rotrep(l)%mat(1:2*(2*l+1),1:2*(2*l+1))=
= MATMUL(tmp_rot(1:2*(2*l+1),1:2*(2*l+1)),
& TRANSPOSE(CONJG(spinrot(1:2*(2*l+1),1:2*(2*l+1)))))
C Since the operation is linear, the field rotloc(jatom)%rotrep(l)%mat = (reptrans)*spinrot(l)*inverse(reptrans)
C rotloc(jatom)%rotrep(l)%mat = D(Rloc)_{new_i} = <new_i|lm> D(Rloc)_{lm} <lm|new_i>
C which is exactly the expression of the spinor rotation matrix in the new basis.
ENDIF
DEALLOCATE(spinrot)
ENDIF ! End of the if mixing if-then-else
DEALLOCATE(tmp_rot)
C
ELSE
C If the basis representation can be reduce to the up/up block (matrices of size (2*l+1) only)
C --------------------------------------------------------------------------------------------
DEALLOCATE(rotloc(jatom)%rotrep(l)%mat)
ALLOCATE(rotloc(jatom)%rotrep(l)%mat(-l:l,-l:l))
ALLOCATE(tmp_rot(-l:l,-l:l))
C Computation of rotloc(jatom)%rotrep(l)%mat
tmp_rot(-l:l,-l:l)=MATMUL(
& reptrans(l,isrt)%transmat(-l:l,-l:l),
& rotloc(jatom)%rotl(-l:l,-l:l,l))
rotloc(jatom)%rotrep(l)%mat(-l:l,-l:l)=
= MATMUL(tmp_rot(-l:l,-l:l),
& TRANSPOSE(CONJG(reptrans(l,isrt)%transmat(-l:l,-l:l))))
C the field rotloc(jatom)%rotrep(l)%mat = (reptrans)*rotl*inverse(reptrans)
C rotloc(jatom)%rotrep(l)%mat = D(Rloc)_{new_i} = <new_i|lm> D(Rloc)_{lm} <lm|new_i>
C which is exactly the expression of the rotation matrix for the up/up block in the new basis.
DEALLOCATE(tmp_rot)
ENDIF
ENDDO ! End of the l loop
ENDDO ! End of the jatom loop
ENDDO ! End of the isrt loop
C
RETURN
END
SUBROUTINE euler(Rot,a,b,c)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine calculates the Euler angles a, b and c of Rot. %%
C %% The result are stored in a,b,c. (same as in SRC_lapwdm/euler.f) %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C
IMPLICIT NONE
REAL(KIND=8) :: a,aa,b,bb,c,cc,zero,pi,y_norm,dot
REAL(KIND=8), DIMENSION(3,3) :: Rot, Rot_temp
REAL(KIND=8), DIMENSION(3) :: z,zz,y,yy,yyy,pom,x,xx
INTEGER :: i,j
C Definition of the constants
zero=0d0
pi=ACOS(-1d0)
C Definition of Rot_temp=Id
DO i=1,3
DO j=1,3
Rot_temp(i,j)=0
IF (i.EQ.j) Rot_temp(i,i)=1
ENDDO
ENDDO
C Initialization of y=e_y, z=e_z, yyy and zz
DO j=1,3
y(j)=Rot_temp(j,2)
yyy(j)=Rot(j,2)
z(j)=Rot_temp(j,3)
zz(j)=Rot(j,3)
ENDDO
C Calculation of yy
CALL vecprod(z,zz,yy)
y_norm=DSQRT(dot(yy,yy))
IF (y_norm.lt.1d-10) THEN
C If yy=0, this implies that b is zero or pi
IF (ABS(dot(y,yyy)).gt.1d0) THEN
aa=dot(y,yyy)/ABS(dot(y,yyy))
a=ACOS(aa)
ELSE
a=ACOS(dot(y,yyy))
ENDIF
C
IF (dot(z,zz).gt.zero) THEN
c=zero
b=zero
IF (yyy(1).gt.zero) a=2*pi-a
ELSE
c=a
a=zero
b=pi
IF (yyy(1).lt.zero) c=2*pi-c
ENDIF
ELSE
C If yy is not 0, then b belongs to ]0,pi[
DO j=1,3
yy(j)=yy(j)/y_norm
ENDDO
C
aa=dot(y,yy)
bb=dot(z,zz)
cc=dot(yy,yyy)
IF (ABS(aa).gt.1d0) aa=aa/ABS(aa)
IF (ABS(bb).gt.1d0) bb=bb/ABS(bb)
IF (ABS(cc).gt.1d0) cc=cc/ABS(cc)
b=ACOS(bb)
a=ACOS(aa)
c=ACOS(cc)
IF (yy(1).gt.zero) a=2*pi-a
CALL vecprod(yy,yyy,pom)
IF (dot(pom,zz).lt.zero) c=2*pi-c
ENDIF
C
END
SUBROUTINE vecprod(a,b,c)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine calculates the vector product of a and b. %%
C %% The result is stored in c. (same as in SRC_lapwdm/euler.f) %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C
IMPLICIT NONE
REAL(KIND=8), DIMENSION(3) :: a,b,c
C
c(1)=a(2)*b(3)-a(3)*b(2)
c(2)=a(3)*b(1)-a(1)*b(3)
c(3)=a(1)*b(2)-a(2)*b(1)
C
END
REAL(KIND=8) FUNCTION dot(a,b)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This function calculates the scalar product of a and b. %%
C %% The result is stored in dot. (same as in SRC_lapwdm/euler.f) %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C
IMPLICIT NONE
REAL(KIND=8) :: a,b
INTEGER :: i
dimension a(3),b(3)
dot=0
DO i=1,3
dot=dot+a(i)*b(i)
ENDDO
C
END

886
fortran/dmftproj/setsym.f Normal file
View File

@ -0,0 +1,886 @@
c ******************************************************************************
c
c TRIQS: a Toolbox for Research in Interacting Quantum Systems
c
c Copyright (C) 2011 by L. Pourovskii, V. Vildosola, C. Martins, M. Aichhorn
c
c TRIQS is free software: you can redistribute it and/or modify it under the
c terms of the GNU General Public License as published by the Free Software
c Foundation, either version 3 of the License, or (at your option) any later
c version.
c
c TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
c WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
c FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
c details.
c
c You should have received a copy of the GNU General Public License along with
c TRIQS. If not, see <http://www.gnu.org/licenses/>.
c
c *****************************************************************************/
SUBROUTINE setsym
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine sets up the symmetry matrices of the structure %%
C %% and the local rotation matrices for each atom of the system. %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE common_data
USE factorial
USE file_names
USE prnt
USE reps
USE symm
IMPLICIT NONE
C
COMPLEX(KIND=8), DIMENSION(:,:), ALLOCATABLE :: tmp_rot, spinrot
COMPLEX(KIND=8), DIMENSION(:,:),ALLOCATABLE :: tmat
COMPLEX(KIND=8), DIMENSION(:,:,:),ALLOCATABLE :: tmp_dmat
REAL(KIND=8) :: factor
INTEGER :: l, isym, mmax, nrefl, i, m, isrt, lms
INTEGER :: lm, is, is1
INTEGER :: iatom, imu, iatomref
REAL(KIND=8) :: det
REAL(KIND=8), DIMENSION(:),ALLOCATABLE :: bufreal
COMPLEX(KIND=8), DIMENSION(:),ALLOCATABLE :: bufcomp
COMPLEX(KIND=8), DIMENSION(:,:),ALLOCATABLE :: tmpcomp
COMPLEX(KIND=8), DIMENSION(1:2,1:2) :: spmt
C
C
WRITE(buf,'(a)')'======================================='
CALL printout(0)
WRITE(buf,'(a)')'Symmetry operations of the system'
CALL printout(1)
C
C ===========================================
C Reading of the symmetry file case.dmftsym :
C ===========================================
CALL setfact(170)
READ(iusym,*)nsym
WRITE(buf,'(a,i4)')'Number of Symmetries = ',nsym
CALL printout(0)
CALL printout(0)
C nsym = total number of symmetry operations for the structure
lsym=lmax
nlmsym=2*lsym+1
C lsym = maximal orbital number for the symmetry
C nlmsym = maximal size of the representation for the symmetry
ALLOCATE(srot(nsym))
DO isym=1,nsym
ALLOCATE(srot(isym)%perm(natom))
READ(iusym,*)srot(isym)%perm
ENDDO
C srot = table of symop elements from to 1 to nsym.
C the field srot(isym)%perm = the table of permutation for the isym symmetry (table from 1 to natom)
C srot(isym)%perm(iatom) = R[isym](iatom) = image by R[isym] fo iatom
WRITE(buf,'(a)')'Properties of the symmetry operations :'
CALL printout(0)
WRITE(buf,'(a)') ' alpha, beta, gamma are their Euler angles.'
CALL printout(0)
WRITE(buf,'(a)') ' iprop is the value of their determinant.'
CALL printout(0)
CALL printout(0)
WRITE(buf,'(a)')' SYM.OP. alpha beta gamma iprop'
CALL printout(0)
DO isym=1,nsym
READ(iusym,'()')
READ(iusym,'()')
READ(iusym,'(3(f6.1),i3)') srot(isym)%a, srot(isym)%b,
& srot(isym)%g, srot(isym)%iprop
C Printing the matrices parameters in the file case.outdmftpr
WRITE(buf,'(i5,3F10.1,5x,i3)')isym,
& srot(isym)%a,srot(isym)%b,srot(isym)%g,srot(isym)%iprop
CALL printout(0)
srot(isym)%a=srot(isym)%a/180d0*Pi
srot(isym)%b=srot(isym)%b/180d0*Pi
srot(isym)%g=srot(isym)%g/180d0*Pi
C the field srot(isym)%a is linked to the Euler precession angle (alpha)
C the field srot(isym)%b is linked to the Euler nutation angle (beta)
C the field srot(isym)%c is linked to the Euler intrinsic rotation angle (gamma)
C They are read in case.dmftsym in degree and are then transformed into radians
C the field sort(isym)% iprop = value of the transformation determinant (1 or -1),
C determines if there is an inversion in the transformation
READ(iusym,*)(srot(isym)%krotm(1:3,i),i=1,3)
srot(isym)%krotm(1:3,1:3)=
& TRANSPOSE(srot(isym)%krotm(1:3,1:3))
C the field srot(isym)%krotm = 3x3 matrices of rotation associated to the transformation (R[isym]).
C (without the global inversion). The matrix was multiplied by the value of iprop before being written in case.dmftsym.
C This reading line was chosen to be consistent with the writing line in rotmat_dmft (in SRC_lapw2)
ENDDO
C
C =============================================================
C Determination of the properties for each symmetry operation :
C =============================================================
C
C Creation of the rotational matrices for each orbital :
C ------------------------------------------------------
DO isym=1,nsym
ALLOCATE(srot(isym)%rotl(-lsym:lsym,-lsym:lsym,lsym))
srot(isym)%rotl=0.d0
ALLOCATE(tmat(1:2*lsym+1,1:2*lsym+1))
DO l=1,lsym
C Use of the subroutine dmat to compute the the rotational matrix
C associated to the isym symmetry operation in a (2*l+1) space :
CALL dmat(l,srot(isym)%a,srot(isym)%b,srot(isym)%g,
& REAL(srot(isym)%iprop,KIND=8),tmat,2*lsym+1)
srot(isym)%rotl(-l:l,-l:l,l)=tmat(1:2*l+1,1:2*l+1)
C srot(isym)%rotl = table of the rotationnal matrices of the symmetry operation
C for the different l orbital (from 1 to lsym), in the usual complex basis : dmat = D(R[isym])_l
C srot(isym)%rotl = D(R[isym])_{lm}
ENDDO
DEALLOCATE(tmat)
C
C
C Determination of the fields timeinv and phase (if SP+SO computations):
C ----------------------------------------------------------------------
C If the calculation is spin-polarized with spin-orbit, the magnetic spacegroup of the
C system is of type III (black-and-white type). The operation must then be classified
C according to their keeping the z-axis invariant or not.
C
C srot(isym)%timeinv = boolean indicating if a time reversal operation is required
IF(ifSP.AND.ifSO) THEN
det=srot(isym)%krotm(1,1)*srot(isym)%krotm(2,2)-
- srot(isym)%krotm(1,2)*srot(isym)%krotm(2,1)
C the value of det is cos(srot(isym)%b) even if the rotation is improper.
IF(det < 0.0d0) THEN
srot(isym)%timeinv=.TRUE.
C The direction of the magnetic moment is changed to its opposite ( srot(isym)%b=pi ),
C A time reversal operation is required.
srot(isym)%phase=srot(isym)%g-srot(isym)%a
C In this case, we define a phase factor for the off-diagonal term (up/dn term)
C which is srot(isym)%phase= g-a = 2pi+(alpha-gamma)
ELSE
srot(isym)%timeinv=.FALSE.
C The direction of the magnetic moment is unchanged ( srot(isym)%b=0 ),
C no time reversal operation is required.
srot(isym)%phase=srot(isym)%a+srot(isym)%g
C In this case, we define a phase factor for the off-diagonal term (up/dn term)
C which is srot(isym)%phase= a+g = 2pi-(alpha+gamma)
ENDIF
ELSE
C If the calculation is either spin-polarized without spin-orbit, or paramagnetic
C the magnetic spacegroup of the system is of type I (ordinary type). The operation
C are thus merely applied.
srot(isym)%timeinv=.FALSE.
srot(isym)%phase=0.d0
ENDIF ! End of the ifSP if-then-else
C
C
C Computation of the rotational matrices in each sort basis :
C -----------------------------------------------------------
ALLOCATE(srot(isym)%rotrep(lsym,nsort))
C
C Initialization of the srot(isym)%rotrep field
C This field is a table of size (lsym*nsort) which contains the rotation matrices
C of isym in the representation basis associated to each included orbital of each atom.
C srot(isym)%rotrep = D(R[isym])_{new_i}
DO isrt=1,nsort
DO l=1,lsym
ALLOCATE(srot(isym)%rotrep(l,isrt)%mat(1,1))
srot(isym)%rotrep(l,isrt)%mat(1,1)=0.d0
ENDDO
ENDDO
C
C Computation of the elements 'mat' in srot(isym)%rotrep(l,isrt)
DO isrt=1,nsort
IF (notinclude(isrt)) cycle
DO l=1,lsym
C The considered orbital is not included, hence no computation
IF (lsort(l,isrt)==0) cycle
C The considered orbital is included
IF (reptrans(l,isrt)%ifmixing) THEN
C If the basis representation needs a complete spinor rotation approach (matrices of size 2*(2*l+1) )
C If this option is used, then ifSO=.TRUE. (because of the restriction in set_ang_trans.f)
C Moreover ifSP=.TRUE. (since ifSO => ifSP in this version)
DEALLOCATE(srot(isym)%rotrep(l,isrt)%mat)
ALLOCATE(srot(isym)%rotrep(l,isrt)%mat
& (1:2*(2*l+1),1:2*(2*l+1)))
ALLOCATE(tmp_rot(1:2*(2*l+1),1:2*(2*l+1)))
ALLOCATE(spinrot(1:2*(2*l+1),1:2*(2*l+1)))
spinrot=0.d0
C Computation of the full spinor rotation matrix associated to isym.
CALL spinrotmat(spinrot,isym,l)
C Computation of srot(isym)%rotrep(l,isrt)%mat
tmp_rot(1:2*(2*l+1),1:2*(2*l+1))=MATMUL(
& reptrans(l,isrt)%transmat(1:2*(2*l+1),1:2*(2*l+1)),
& spinrot(1:2*(2*l+1),1:2*(2*l+1)))
srot(isym)%rotrep(l,isrt)%mat(1:2*(2*l+1),1:2*(2*l+1))=
= MATMUL(tmp_rot(1:2*(2*l+1),1:2*(2*l+1)),
& TRANSPOSE(CONJG(reptrans(l,isrt)%transmat
& (1:2*(2*l+1),1:2*(2*l+1)))))
C the field srot(isym)%rotrep(l,isrt)%mat = (reptrans)*spinrot(l)*inverse(reptrans)
C or srot(isym)%rotrep = D(R[isym])_{new_i} = <new_i|lm> D(R[isym])_{lm} <lm|new_i>
C which is exactly the expression of the spinor rotation matrix in the new basis.
DEALLOCATE(tmp_rot)
DEALLOCATE(spinrot)
ELSE
C If the basis representation can be reduce to the up/up block (matrices of size (2*l+1) only)
DEALLOCATE(srot(isym)%rotrep(l,isrt)%mat)
ALLOCATE(srot(isym)%rotrep(l,isrt)%mat(-l:l,-l:l))
ALLOCATE(tmp_rot(-l:l,-l:l))
C Computation of srot(isym)%rotrep(l,isrt)%mat
tmp_rot(-l:l,-l:l)=MATMUL(
& reptrans(l,isrt)%transmat(-l:l,-l:l),
& srot(isym)%rotl(-l:l,-l:l,l))
srot(isym)%rotrep(l,isrt)%mat(-l:l,-l:l)=
= MATMUL(tmp_rot(-l:l,-l:l),
& TRANSPOSE(CONJG(reptrans(l,isrt)%transmat(-l:l,-l:l))))
C the field srot(isym)%rotrep(l,isrt)%mat = (reptrans)*rotl*inverse(reptrans)
C or srot(isym)%rotrep = D(R[isym])_{new_i} = <new_i|lm> D(R[isym])_{lm} <lm|new_i>
C which is exactly the expression of the rotation matrix for the up/up block in the new basis.
DEALLOCATE(tmp_rot)
ENDIF
ENDDO ! End of the l loop
ENDDO ! End of the isrt loop
ENDDO ! End of the isym loop
C
C
C =============================================================
C Printing the matrix parameters in the file fort.17 for test :
C =============================================================
DO isym=1,nsym
WRITE(17,'()')
WRITE(17,'(a,i3)')' Sym. op.: ',isym
DO i =1,3
ALLOCATE(bufreal(3))
bufreal(1:3)=srot(isym)%krotm(i,1:3)
WRITE(17,'(3f10.4)') bufreal
DEALLOCATE(bufreal)
ENDDO
WRITE(17,'(a,3f8.1,i4)')'a, b, g, iprop =',
& srot(isym)%a*180d0/Pi,srot(isym)%b*180d0/Pi,
& srot(isym)%g*180d0/Pi,srot(isym)%iprop
C Printing the data relative to SP option
IF (ifSP) THEN
WRITE(17,*)'If DIR. magn. mom. is inverted :'
& ,srot(isym)%timeinv
WRITE(17,*)'phase = ',srot(isym)%phase
ENDIF
C Printing the rotational matrices for each orbital number l.
WRITE(17,'()')
DO l=1,lsym
WRITE(17,'(a,a,i2)')'Rotation matrix ',
& 'D(R[isym])_{lm} for l = ',l
DO m=-l,l
ALLOCATE(bufcomp(-l:l))
bufcomp(-l:l)=srot(isym)%rotl(m,-l:l,l)
WRITE(17,'(7(2f7.3,x))') bufcomp
DEALLOCATE(bufcomp)
ENDDO
ENDDO
C Printing the matrices rotrep(l,isrt)%mat
WRITE(17,'()')
DO isrt=1,nsort
IF (notinclude(isrt)) cycle
DO l=1,lsym
IF (lsort(l,isrt)==0) cycle
WRITE(17,'(a,i2,a,i2)')'Representation for isrt = ',
& isrt,' and l= ',l
IF (reptrans(l,isrt)%ifmixing) THEN
DO m=1,2*(2*l+1)
ALLOCATE(bufcomp(1:2*(2*l+1)))
bufcomp(1:2*(2*l+1))=
& srot(isym)%rotrep(l,isrt)%mat(m,1:2*(2*l+1))
WRITE(17,'(7(2f7.3,x))') bufcomp
DEALLOCATE(bufcomp)
ENDDO
ELSE
DO m=-l,l
ALLOCATE(bufcomp(-l:l))
bufcomp(-l:l)=
& srot(isym)%rotrep(l,isrt)%mat(m,-l:l)
WRITE(17,'(7(2f7.3,x))') bufcomp
DEALLOCATE(bufcomp)
ENDDO
ENDIF
ENDDO
ENDDO
ENDDO
C
C
C =================================================================================
C Applying time-reversal operator if the system is spin-polarized with Spin Orbit :
C =================================================================================
C
C If the calculation is spin-polarized with spin-orbit, the magnetic spacegroup of the compound
C is of type III (black-and-white). The symmetry operations which reverse the z-axis must be
C multiplied by the time-reversal operator.
C If spin-orbit is not taken into account, all the field timeinv are .FALSE. and no time-reversal
C is applied, since the magnetic spacegroup of the compound is of type I (ordinary).
IF (ifSP) THEN
C The modification of srot(isym)%rotl is done for each isym
DO isym=1,nsym
DO l=1,lsym
IF (srot(isym)%timeinv) THEN
C The field srot(isym)%rotl is multiplied by the time-reversal operator in the complex basis.
ALLOCATE(tmpcomp(-l:l,-l:l))
tmpcomp(-l:l,-l:l)=
& srot(isym)%rotl(-l:l,-l:l,l)
CALL timeinv_op(tmpcomp,(2*l+1),l,0)
srot(isym)%rotl(-l:l,-l:l,l)=tmpcomp(-l:l,-l:l)
DEALLOCATE(tmpcomp)
C The field srot(isym)%phase must not be modified.
END IF
END DO
END DO
C
C The other modification are done for each (isrt,l) included.
DO isrt=1,nsort
IF (notinclude(isrt)) cycle
DO l=1,lsym
C The considered orbital is not included, hence no computation
IF (lsort(l,isrt)==0) cycle
C If the basis representation needs a complete spinor rotation approach (matrices of size 2*(2*l+1) )
IF (reptrans(l,isrt)%ifmixing) THEN
DO isym=1,nsym
IF (srot(isym)%timeinv) THEN
C The field srot(isym)%rotrep(l,isrt)%mat is multiplied by the time-reversal operator in the corresponding basis of isrt.
CALL timeinv_op(srot(isym)%rotrep(l,isrt)%mat,
& 2*(2*l+1),l,isrt)
END IF
END DO ! End of the isym loop
C If the basis representation can be reduce to the up/up block (matrices of size (2*l+1) only)
ELSE
DO isym=1,nsym
IF (srot(isym)%timeinv) THEN
C The field srot(isym)%rotrep(l,isrt)%mat is multiplied by the time-reversal operator in the corresponding basis of isrt.
CALL timeinv_op(srot(isym)%rotrep(l,isrt)%mat,
& (2*l+1),l,isrt)
END IF
END DO ! End of the isym loop
END IF ! End of the ifmixing if-then-else
END DO ! End of the l loop
END DO ! End of the isrt loop
END IF ! End of the ifSP if-then-else
C
C
C ======================================================================
C Printing the time-reversal modification in the file fort.17 for test :
C ======================================================================
IF (ifSP.AND.ifSO) THEN
WRITE(17,'()')
WRITE(17,'(a)') '---With time-reversal operation---'
WRITE(17,'()')
C Printing the srot(isym) operations if necessary :
DO isym=1,nsym
IF (srot(isym)%timeinv) THEN
WRITE(17,'()')
WRITE(17,'(a,i3)')' Sym. op.: ',isym
C Printing the new rotational matrices for each orbital number l.
WRITE(17,'()')
DO l=1,lsym
WRITE(17,'(a,a,i2)')'T*Rotation matrix ',
& 'D(T.R[isym])_{lm} for l = ',l
DO m=-l,l
ALLOCATE(bufcomp(-l:l))
bufcomp(-l:l)=srot(isym)%rotl(m,-l:l,l)
WRITE(17,'(7(2f7.3,x))') bufcomp
DEALLOCATE(bufcomp)
ENDDO
ENDDO
C Printing the new matrices rotrep(l,isrt)%mat
WRITE(17,'()')
DO isrt=1,nsort
IF (notinclude(isrt)) cycle
DO l=1,lsym
IF (lsort(l,isrt)==0) cycle
WRITE(17,'(a,i2,a,i2)')
& 'Representation for isrt = ',isrt,' and l= ',l
IF (reptrans(l,isrt)%ifmixing) THEN
DO m=1,2*(2*l+1)
ALLOCATE(bufcomp(1:2*(2*l+1)))
bufcomp(1:2*(2*l+1))=
& srot(isym)%rotrep(l,isrt)%mat(m,1:2*(2*l+1))
WRITE(17,'(7(2f7.3,x))') bufcomp
DEALLOCATE(bufcomp)
ENDDO
ELSE
DO m=-l,l
ALLOCATE(bufcomp(-l:l))
bufcomp(-l:l)=
& srot(isym)%rotrep(l,isrt)%mat(m,-l:l)
WRITE(17,'(7(2f7.3,x))') bufcomp
DEALLOCATE(bufcomp)
END DO
END IF
END DO
END DO
END IF
ENDDO
END IF
C
C
C ============================================================
C Creation of the global->local coordinate rotation matrices :
C ============================================================
ALLOCATE(rotloc(natom))
CALL printout(1)
WRITE(buf,'(a)')'-------------------------------------'
CALL printout(0)
WRITE(buf,'(a)')'Global-to-local-coordinates rotations'
CALL printout(1)
WRITE(buf,'(a)')'Properties of the symmetry operations :'
CALL printout(0)
WRITE(buf,'(a)') ' alpha, beta, gamma are their Euler angles.'
CALL printout(0)
WRITE(buf,'(a)') ' iprop is the value of their determinant.'
CALL printout(0)
CALL printout(0)
WRITE(buf,'(a)')' SORT alpha beta gamma iprop'
CALL printout(0)
READ(iusym,'()')
DO isrt=1,nsort
C Reading the data for the representative atom in case.dmftsym and printing them in case.outdmftpr :
C --------------------------------------------------------------------------------------------------
iatomref=SUM(nmult(0:isrt-1))+1
READ(iusym,'()')
DO i=1,3
ALLOCATE(bufreal(3))
READ(iusym,*) bufreal
rotloc(iatomref)%krotm(i,1:3)=bufreal(1:3)
DEALLOCATE(bufreal)
ENDDO
C the field rotloc(iatomref)%krotm = 3x3 matrices of rotation associated to the transformation Rloc
C Rloc = <x_global | x_local >. The matrix was not multiplied by the value of iprop before being
C written in case.dmftsym (cf. SRC_lapw2/rotmat_dmft.f).
C rotloc(iatomref)%krotm can thus be either a proper or an improper rotation (with inversion).
C This reading line was chosen to be consistent with the writing line in rotmat_dmft (in SRC_lapw2)
READ(iusym,*)rotloc(iatomref)%a,rotloc(iatomref)%b,
& rotloc(iatomref)%g, rotloc(iatomref)%iprop
WRITE(buf,'(i5,3F10.1,5x,i3)')isrt,
& rotloc(iatomref)%a, rotloc(iatomref)%b,
& rotloc(iatomref)%g, rotloc(iatomref)%iprop
CALL printout(0)
rotloc(iatomref)%a=rotloc(iatomref)%a/180d0*Pi
rotloc(iatomref)%b=rotloc(iatomref)%b/180d0*Pi
rotloc(iatomref)%g=rotloc(iatomref)%g/180d0*Pi
C the field rotloc%a is linked to the Euler precession angle (alpha)
C the field rotloc%b is linked to the Euler nutation angle (beta)
C the field rotloc%c is linked to the Euler intrinsic rotation angle (gamma)
C They are read in case.dmftsym and printed in case.outdmftpr in degree and are then transformed into radians
C the field rotloc%iprop = value of the transformation determinant (should be 1 in almost all the cases),
C determines if there is an inversion in the transformation from global to local basis.
rotloc(iatomref)%krotm(1:3,1:3)=rotloc(iatomref)%iprop*
& rotloc(iatomref)%krotm(1:3,1:3)
C Now, the field rotloc(iatomref)%krotm described only the proper rotation associated to the transformation.
C
C Use of the subroutine dmat to compute the rotational matrix
C associated to the rotloc(iatomref) operation in a (2*l+1) orbital space :
ALLOCATE(tmat(1:2*lsym+1,1:2*lsym+1))
ALLOCATE(tmp_dmat(1:2*lsym+1,1:2*lsym+1,1:lsym))
DO l=1,lsym
tmat=0.d0
CALL dmat(l,rotloc(iatomref)%a,rotloc(iatomref)%b,
& rotloc(iatomref)%g,REAL(rotloc(iatomref)%iprop,KIND=8),
& tmat,2*lsym+1)
tmp_dmat(1:2*l+1,1:2*l+1,l)=tmat(1:2*l+1,1:2*l+1)
C tmp_dmat = D(Rloc)_{lm}
ENDDO
DEALLOCATE(tmat)
C
C
C Storing the rotloc matrix and initializing the other fields for all equivalent atoms :
C --------------------------------------------------------------------------------------
C All the equivalent atoms will have the same rotloc description. These data
C will be correctly redifined in the subroutine set_rotloc, where the action of the
C symmetry operation which transforms the representative atom in the considered one
C will be added.
DO imu=1,nmult(isrt)
iatom=SUM(nmult(0:isrt-1))+imu
IF(ifSP.AND.ifSO) THEN
C In this case, we have to consider the spinor rotation matrix associated to rotloc
C (the value of the Euler angle beta can be anything between 0 and Pi)
ALLOCATE(rotloc(iatom)%rotl(1:2*(2*lsym+1),
& 1:2*(2*lsym+1),lsym))
rotloc(iatom)%rotl=0.d0
DO l=1,lsym
C For each orbital (from l=0 to lsym)
C Calculation of the representation matrix of rotloc in the spin-space
C in agreement with Wien conventions used for the definition of spmt (in SRC_lapwdm/sym.f)
C Up/up and Dn/dn terms
factor=(rotloc(iatomref)%a+rotloc(iatomref)%g)/2.d0
spmt(1,1)=EXP(CMPLX(0.d0,factor))
& *DCOS(rotloc(iatomref)%b/2.d0)
spmt(2,2)=CONJG(spmt(1,1))
C Up/dn and Dn/up terms
factor=-(rotloc(iatomref)%a-rotloc(iatomref)%g)/2.d0
spmt(1,2)=EXP(CMPLX(0.d0,factor))
& *DSIN(rotloc(iatomref)%b/2.d0)
spmt(2,1)=-CONJG(spmt(1,2))
C Up/up block :
rotloc(iatom)%rotl(1:2*l+1,1:2*l+1,l)=
& spmt(1,1)*tmp_dmat(1:2*l+1,1:2*l+1,l)
C Dn/dn block :
rotloc(iatom)%rotl(2*l+2:2*(2*l+1),2*l+2:2*(2*l+1),l)=
& spmt(2,2)*tmp_dmat(1:2*l+1,1:2*l+1,l)
C Up/dn block :
rotloc(iatom)%rotl(1:2*l+1,2*l+2:2*(2*l+1),l)=
& spmt(1,2)*tmp_dmat(1:2*l+1,1:2*l+1,l)
C Dn/up block :
rotloc(iatom)%rotl(2*l+2:2*(2*l+1),1:2*l+1,l)=
& spmt(2,1)*tmp_dmat(1:2*l+1,1:2*l+1,l)
C The fields rotloc(iatom)%rotl now contain D(rotloc)_{lm}xD(rotloc)_{1/2}
ENDDO
ELSE
C In this case, we can consider the spatial rotation matrix only
C since each spin space is independent (paramagnetic or spin-polarized without SO computation)
ALLOCATE(rotloc(iatom)%rotl(-lsym:lsym,-lsym:lsym,lsym))
rotloc(iatom)%rotl=0.d0
DO l=1,lsym
rotloc(iatom)%rotl(-l:l,-l:l,l)=
= tmp_dmat(1:2*l+1,1:2*l+1,l)
C The fields rotloc(iatom)%rotl now contain D(rotloc)_{lm}
ENDDO
ENDIF
C The fields rotloc(iatom)%a,b and c will now contain the parameters linked to
C the Euler angles of the local rotation rotloc.
IF(imu.gt.1) THEN
rotloc(iatom)%a=rotloc(iatomref)%a
rotloc(iatom)%b=rotloc(iatomref)%b
rotloc(iatom)%g=rotloc(iatomref)%g
rotloc(iatom)%iprop=rotloc(iatomref)%iprop
rotloc(iatom)%krotm(1:3,1:3)=
= rotloc(iatomref)%krotm(1:3,1:3)
ENDIF
C The fields rotloc%phase, timeinv and srotnum are initialized to their
C default value.
rotloc(iatom)%phase=0.d0
rotloc(iatom)%timeinv=.FALSE.
rotloc(iatom)%srotnum=0
C the field rotloc(iatom)%srotnum and timeinv will be recalculated in set_rotloc.
ENDDO
DEALLOCATE(tmp_dmat)
ENDDO ! End of the isrt loop
C
C
C ====================================================================
C Printing the rotloc matrix parameters in the file fort.17 for test :
C ====================================================================
DO isrt=1,nsort
IF (notinclude(isrt)) cycle
DO imu=1,nmult(isrt)
iatom=SUM(nmult(0:isrt-1))+imu
WRITE(17,'()')
WRITE(17,'(2(a,i3))')' SORT ',isrt,' IMU= ',imu
DO i=1,3
ALLOCATE(bufreal(3))
bufreal(1:3)=rotloc(iatom)%krotm(i,1:3)
WRITE(17,'(3f10.4)') bufreal
DEALLOCATE(bufreal)
ENDDO
WRITE(17,'(a,3f8.1,i4)')'a, b, g, iprop ==',
& rotloc(iatom)%a*180d0/Pi,rotloc(iatom)%b*180d0/Pi,
& rotloc(iatom)%g*180d0/Pi,rotloc(iatom)%iprop
C Printing the data relative to SP option
IF (ifSP) THEN
WRITE(17,*)'If DIR. magn. mom. is inverted :'
& ,rotloc(iatom)%timeinv
WRITE(17,*)'phase = ',rotloc(iatom)%phase
ENDIF
C Printing the rotloc matrices for each orbital number l.
WRITE(17,'()')
DO l=1,lsym
WRITE(17,'(a,a,i2)')'Rotation matrix ',
& 'D(R[isym])_{lm} for l = ',l
IF(ifSP.AND.ifSO) THEN
DO m=1,2*(2*l+1)
ALLOCATE(bufcomp(1:2*(2*l+1)))
bufcomp(1:2*(2*l+1))=rotloc(iatom)%rotl(m,1:2*(2*l+1),l)
WRITE(17,'(7(2f7.3,x))') bufcomp
DEALLOCATE(bufcomp)
ENDDO
ELSE
DO m=-l,l
ALLOCATE(bufcomp(-l:l))
bufcomp(-l:l)=rotloc(iatom)%rotl(m,-l:l,l)
WRITE(17,'(7(2f7.3,x))') bufcomp
DEALLOCATE(bufcomp)
ENDDO
ENDIF
ENDDO
ENDDO
ENDDO
C
C
C ==================================================================================
C Computation of the true local rotation matrices for each non representative atom :
C ==================================================================================
CALL set_rotloc
C
C
C ====================================================================
C Printing the rotloc matrix parameters in the file fort.17 for test :
C ====================================================================
DO isrt=1,nsort
IF (notinclude(isrt)) cycle
DO imu=1,nmult(isrt)
iatom=SUM(nmult(0:isrt-1))+imu
WRITE(17,'()')
WRITE(17,'(2(a,i3))')' SORT ',isrt,' IMU= ',imu
DO i=1,3
ALLOCATE(bufreal(3))
bufreal(1:3)=rotloc(iatom)%krotm(i,1:3)
WRITE(17,'(3f10.4)') bufreal
DEALLOCATE(bufreal)
ENDDO
WRITE(17,'(a,3f8.1,i4)')'a, b, g, iprop ==',
& rotloc(iatom)%a*180d0/Pi,rotloc(iatom)%b*180d0/Pi,
& rotloc(iatom)%g*180d0/Pi,rotloc(iatom)%iprop
C Printing the data relative to SP option
IF (ifSP) THEN
WRITE(17,*)'If DIR. magn. mom. is inverted :'
& ,rotloc(iatom)%timeinv
WRITE(17,*)'phase = ',rotloc(iatom)%phase
ENDIF
C Printing the rotloc matrices for each orbital number l.
WRITE(17,'()')
DO l=1,lsym
WRITE(17,'(a,a,i2)')'Rotation matrix ',
& 'D(R[isym])_{lm} for l = ',l
IF(ifSP.AND.ifSO) THEN
DO m=1,2*(2*l+1)
ALLOCATE(bufcomp(1:2*(2*l+1)))
bufcomp(1:2*(2*l+1))=rotloc(iatom)%rotl(m,1:2*(2*l+1),l)
WRITE(17,'(7(2f7.3,x))') bufcomp
DEALLOCATE(bufcomp)
ENDDO
ELSE
DO m=-l,l
ALLOCATE(bufcomp(-l:l))
bufcomp(-l:l)=rotloc(iatom)%rotl(m,-l:l,l)
WRITE(17,'(7(2f7.3,x))') bufcomp
DEALLOCATE(bufcomp)
ENDDO
ENDIF
ENDDO
C Printing the matrices rotrep(l)%mat
WRITE(17,'()')
DO l=1,lsym
IF (lsort(l,isrt)==0) cycle
WRITE(17,'(a,i2)')'Representation for l= ',l
IF (ifSP.AND.ifSO) THEN
DO m=1,2*(2*l+1)
ALLOCATE(bufcomp(1:2*(2*l+1)))
bufcomp(1:2*(2*l+1))=
& rotloc(iatom)%rotrep(l)%mat(m,1:2*(2*l+1))
WRITE(17,'(7(2f7.3,x))') bufcomp
DEALLOCATE(bufcomp)
ENDDO
ELSE
DO m=-l,l
ALLOCATE(bufcomp(-l:l))
bufcomp(-l:l)=
& rotloc(iatom)%rotrep(l)%mat(m,-l:l)
WRITE(17,'(7(2f7.3,x))') bufcomp
DEALLOCATE(bufcomp)
ENDDO
ENDIF
ENDDO
ENDDO
ENDDO
C
RETURN
END
Subroutine dmat(l,a,b,c,det,DD,length)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine computes the inverse of the matrix of the %%
C %% representation of size (2*l+1) associated to the rotation %%
C %% described by (a,b,c) angles in Euler description and with %%
C %% determinant det. %%
C %% The obtained matrix is put in the variable DD. %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
IMPLICIT REAL*8 (A-H,O-Z)
INTEGER l,m,n,ifac,length
COMPLEX*16 izero,imag, dd
dimension DD(length,length)
imag=(0d0,1d0)
izero=(0d0,0d0)
pi=acos(-1d0)
do m=-l,l
do n=-l,l
call d_matrix(l,m,n,b,dm)
if (det.lt.-0.5) then
dd(l+m+1,n+l+1)=(-1)**l*cdexp(imag*n*a)
& *cdexp(imag*m*c)*dm
else
dd(l+m+1,n+l+1)=cdexp(imag*n*a)
& *cdexp(imag*m*c)*dm
end if
3 format(2I3,2f10.6)
end do
end do
do j=1,2*l+1
end do
5 format(7(2f6.3,1X))
end
Subroutine d_matrix(l,m,n,b,dm)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine is called by the subroutine dmat to compute the %%
C %% the value of the coefficient dm. %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
IMPLICIT REAL*8 (A-H,O-Z)
INTEGER l,m,n,t
sum=0d0
f1=dfloat(ifac(l+m)*ifac(l-m))/
& dfloat(ifac(l+n)*ifac(l-n))
do t=0,2*l
if ((l-m-t).ge.0.AND.(l-n-t).ge.0.AND.(t+n+m).ge.0) then
C general factor
f2=dfloat(ifac(l+n)*ifac(l-n))/dfloat(ifac(l-m-t)
& *ifac(m+n+t)*ifac(l-n-t)*ifac(t))
C factor with sin(b/2)
if ((2*l-m-n-2*t).eq.0) then
f3=1.
else
f3=(sin(b/2))**(2*l-m-n-2*t)
end if
C factor with cos(b/2)
if ((2*t+n+m).eq.0) then
f4=1.
else
f4=(cos(b/2))**(2*t+n+m)
end if
! write(12,*)f1,f2,f3,f4
sum=sum+(-1)**(l-m-t)*f2*f3*f4
end if
end do
dm=sqrt(f1)*sum
end
Integer Function ifac(n)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine computes the factorial of the number n %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
if (n.eq.0) then
ifac=1
else
ifac=1
do j=1,n
ifac=ifac*j
end do
end if
end
SUBROUTINE spinrotmat(spinrot,isym,l)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine sets up the complete spinor rotation matrix %%
C %% associated to the symmetry operation isym for the orbital l. %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definition of the variables :
C -----------------------------
USE common_data
USE symm
IMPLICIT NONE
INTEGER :: l,isym
COMPLEX(KIND=8) :: ephase, det
REAL(KIND=8) :: factor
COMPLEX(KIND=8), DIMENSION(1:2*(2*l+1),1:2*(2*l+1)) :: spinrot
COMPLEX(KIND=8), DIMENSION(1:2,1:2) :: spmt
C
spinrot=0.d0
C For a computation with spin polarized inputs :
IF (ifSP) THEN
IF (srot(isym)%timeinv) THEN
C In this case, the Euler angle Beta is Pi. The spinor rotation matrix is block-antidiagonal and
C the time reversal operation will be applied to keep the direction of the magnetization.
C Up/dn block :
factor=srot(isym)%phase/2.d0
C We remind that the field phase is (g-a) in this case.
C as a result, ephase = exp(+i(g-a)/2) = -exp(+i(alpha-gamma)/2)
C in good agreement with Wien conventions for the definition of this phase factor.
ephase=EXP(CMPLX(0.d0,factor))
spinrot(1:2*l+1,2*l+2:2*(2*l+1))=
= ephase*srot(isym)%rotl(-l:l,-l:l,l)
C Dn/up block :
ephase=-CONJG(ephase)
C now, ephase = -exp(+i(a-g)/2) = exp(-i(alpha-gamma)/2)
spinrot(2*l+2:2*(2*l+1),1:2*l+1)=
= ephase*srot(isym)%rotl(-l:l,-l:l,l)
ELSE
C In this case, the Euler angle Beta is 0. The spinor rotation matrix is block-diagonal and
C no time reversal operation will be applied.
C Up/up block :
factor=srot(isym)%phase/2.d0
C We remind that the field phase is (a+g) in this case.
C as a result, ephase = exp(+i(a+g)/2)=-exp(-i(alpha+gamma)/2)
C in good agreement with Wien conventions for the definition of this phase factor.
ephase=EXP(CMPLX(0.d0,factor))
spinrot(1:2*l+1,1:2*l+1)=
= ephase*srot(isym)%rotl(-l:l,-l:l,l)
C Dn/dn block :
ephase=CONJG(ephase)
C now, ephase = exp(-i(a+g)/2) = -exp(+i(alpha+gamma)/2)
spinrot(2*l+2:2*(2*l+1),2*l+2:2*(2*l+1))=
= ephase*srot(isym)%rotl(-l:l,-l:l,l)
ENDIF
ELSE
C For a computation with paramagnetic treatment input files. (not used in this version)
C
C In this case, there is no restriction on the value of the Euler angle beta.
C The general definition of a spinor rotation matrix is used.
C
C Calculation of the representation matrix of isym in the spin-space
C in agreement with Wien conventions used for the definition of spmt (in SRC_lapwdm/sym.f)
C Up/up and Dn/dn terms
factor=(srot(isym)%a+srot(isym)%g)/2.d0
spmt(1,1)=EXP(CMPLX(0.d0,factor))*DCOS(srot(isym)%b/2.d0)
spmt(2,2)=CONJG(spmt(1,1))
C Up/dn and Dn/up terms
factor=-(srot(isym)%a-srot(isym)%g)/2.d0
spmt(1,2)=EXP(CMPLX(0.d0,factor))*DSIN(srot(isym)%b/2.d0)
spmt(2,1)=-CONJG(spmt(1,2))
C Up/up block :
spinrot(1:2*l+1,1:2*l+1)=
& spmt(1,1)*srot(isym)%rotl(-l:l,-l:l,l)
C Dn/dn block :
spinrot(2*l+2:2*(2*l+1),2*l+2:2*(2*l+1))=
& spmt(2,2)*srot(isym)%rotl(-l:l,-l:l,l)
C Up/dn block :
spinrot(1:2*l+1,2*l+2:2*(2*l+1))=
& spmt(1,2)*srot(isym)%rotl(-l:l,-l:l,l)
C Dn/up block :
spinrot(2*l+2:2*(2*l+1),1:2*l+1)=
& spmt(2,1)*srot(isym)%rotl(-l:l,-l:l,l)
ENDIF
C
RETURN
END

View File

@ -0,0 +1,292 @@
c ******************************************************************************
c
c TRIQS: a Toolbox for Research in Interacting Quantum Systems
c
c Copyright (C) 2011 by L. Pourovskii, V. Vildosola, C. Martins, M. Aichhorn
c
c TRIQS is free software: you can redistribute it and/or modify it under the
c terms of the GNU General Public License as published by the Free Software
c Foundation, either version 3 of the License, or (at your option) any later
c version.
c
c TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
c WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
c FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
c details.
c
c You should have received a copy of the GNU General Public License along with
c TRIQS. If not, see <http://www.gnu.org/licenses/>.
c
c *****************************************************************************/
SUBROUTINE symmetrize_mat(Dmat,orbit,norbit)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine applies the symmetry operations to the %%
C %% density matrices stored in Dmat and puts the resulting %%
C %% density matrices into the local coordinate system. %%
C %% %%
C %% This version can be used for SO computations. %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definition of the variables :
C ----------------------------
USE common_data
USE projections
USE symm
USE reps
IMPLICIT NONE
INTEGER :: norbit
TYPE(matrix), DIMENSION(nsp,norbit) :: Dmat
COMPLEX(KIND=8),DIMENSION(:,:,:,:), ALLOCATABLE :: sym_dmat
COMPLEX(KIND=8),DIMENSION(:,:), ALLOCATABLE :: tmp_mat
COMPLEX(KIND=8):: ephase
TYPE(orbital), DIMENSION(norbit) :: orbit
INTEGER :: isym, iorb, iatom, jorb, is, is1, l, i, m
INTEGER :: isrt, jatom, imult, asym
C
C =========================================
C Computation of the symmetrized matrices :
C =========================================
C
iorb=1
C Initialization of the iorb index.
DO WHILE (iorb.lt.(norbit+1))
C The use of the while-loop was motivated by the idea of studying
C all the orbitals iorb associated to a same atomic sort isrt together.
C At the end, the index iorb is incremented by nmult(isrt) so that the
C following studied orbitals are associated to another atomic sort.
l=orbit(iorb)%l
isrt=orbit(iorb)%sort
C
C -----------------------------------------------------------------------------------
C The s-orbitals are a particular case of a "non-mixing" basis and are treated here :
C -----------------------------------------------------------------------------------
IF (l==0) THEN
C The table sym_dmat will store the symmetrized value of the density matrices of Dmat
C associated to a same atomic sort isrt.
ALLOCATE(sym_dmat(1,1,nsp,1:nmult(isrt)))
sym_dmat=0.d0
C Its size is nmult(isrt) because symmetry operations can transform the representants
C of a same atomic sort one into another.
C
C Loop on the representants of the atomic sort isrt
DO imult=0,nmult(isrt)-1
iatom=orbit(iorb+imult)%atom
C Loop on the symmetry operations of the system
DO isym=1,nsym
DO is=1,nsp
ALLOCATE(tmp_mat(1,1))
C If the calculation uses spin-polarized input files, the application of the symmetry operation
C depends on the field srot%timeinv.
IF(ifSP.AND.srot(isym)%timeinv) THEN
C In this case (spin-polarized computation), the symmetry operation is block-diagonal in spin-space but
C the time reversal operator is included.
tmp_mat(1,1)=CONJG(Dmat(is,iorb+imult)%mat(1,1))
C because of the antiunitarity of the operator, the conjugate of Dmat must be use
ELSE
tmp_mat(1,1)=Dmat(is,iorb+imult)%mat(1,1)
ENDIF
C
C Definition of the index where the transformed Dmat will be stored. [jorb = R[isym](iorb)]
jorb=srot(isym)%perm(iatom)-iatom+(imult+1)
C
C Computation of the phase factors in the case of a SO computation :
C ------------------------------------------------------------------
C For up/up and dn/dn blocks, no phase factor is needed.
ephase=1.d0
C For the up/dn block, initialisation of the phase factor
IF(is==3) THEN
ephase=EXP(CMPLX(0d0,srot(isym)%phase))
C if srot%timeinv = .TRUE. , phase= g-a = 2pi+(alpha-gamma) and ephase = exp(+i(g-a)) = exp(+i(alpha-gamma))
C if srot%timeinv = .FALSE., phase= a+g = 2pi-(alpha+gamma) and ephase = exp(+i(a+g)) = exp(-i(alpha+gamma))
ENDIF
C For the dn/up block, initialisation of the phase factor
IF(is==4) THEN
ephase=EXP(CMPLX(0d0,-srot(isym)%phase))
C if srot%timeinv = .TRUE. , phase= g-a = 2pi+(alpha-gamma) and ephase = exp(-i(g-a)) = exp(-i(alpha-gamma))
C if srot%timeinv = .FALSE., phase= a+g = 2pi-(alpha+gamma) and ephase = exp(-i(a+g)) = exp(+i(alpha+gamma))
ENDIF
C
C Application of the symmetry operation which changes iorb in jorb=R[isym](iorb) :
C --------------------------------------------------------------------------------
C That's why the result is stored in the jorb section of sym_dmat.
sym_dmat(1,1,is,jorb)=
= sym_dmat(1,1,is,jorb)+tmp_mat(1,1)*ephase
DEALLOCATE(tmp_mat)
ENDDO ! End of the is loop
ENDDO ! End of the isym loop
ENDDO ! End of the imult loop
C
C Renormalization of the symmetrized density matrices :
C -----------------------------------------------------
IF (nsym.gt.0) THEN
DO imult=0,nmult(isrt)-1
DO is=1,nsp
Dmat(is,iorb+imult)%mat(1,1)=
& sym_dmat(1,1,is,imult+1)/nsym
ENDDO
ENDDO
ENDIF
DEALLOCATE(sym_dmat)
C Incrementation of the iorb index (for the while loop)
iorb=iorb+nmult(isrt)
C
C -----------------------------------------------------------------------------------------------------
C If the basis representation needs a complete spinor rotation approach (matrices of size 2*(2*l+1) ) :
C -----------------------------------------------------------------------------------------------------
ELSEIF (reptrans(l,isrt)%ifmixing) THEN
C The table sym_dmat will store the symmetrized value of the density matrices of Dmat
C associated to a same atomic sort isrt.
ALLOCATE(sym_dmat(1:2*(2*l+1),1:2*(2*l+1),1,1:nmult(isrt)))
sym_dmat=0.d0
C Its size is nmult(isrt) because symmetry operations can transform the representants
C of a same atomic sort one into another.
C
C Loop on the representants of the atomic sort isrt
DO imult=0,nmult(isrt)-1
iatom=orbit(iorb+imult)%atom
C Loop on the symmetry operations of the system
DO isym=1,nsym
ALLOCATE(tmp_mat(1:2*(2*l+1),1:2*(2*l+1)))
C We use the complete spin-space representation, so no trick on indices is necessary.
tmp_mat(1:2*(2*l+1),1:2*(2*l+1))=
& Dmat(1,iorb+imult)%mat(1:2*(2*l+1),1:2*(2*l+1))
C If the calculation is spin-polarized, the symmetry operator is antiunitary.
IF(ifSP.AND.srot(isym)%timeinv) THEN
tmp_mat(1:2*(2*l+1),1:2*(2*l+1))=
& CONJG(tmp_mat(1:2*(2*l+1),1:2*(2*l+1)))
ENDIF
C Definition of the index where the transformed Dmat will be stored. [jorb = R[isym](iorb)]
jorb=srot(isym)%perm(iatom)-iatom+(imult+1)
C Application of the symmetry operation :
C ---------------------------------------
C The transformation is : srot%rotrep.tmpmat(iorb).inverse(sort%rotrep) = Dmat(jorb)
C or in other words, if R is a simple symmetry D(R[isym]) tmpmat(iorb) D(inverse(R[isym])) = Dmat(R[isym](iorb))
C if R is multiplied by Theta D(R[isym]) tmpmat(iorb)* D(inverse(R[isym]))* = Dmat(R[isym](iorb))
tmp_mat(1:2*(2*l+1),1:2*(2*l+1))=
= MATMUL(tmp_mat(1:2*(2*l+1),1:2*(2*l+1)),
& TRANSPOSE(CONJG(srot(isym)%rotrep(l,isrt)
% %mat(1:2*(2*l+1),1:2*(2*l+1)) )) )
sym_dmat(1:2*(2*l+1),1:2*(2*l+1),1,jorb)=
= sym_dmat(1:2*(2*l+1),1:2*(2*l+1),1,jorb)+
+ MATMUL( srot(isym)%rotrep(l,isrt)
% %mat(1:2*(2*l+1),1:2*(2*l+1)) ,
& tmp_mat(1:2*(2*l+1),1:2*(2*l+1)))
DEALLOCATE(tmp_mat)
ENDDO ! End of the isym loop
ENDDO ! End of the imult loop
C Renormalization of the symmetrized density matrices :
C -----------------------------------------------------
IF (nsym.gt.0) THEN
DO imult=0,nmult(isrt)-1
Dmat(1,iorb+imult)%mat(1:2*(2*l+1),1:2*(2*l+1))=
= sym_dmat(1:2*(2*l+1),1:2*(2*l+1),1,imult+1)/nsym
ENDDO
ENDIF
DEALLOCATE(sym_dmat)
C Incrementation of the iorb index (for the while loop)
iorb=iorb+nmult(isrt)
C
C ----------------------------------------------------------------------------------------------
C If the basis representation can be reduce to the up/up block (matrices of size (2*l+1) only) :
C ----------------------------------------------------------------------------------------------
ELSE
C The table sym_dmat will store the symmetrized value of the density matrices of Dmat
C associated to a same atomic sort isrt.
ALLOCATE(sym_dmat(-l:l,-l:l,nsp,1:nmult(isrt)))
sym_dmat=0.d0
C Its size is nmult(isrt) because symmetry operations can transform the representants
C of a same atomic sort one into another.
C
C Loop on the representants of the atomic sort isrt
DO imult=0,nmult(isrt)-1
iatom=orbit(iorb+imult)%atom
C Loop on the symmetry operations of the system
asym=0
DO isym=1,nsym
DO is=1,nsp
ALLOCATE(tmp_mat(-l:l,-l:l))
C If the calculation uses spin-polarized input files, the application of the symmetry operation
C depends on the field srot%timeinv.
IF(ifSP.AND.srot(isym)%timeinv) THEN
C In this case (spin-polarized computation), the symmetry operation is block-diagonal in spin-space but
C the time reversal operatot is included.
tmp_mat(-l:l,-l:l)=CONJG(
& Dmat(is,iorb+imult)%mat(-l:l,-l:l))
C because of antiunitarity of the operator, the conjugate of Dmat must be use
ELSE
tmp_mat(-l:l,-l:l)=
& Dmat(is,iorb+imult)%mat(-l:l,-l:l)
ENDIF
C
C Definition of the index where the transformed Dmat will be stored. [jorb = R[isym](iorb)]
jorb=srot(isym)%perm(iatom)-iatom+(imult+1)
C
C Computation of the phase factors in the case of a SO computation :
C ------------------------------------------------------------------
C For up/up and dn/dn blocks, no phase factor is needed.
ephase=1.d0
C For the up/dn block, initialisation of the phase factor
IF(is==3) THEN
ephase=EXP(CMPLX(0d0,srot(isym)%phase))
C if srot%timeinv = .TRUE. , phase= g-a = 2pi+(alpha-gamma) and ephase = exp(+i(g-a)) = exp(+i(alpha-gamma))
C if srot%timeinv = .FALSE., phase= a+g = 2pi-(alpha+gamma) and ephase = exp(+i(a+g)) = exp(-i(alpha+gamma))
ENDIF
C For the dn/up block, initialisation of the phase factor
IF(is==4) THEN
ephase=EXP(CMPLX(0d0,-srot(isym)%phase))
C if srot%timeinv = .TRUE. , phase= g-a = 2pi+(alpha-gamma) and ephase = exp(-i(g-a)) = exp(-i(alpha-gamma))
C if srot%timeinv = .FALSE., phase= a+g = 2pi-(alpha+gamma) and ephase = exp(-i(a+g)) = exp(+i(alpha+gamma))
ENDIF
C
C Application of the symmetry operation which changes iorb in jorb :
C ------------------------------------------------------------------
C The transformation is : srot%rotrep.tmpmat(iorb).inverse(sort%rotrep) = Dmat(jorb)
C or in other words, if R is a simple symmetry D(R[isym]) tmpmat(iorb) D(inverse(R[isym])) = Dmat(R[isym](iorb))
C if R is multiplied by T D(R[isym]) tmpmat(iorb)* D(inverse(R[isym]))* = Dmat(R[isym](iorb))
tmp_mat(-l:l,-l:l)=
= MATMUL(tmp_mat(-l:l,-l:l),
& TRANSPOSE(CONJG( srot(isym)
& %rotrep(l,isrt)%mat(-l:l,-l:l) )) )
sym_dmat(-l:l,-l:l,is,jorb)=
= sym_dmat(-l:l,-l:l,is,jorb)+
+ MATMUL(srot(isym)%rotrep(l,isrt)%mat(-l:l,-l:l),
& tmp_mat(-l:l,-l:l) )*ephase
DEALLOCATE(tmp_mat)
ENDDO ! End of the is loop
ENDDO ! End of the isym loop
ENDDO ! End of the imult loop
C
C Renormalization of the symmetrized density matrices :
C -----------------------------------------------------
IF (nsym.gt.0) THEN
DO imult=0,nmult(isrt)-1
DO is=1,nsp
Dmat(is,iorb+imult)%mat(-l:l,-l:l)=
= sym_dmat(-l:l,-l:l,is,imult+1)/(nsym-asym)
ENDDO
ENDDO
ENDIF
DEALLOCATE(sym_dmat)
C Incrementation of the iorb index (for the while loop)
iorb=iorb+nmult(isrt)
ENDIF ! End of the type basis if-then-else
C
ENDDO ! End of the while(iorb) loop
C
C
C =============================================================
C Application of the time reversal operation if paramagnetism :
C =============================================================
C If the system is paramagnetic, the magnetic group of the system
C is a type II Shubnikov group and time-reveral symmetry must be added
C to achieve the complete symmetrization.
IF (.not.ifSP) THEN
CALL add_timeinv(Dmat,orbit,norbit)
END IF
C
RETURN
END

289
fortran/dmftproj/timeinv.f Normal file
View File

@ -0,0 +1,289 @@
c ******************************************************************************
c
c TRIQS: a Toolbox for Research in Interacting Quantum Systems
c
c Copyright (C) 2011 by L. Pourovskii, V. Vildosola, C. Martins, M. Aichhorn
c
c TRIQS is free software: you can redistribute it and/or modify it under the
c terms of the GNU General Public License as published by the Free Software
c Foundation, either version 3 of the License, or (at your option) any later
c version.
c
c TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
c WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
c FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
c details.
c
c You should have received a copy of the GNU General Public License along with
c TRIQS. If not, see <http://www.gnu.org/licenses/>.
c
c *****************************************************************************/
SUBROUTINE timeinv_op(mat,lm,l,isrt)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine applies the time reversal operation to the %%
C %% matrix mat which is associated to the l orbital of the atomic %%
C %% isrt. (matrix size = lm) The matrix mat is assumed to already %%
C %% be in the desired basis associated to isrt. %%
C %% The calculation done is : %%
C %% reptrans*T*conjg((inv(reptrans))*conjg(mat) %%
C %% %%
C %% If isrt=0, the matrix mat is assumed to be in the spherical %%
C %% harmonics basis and no spin is considered. (lm = 2*l+1) %%
C %% The calculation done is then : T*conjg(mat) %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE common_data
USE reps
IMPLICIT NONE
INTEGER :: lm,l,isrt
COMPLEX(KIND=8), DIMENSION(1:lm,1:lm) :: mat
COMPLEX(KIND=8), DIMENSION(:,:), ALLOCATABLE :: tinv
COMPLEX(KIND=8), DIMENSION(:,:), ALLOCATABLE :: tmp_tinv
COMPLEX(KIND=8), DIMENSION(-l:l,-l:l) :: tmat
INTEGER :: m,n
C
C Definition of the complex conjugation operator in the spherical harmonic basis :
C --------------------------------------------------------------------------------
C
tmat = CMPLX(0.d0,0.d0)
DO m=-l,l
tmat(m,-m)=(-1)**m
END DO
C
C
C Calculation of the Time-reversal operator in the desired representation basis :
C -------------------------------------------------------------------------------
C
IF (isrt==0) THEN
C The case isrt=0 is a "default case" :
C mat is in the spherical harmonic basis (without spinor representation)
ALLOCATE(tinv(1:2*l+1,1:2*l+1))
tinv(1:2*l+1,1:2*l+1)=tmat(-l:l,-l:l)
ELSE
C If the basis representation needs a complete spinor rotation approach (matrices of size 2*(2*l+1) )
IF (reptrans(l,isrt)%ifmixing) THEN
ALLOCATE(tinv(1:2*(2*l+1),1:2*(2*l+1)))
ALLOCATE(tmp_tinv(1:2*(2*l+1),1:2*(2*l+1)))
tinv = CMPLX(0.d0,0.d0)
tmp_tinv = CMPLX(0.d0,0.d0)
C Definition of the time-reversal operator as a spinor-operator (multiplication by -i.sigma_y)
tinv(1:2*l+1,2*l+2:2*(2*l+1))=-tmat(-l:l,-l:l)
tinv(2*l+2:2*(2*l+1),1:2*l+1)=tmat(-l:l,-l:l)
C The time reversal operator is put in the desired basis.
tmp_tinv(1:2*(2*l+1),1:2*(2*l+1))=MATMUL(
& reptrans(l,isrt)%transmat(1:2*(2*l+1),1:2*(2*l+1)),
& tinv(1:2*(2*l+1),1:2*(2*l+1)))
tinv(1:2*(2*l+1),1:2*(2*l+1))=MATMUL(
& tmp_tinv(1:2*(2*l+1),1:2*(2*l+1)),
& TRANSPOSE(reptrans(l,isrt)%transmat
& (1:2*(2*l+1),1:2*(2*l+1)) ) )
C the result tinv = (reptrans)*tinv*transpose(reptrans)
C or tinv_{new_i} = <new_i|lm> tinv_{lm} (<lm|new_i>)*
C which is exactly the expression of the spinor operator in the new basis.
DEALLOCATE(tmp_tinv)
C If the basis representation can be reduce to the up/up block (matrices of size (2*l+1) only)
ELSE
ALLOCATE(tinv(1:2*l+1,1:2*l+1))
ALLOCATE(tmp_tinv(-l:l,-l:l))
tinv = CMPLX(0.d0,0.d0)
tmp_tinv = CMPLX(0.d0,0.d0)
C The time reversal operator is put in the desired basis.
tmp_tinv(-l:l,-l:l)=MATMUL(
& reptrans(l,isrt)%transmat(-l:l,-l:l),
& tmat(-l:l,-l:l) )
tinv(1:2*l+1,1:2*l+1)=MATMUL(
& tmp_tinv(-l:l,-l:l),TRANSPOSE(
& reptrans(l,isrt)%transmat(-l:l,-l:l)) )
DEALLOCATE(tmp_tinv)
END IF
C the result tinv = (reptrans)*tinv*transpose(reptrans)
C or tinv_{new_i} = <new_i|lm> tinv_{lm} (<lm|new_i>)*
C which is exactly the expression of the operator in the new basis.
END IF
C
C
C Multiplication of the matrix mat by the time reversal operator :
C ----------------------------------------------------------------
C
mat(1:lm,1:lm) = MATMUL(
& tinv(1:lm,1:lm),CONJG(mat(1:lm,1:lm)) )
DEALLOCATE(tinv)
C The multiplication is the product of tinv and (mat)*
C
RETURN
END
SUBROUTINE add_timeinv(Dmat,orbit,norbit)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine calculates for each density matrix in Dmat %%
C %% its image by the time-reversal operator and adds it to the %%
C %% former one to get a time-symmetrized result. %%
C %% %%
C %% This operation is done only if the computation is paramagnetic %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE common_data
USE projections
USE symm
USE reps
IMPLICIT NONE
INTEGER :: norbit
TYPE(matrix), DIMENSION(nsp,norbit) :: Dmat
COMPLEX(KIND=8),DIMENSION(:,:,:), ALLOCATABLE :: rot_dmat
COMPLEX(KIND=8),DIMENSION(:,:), ALLOCATABLE :: time_op
COMPLEX(KIND=8),DIMENSION(:,:,:), ALLOCATABLE :: tmp_mat
COMPLEX(KIND=8):: ephase
TYPE(orbital), DIMENSION(norbit) :: orbit
INTEGER :: isym, iorb, iatom, jorb, is, is1, l, i
INTEGER :: isrt, jatom, imult, m
C
C
DO iorb=1,norbit
l=orbit(iorb)%l
isrt=orbit(iorb)%sort
iatom=orbit(iorb)%atom
C -----------------------------------------------------------------------------------
C The s-orbitals are a particular case of a "non-mixing" basis and are treated here :
C -----------------------------------------------------------------------------------
IF(l==0) THEN
IF (nsp==1) THEN
Dmat(1,iorb)%mat(1,1) =
& ( Dmat(1,iorb)%mat(1,1)+
& CONJG(Dmat(1,iorb)%mat(1,1)) )/2.d0
ELSE
ALLOCATE(tmp_mat(1,1,nsp))
tmp_mat=0.d0
C Application of the time-reversal operation
C ------------------------------------------
DO is=1,nsp
is1=is+(-1)**(is+1)
C the time reversal operation transforms up/up -1- in dn/dn -2- and up/dn -3- in dn/up -4- (and vice versa)
tmp_mat(1,1,is)=CONJG(Dmat(is1,iorb)%mat(1,1) )
IF (is.gt.2) tmp_mat(1,1,is)=-tmp_mat(1,1,is)
C Off diagonal blocks are multiplied by (-1).
ENDDO
C Symmetrization of Dmat :
C ------------------------
DO is=1,nsp
Dmat(is,iorb)%mat(1,1) = (Dmat(is,iorb)%mat(1,1)+
& tmp_mat(1,1,is) )/2.d0
ENDDO
DEALLOCATE(tmp_mat)
ENDIF
C -----------------------------------------------------------------------------------------------------
C If the basis representation needs a complete spinor rotation approach (matrices of size 2*(2*l+1) ) :
C -----------------------------------------------------------------------------------------------------
ELSEIF (reptrans(l,isrt)%ifmixing) THEN
C Calculation of the time-reversal operator :
C -------------------------------------------
ALLOCATE(time_op(1:2*(2*l+1),1:2*(2*l+1)))
time_op(:,:)=0.d0
DO m=1,2*(2*l+1)
time_op(m,m)=1.d0
ENDDO
C time_op is Identity.
CALL timeinv_op(time_op,2*(2*l+1),l,isrt)
C time_op is now the time-reversal operator in the desired basis ({new_i})
C
C Application of the time-reversal operation
C ------------------------------------------
ALLOCATE(tmp_mat(1:2*(2*l+1),1:2*(2*l+1),1))
tmp_mat(1:2*(2*l+1),1:2*(2*l+1),1)=
= MATMUL(Dmat(1,iorb)%mat(1:2*(2*l+1),1:2*(2*l+1)),
& TRANSPOSE(time_op(1:2*(2*l+1),1:2*(2*l+1)) ) )
tmp_mat(1:2*(2*l+1),1:2*(2*l+1),1)=
= MATMUL(time_op(1:2*(2*l+1),1:2*(2*l+1)),
& CONJG(tmp_mat(1:2*(2*l+1),1:2*(2*l+1),1) ) )
C The operation performed is : time_op.conjugate(Dmat).transpose(conjugate(time_op))
C or in other words, D(T)_{new_i} . Dmat* . D(inverse(T))*_{new_i}
C
C Symmetrization of Dmat :
C ------------------------
Dmat(1,iorb)%mat(1:2*(2*l+1),1:2*(2*l+1)) =
& ( Dmat(1,iorb)%mat(1:2*(2*l+1),1:2*(2*l+1)) +
& tmp_mat(1:2*(2*l+1),1:2*(2*l+1),1) )/2.d0
DEALLOCATE(tmp_mat)
DEALLOCATE(time_op)
C ----------------------------------------------------------------------------------------------
C If the basis representation can be reduce to the up/up block (matrices of size (2*l+1) only) :
C ----------------------------------------------------------------------------------------------
ELSE
C Calculation of the time-reversal operator :
C -------------------------------------------
ALLOCATE(time_op(-l:l,-l:l))
time_op(:,:)=0.d0
DO m=-l,l
time_op(m,m)=1.d0
ENDDO
C time_op is Identity.
CALL timeinv_op(time_op,(2*l+1),l,isrt)
C time_op is now the time-reversal operator in the desired basis ({new_i})
C
IF (nsp==1) THEN
C Application of the time-reversal operation and symmetrization :
C ---------------------------------------------------------------
ALLOCATE(tmp_mat(-l:l,-l:l,1))
tmp_mat(-l:l,-l:l,1)=
= MATMUL( Dmat(1,iorb)%mat(-l:l,-l:l),
& TRANSPOSE(time_op(-l:l,-l:l) ) )
tmp_mat(-l:l,-l:l,1)=
= MATMUL(time_op(-l:l,-l:l),
& CONJG(tmp_mat(-l:l,-l:l,1)) )
C The operation performed is : time_op.conjugate(Dmat).transpose(conjugate(time_op))
C or in other words, D(T)_{new_i} . Dmat* . D(inverse(T))*_{new_i}
Dmat(1,iorb)%mat(-l:l,-l:l) =
& ( Dmat(1,iorb)%mat(-l:l,-l:l) +
& tmp_mat(-l:l,-l:l,1) )/2.d0
DEALLOCATE(tmp_mat)
ELSE
C Application of the time-reversal operation
C ------------------------------------------
ALLOCATE(tmp_mat(-l:l,-l:l,nsp))
DO is=1,nsp
is1=is+(-1)**(is+1)
C the time reversal operation transforms up/up -1- in dn/dn -2- and up/dn -3- in dn/up -4 (and vice versa)
tmp_mat(-l:l,-l:l,is)=
= MATMUL( Dmat(is1,iorb)%mat(-l:l,-l:l),
& TRANSPOSE( time_op(-l:l,-l:l) ) )
tmp_mat(-l:l,-l:l,is)=
= MATMUL( time_op(-l:l,-l:l),
& CONJG( tmp_mat(-l:l,-l:l,is) ) )
C The operation performed is : time_op.conjugate(Dmat).transpose(conjugate(time_op))
C or in other words, D(T)_{new_i} . Dmat* . D(inverse(T))*_{new_i}
IF (is.gt.2) THEN
tmp_mat(-l:l,-l:l,is)=-tmp_mat(-l:l,-l:l,is)
ENDIF
C Off diagonal terms are multiplied by (-1).
ENDDO
C Symmetrization of Dmat :
C ------------------------
DO is=1,nsp
Dmat(is,iorb)%mat(-l:l,-l:l) =
& (Dmat(is,iorb)%mat(-l:l,-l:l)+
& tmp_mat(-l:l,-l:l,is) )/2.d0
ENDDO
DEALLOCATE(tmp_mat)
ENDIF
DEALLOCATE(time_op)
C
ENDIF ! End of the type basis if-then-else
ENDDO ! End of the iorb loop
C
RETURN
END

18
python/CMakeLists.txt Normal file
View File

@ -0,0 +1,18 @@
triqs_make_target_to_copy_all_py_files_from_python_dir_to_build_dir()
execute_process(COMMAND ln -fs ${CMAKE_BINARY_DIR}/fortran/F90/vertex.so ${CMAKE_CURRENT_BINARY_DIR} )
add_subdirectory(converters)
#installation
SET(PYTHON_SOURCES
${CMAKE_CURRENT_SOURCE_DIR}/__init__.py
${CMAKE_CURRENT_SOURCE_DIR}/solver_multiband.py
${CMAKE_CURRENT_SOURCE_DIR}/sumk_lda.py
${CMAKE_CURRENT_SOURCE_DIR}/sumk_lda_tools.py
${CMAKE_CURRENT_SOURCE_DIR}/symmetry.py
${CMAKE_CURRENT_SOURCE_DIR}/U_matrix.py
)
install (FILES ${PYTHON_SOURCES} DESTINATION ${TRIQS_PYTHON_LIB_DEST}/applications/dft)

100
python/U_matrix.py Normal file
View File

@ -0,0 +1,100 @@
################################################################################
#
# TRIQS: a Toolbox for Research in Interacting Quantum Systems
#
# Copyright (C) 2011 by M. Aichhorn, L. Pourovskii, V. Vildosola
#
# TRIQS is free software: you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.
#
# TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# TRIQS. If not, see <http://www.gnu.org/licenses/>.
#
################################################################################
# calculates the four index U matrix
import numpy
from types import *
from math import sqrt
import copy
from vertex import u4ind
#from pytriqs.applications.dft.vertex import u4ind
class Umatrix:
"""calculates, stores, and manipulates the four index U matrix"""
def __init__(self, l, U_interact=0, J_hund=0):
self.l = l
self.U_av = U_interact
self.J = J_hund
self.N = 2*l+1 # multiplicity
#self.Ucmplx = numpy.zeros([self.N,self.N,self.N,self.N],numpy.float_)
#self.Ucubic = numpy.zeros([self.N,self.N,self.N,self.N],numpy.float_)
def __call__(self, T = None, rcl = None):
"""calculates the four index matrix. Slater parameters can be provided in rcl,
and a transformation matrix from complex harmonics to a specified other representation (e.g. cubic).
If T is not given, use standard complex harmonics."""
if rcl is None: rcl = self.get_rcl(self.U_av,self.J,self.l)
if (T is None):
TM = numpy.identity(self.N,numpy.complex_)
else:
TM = T
self.Nmat = len(TM)
self.Ufull = u4ind(rcl,TM)
def reduce_matrix(self):
"""Reduces the four-index matrix to two-index matrices."""
if (self.N==self.Nmat):
self.U = numpy.zeros([self.N,self.N],numpy.float_) # matrix for same spin
self.Up = numpy.zeros([self.N,self.N],numpy.float_) # matrix for opposite spin
for m in range(self.N):
for mp in range(self.N):
self.U[m,mp] = self.Ufull[m,mp,m,mp].real - self.Ufull[m,mp,mp,m].real
self.Up[m,mp] = self.Ufull[m,mp,m,mp].real
else:
self.U = numpy.zeros([self.Nmat,self.Nmat],numpy.float_) # matrix
for m in range(self.Nmat):
for mp in range(self.Nmat):
self.U[m,mp] = self.Ufull[m,mp,m,mp].real - self.Ufull[m,mp,mp,m].real
def get_rcl(self, U_int, J_hund, l):
#rcl = numpy.array([0.0, 0.0, 0.0, 0.0],numpy.float_)
xx = l+1
rcl = numpy.zeros([xx],numpy.float_)
if(l==2):
rcl[0] = U_int
rcl[1] = J_hund * 14.0 / (1.0 + 0.63)
rcl[2] = 0.630 * rcl[1]
elif(l==3):
rcl[0] = U_int
rcl[1] = 6435.0 * J_hund / (286.0 + 195.0 * 451.0 / 675.0 + 250.0 * 1001.0 / 2025.0)
rcl[2] = 451.0 * rcl[1] / 675.0
rcl[3] = 1001.0 * rcl[1] / 2025.0
return rcl

31
python/__init__.py Normal file
View File

@ -0,0 +1,31 @@
################################################################################
#
# TRIQS: a Toolbox for Research in Interacting Quantum Systems
#
# Copyright (C) 2011 by M. Aichhorn, L. Pourovskii, V. Vildosola
#
# TRIQS is free software: you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.
#
# TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# TRIQS. If not, see <http://www.gnu.org/licenses/>.
#
################################################################################
from sumk_lda import SumkLDA
from symmetry import Symmetry
from sumk_lda_tools import SumkLDATools
from U_matrix import Umatrix
from converters import *
__all__ =['SumkLDA','Symmetry','SumkLDATools','Umatrix','Wien2kConverter']

View File

@ -0,0 +1,6 @@
SET(PYTHON_SOURCES
${CMAKE_CURRENT_SOURCE_DIR}/__init__.py
${CMAKE_CURRENT_SOURCE_DIR}/wien2k_converter.py
)
install (FILES ${PYTHON_SOURCES} DESTINATION ${TRIQS_PYTHON_LIB_DEST}/applications/dft/converters)

View File

@ -0,0 +1,27 @@
################################################################################
#
# TRIQS: a Toolbox for Research in Interacting Quantum Systems
#
# Copyright (C) 2011 by M. Aichhorn, L. Pourovskii, V. Vildosola
#
# TRIQS is free software: you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.
#
# TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# TRIQS. If not, see <http://www.gnu.org/licenses/>.
#
################################################################################
from wien2k_converter import Wien2kConverter
__all__ =['Wien2kConverter']

View File

@ -0,0 +1,581 @@
################################################################################
#
# TRIQS: a Toolbox for Research in Interacting Quantum Systems
#
# Copyright (C) 2011 by M. Aichhorn, L. Pourovskii, V. Vildosola
#
# TRIQS is free software: you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.
#
# TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# TRIQS. If not, see <http://www.gnu.org/licenses/>.
#
################################################################################
from types import *
import numpy
from pytriqs.archive import *
import pytriqs.utility.mpi as mpi
import string
def read_fortran_file (filename):
""" Returns a generator that yields all numbers in the Fortran file as float, one by one"""
import os.path
if not(os.path.exists(filename)) : raise IOError, "File %s does not exists"%filename
for line in open(filename,'r') :
for x in line.replace('D','E').split() :
yield string.atof(x)
class Wien2kConverter:
"""
Conversion from Wien2k output to an hdf5 file, that can be used as input for the SumkLDA class.
"""
def __init__(self, filename, lda_subgrp = 'SumK_LDA', symm_subgrp = 'SymmCorr', repacking = False):
"""
Init of the class. Variable filename gives the root of all filenames, e.g. case.ctqmcout, case.h5, and so
on.
"""
assert type(filename)==StringType,"LDA_file must be a filename"
self.hdf_file = filename+'.h5'
self.lda_file = filename+'.ctqmcout'
self.symm_file = filename+'.symqmc'
self.parproj_file = filename+'.parproj'
self.symmpar_file = filename+'.sympar'
self.band_file = filename+'.outband'
self.lda_subgrp = lda_subgrp
self.symm_subgrp = symm_subgrp
# Checks if h5 file is there and repacks it if wanted:
import os.path
if (os.path.exists(self.hdf_file) and repacking):
self.__repack()
def convert_dmft_input(self):
"""
Reads the input files, and stores the data in the HDFfile
"""
if not (mpi.is_master_node()): return # do it only on master:
mpi.report("Reading input from %s..."%self.lda_file)
# Read and write only on Master!!!
# R is a generator : each R.Next() will return the next number in the file
R = read_fortran_file(self.lda_file)
try:
energy_unit = R.next() # read the energy convertion factor
n_k = int(R.next()) # read the number of k points
k_dep_projection = 1
SP = int(R.next()) # flag for spin-polarised calculation
SO = int(R.next()) # flag for spin-orbit calculation
charge_below = R.next() # total charge below energy window
density_required = R.next() # total density required, for setting the chemical potential
symm_op = 1 # Use symmetry groups for the k-sum
# the information on the non-correlated shells is not important here, maybe skip:
n_shells = int(R.next()) # number of shells (e.g. Fe d, As p, O p) in the unit cell,
# corresponds to index R in formulas
shells = [ [ int(R.next()) for i in range(4) ] for icrsh in range(n_shells) ] # reads iatom, sort, l, dim
#shells = numpy.array(shells)
n_corr_shells = int(R.next()) # number of corr. shells (e.g. Fe d, Ce f) in the unit cell,
# corresponds to index R in formulas
# now read the information about the shells:
corr_shells = [ [ int(R.next()) for i in range(6) ] for icrsh in range(n_corr_shells) ] # reads iatom, sort, l, dim, SO flag, irep
self.inequiv_shells(corr_shells) # determine the number of inequivalent correlated shells, has to be known for further reading...
#corr_shells = numpy.array(corr_shells)
use_rotations = 1
rot_mat = [numpy.identity(corr_shells[icrsh][3],numpy.complex_) for icrsh in xrange(n_corr_shells)]
# read the matrices
rot_mat_time_inv = [0 for i in range(n_corr_shells)]
for icrsh in xrange(n_corr_shells):
for i in xrange(corr_shells[icrsh][3]): # read real part:
for j in xrange(corr_shells[icrsh][3]):
rot_mat[icrsh][i,j] = R.next()
for i in xrange(corr_shells[icrsh][3]): # read imaginary part:
for j in xrange(corr_shells[icrsh][3]):
rot_mat[icrsh][i,j] += 1j * R.next()
if (SP==1): # read time inversion flag:
rot_mat_time_inv[icrsh] = int(R.next())
# Read here the infos for the transformation of the basis:
n_reps = [1 for i in range(self.n_inequiv_corr_shells)]
dim_reps = [0 for i in range(self.n_inequiv_corr_shells)]
T = []
for icrsh in range(self.n_inequiv_corr_shells):
n_reps[icrsh] = int(R.next()) # number of representatives ("subsets"), e.g. t2g and eg
dim_reps[icrsh] = [int(R.next()) for i in range(n_reps[icrsh])] # dimensions of the subsets
# The transformation matrix:
# it is of dimension 2l+1, if no SO, and 2*(2l+1) with SO!!
#T = []
#for ish in xrange(self.n_inequiv_corr_shells):
ll = 2*corr_shells[self.invshellmap[icrsh]][2]+1
lmax = ll * (corr_shells[self.invshellmap[icrsh]][4] + 1)
T.append(numpy.zeros([lmax,lmax],numpy.complex_))
# now read it from file:
for i in xrange(lmax):
for j in xrange(lmax):
T[icrsh][i,j] = R.next()
for i in xrange(lmax):
for j in xrange(lmax):
T[icrsh][i,j] += 1j * R.next()
# Spin blocks to be read:
n_spin_blocs = SP + 1 - SO
# read the list of n_orbitals for all k points
n_orbitals = numpy.zeros([n_k,n_spin_blocs],numpy.int)
#n_orbitals = [ [0 for isp in range(n_spin_blocs)] for ik in xrange(n_k)]
for isp in range(n_spin_blocs):
for ik in xrange(n_k):
#n_orbitals[ik][isp] = int(R.next())
n_orbitals[ik,isp] = int(R.next())
#print n_orbitals
# Initialise the projectors:
#proj_mat = [ [ [numpy.zeros([corr_shells[icrsh][3], n_orbitals[ik][isp]], numpy.complex_)
# for icrsh in range (n_corr_shells)]
# for isp in range(n_spin_blocs)]
# for ik in range(n_k) ]
proj_mat = numpy.zeros([n_k,n_spin_blocs,n_corr_shells,max(numpy.array(corr_shells)[:,3]),max(n_orbitals)],numpy.complex_)
# Read the projectors from the file:
for ik in xrange(n_k):
for icrsh in range(n_corr_shells):
no = corr_shells[icrsh][3]
# first Real part for BOTH spins, due to conventions in dmftproj:
for isp in range(n_spin_blocs):
for i in xrange(no):
for j in xrange(n_orbitals[ik][isp]):
#proj_mat[ik][isp][icrsh][i,j] = R.next()
proj_mat[ik,isp,icrsh,i,j] = R.next()
# now Imag part:
for isp in range(n_spin_blocs):
for i in xrange(no):
for j in xrange(n_orbitals[ik][isp]):
#proj_mat[ik][isp][icrsh][i,j] += 1j * R.next()
proj_mat[ik,isp,icrsh,i,j] += 1j * R.next()
# now define the arrays for weights and hopping ...
bz_weights = numpy.ones([n_k],numpy.float_)/ float(n_k) # w(k_index), default normalisation
#hopping = [ [numpy.zeros([n_orbitals[ik][isp],n_orbitals[ik][isp]],numpy.complex_)
# for isp in range(n_spin_blocs)] for ik in xrange(n_k) ]
hopping = numpy.zeros([n_k,n_spin_blocs,max(n_orbitals),max(n_orbitals)],numpy.complex_)
# weights in the file
for ik in xrange(n_k) : bz_weights[ik] = R.next()
# if the sum over spins is in the weights, take it out again!!
sm = sum(bz_weights)
bz_weights[:] /= sm
# Grab the H
# we use now the convention of a DIAGONAL Hamiltonian!!!!
for isp in range(n_spin_blocs):
for ik in xrange(n_k) :
no = n_orbitals[ik][isp]
for i in xrange(no):
#hopping[ik][isp][i,i] = R.next() * energy_unit
hopping[ik,isp,i,i] = R.next() * energy_unit
#keep some things that we need for reading parproj:
self.n_shells = n_shells
self.shells = shells
self.n_corr_shells = n_corr_shells
self.corr_shells = corr_shells
self.n_spin_blocs = n_spin_blocs
self.n_orbitals = n_orbitals
self.n_k = n_k
self.SO = SO
self.SP = SP
self.energy_unit = energy_unit
except StopIteration : # a more explicit error if the file is corrupted.
raise "SumkLDA : reading file HMLT_file failed!"
R.close()
#print proj_mat[0]
#-----------------------------------------
# Store the input into HDF5:
ar = HDFArchive(self.hdf_file,'a')
if not (self.lda_subgrp in ar): ar.create_group(self.lda_subgrp)
# The subgroup containing the data. If it does not exist, it is created.
# If it exists, the data is overwritten!!!
ar[self.lda_subgrp]['energy_unit'] = energy_unit
ar[self.lda_subgrp]['n_k'] = n_k
ar[self.lda_subgrp]['k_dep_projection'] = k_dep_projection
ar[self.lda_subgrp]['SP'] = SP
ar[self.lda_subgrp]['SO'] = SO
ar[self.lda_subgrp]['charge_below'] = charge_below
ar[self.lda_subgrp]['density_required'] = density_required
ar[self.lda_subgrp]['symm_op'] = symm_op
ar[self.lda_subgrp]['n_shells'] = n_shells
ar[self.lda_subgrp]['shells'] = shells
ar[self.lda_subgrp]['n_corr_shells'] = n_corr_shells
ar[self.lda_subgrp]['corr_shells'] = corr_shells
ar[self.lda_subgrp]['use_rotations'] = use_rotations
ar[self.lda_subgrp]['rot_mat'] = rot_mat
ar[self.lda_subgrp]['rot_mat_time_inv'] = rot_mat_time_inv
ar[self.lda_subgrp]['n_reps'] = n_reps
ar[self.lda_subgrp]['dim_reps'] = dim_reps
ar[self.lda_subgrp]['T'] = T
ar[self.lda_subgrp]['n_orbitals'] = n_orbitals
ar[self.lda_subgrp]['proj_mat'] = proj_mat
ar[self.lda_subgrp]['bz_weights'] = bz_weights
ar[self.lda_subgrp]['hopping'] = hopping
del ar
# Symmetries are used,
# Now do the symmetries for correlated orbitals:
self.read_symmetry_input(orbits=corr_shells,symm_file=self.symm_file,symm_subgrp=self.symm_subgrp,SO=SO,SP=SP)
def convert_parproj_input(self, par_proj_subgrp='SumK_LDA_ParProj', symm_par_subgrp='SymmPar'):
"""
Reads the input for the partial charges projectors from case.parproj, and stores it in the symm_par_subgrp
group in the HDF5.
"""
if not (mpi.is_master_node()): return
self.par_proj_subgrp = par_proj_subgrp
self.symm_par_subgrp = symm_par_subgrp
mpi.report("Reading parproj input from %s..."%self.parproj_file)
dens_mat_below = [ [numpy.zeros([self.shells[ish][3],self.shells[ish][3]],numpy.complex_) for ish in range(self.n_shells)]
for isp in range(self.n_spin_blocs) ]
R = read_fortran_file(self.parproj_file)
#try:
n_parproj = [int(R.next()) for i in range(self.n_shells)]
n_parproj = numpy.array(n_parproj)
# Initialise P, here a double list of matrices:
#proj_mat_pc = [ [ [ [numpy.zeros([self.shells[ish][3], self.n_orbitals[ik][isp]], numpy.complex_)
# for ir in range(n_parproj[ish])]
# for ish in range (self.n_shells) ]
# for isp in range(self.n_spin_blocs) ]
# for ik in range(self.n_k) ]
proj_mat_pc = numpy.zeros([self.n_k,self.n_spin_blocs,self.n_shells,max(n_parproj),max(numpy.array(self.shells)[:,3]),max(self.n_orbitals)],numpy.complex_)
rot_mat_all = [numpy.identity(self.shells[ish][3],numpy.complex_) for ish in xrange(self.n_shells)]
rot_mat_all_time_inv = [0 for i in range(self.n_shells)]
for ish in range(self.n_shells):
#print ish
# read first the projectors for this orbital:
for ik in xrange(self.n_k):
for ir in range(n_parproj[ish]):
for isp in range(self.n_spin_blocs):
for i in xrange(self.shells[ish][3]): # read real part:
for j in xrange(self.n_orbitals[ik][isp]):
proj_mat_pc[ik,isp,ish,ir,i,j] = R.next()
for isp in range(self.n_spin_blocs):
for i in xrange(self.shells[ish][3]): # read imaginary part:
for j in xrange(self.n_orbitals[ik][isp]):
proj_mat_pc[ik,isp,ish,ir,i,j] += 1j * R.next()
# now read the Density Matrix for this orbital below the energy window:
for isp in range(self.n_spin_blocs):
for i in xrange(self.shells[ish][3]): # read real part:
for j in xrange(self.shells[ish][3]):
dens_mat_below[isp][ish][i,j] = R.next()
for isp in range(self.n_spin_blocs):
for i in xrange(self.shells[ish][3]): # read imaginary part:
for j in xrange(self.shells[ish][3]):
dens_mat_below[isp][ish][i,j] += 1j * R.next()
if (self.SP==0): dens_mat_below[isp][ish] /= 2.0
# Global -> local rotation matrix for this shell:
for i in xrange(self.shells[ish][3]): # read real part:
for j in xrange(self.shells[ish][3]):
rot_mat_all[ish][i,j] = R.next()
for i in xrange(self.shells[ish][3]): # read imaginary part:
for j in xrange(self.shells[ish][3]):
rot_mat_all[ish][i,j] += 1j * R.next()
#print Dens_Mat_below[0][ish],Dens_Mat_below[1][ish]
if (self.SP):
rot_mat_all_time_inv[ish] = int(R.next())
#except StopIteration : # a more explicit error if the file is corrupted.
# raise "Wien2kConverter: reading file for Projectors failed!"
R.close()
#-----------------------------------------
# Store the input into HDF5:
ar = HDFArchive(self.hdf_file,'a')
if not (self.par_proj_subgrp in ar): ar.create_group(self.par_proj_subgrp)
# The subgroup containing the data. If it does not exist, it is created.
# If it exists, the data is overwritten!!!
thingstowrite = ['dens_mat_below','n_parproj','proj_mat_pc','rot_mat_all','rot_mat_all_time_inv']
for it in thingstowrite: exec "ar['%s']['%s'] = %s"%(self.par_proj_subgrp,it,it)
del ar
# Symmetries are used,
# Now do the symmetries for all orbitals:
self.read_symmetry_input(orbits=self.shells,symm_file=self.symmpar_file,symm_subgrp=self.symm_par_subgrp,SO=self.SO,SP=self.SP)
def convert_bands_input(self, bands_subgrp = 'SumK_LDA_Bands'):
"""
Converts the input for momentum resolved spectral functions, and stores it in bands_subgrp in the
HDF5.
"""
if not (mpi.is_master_node()): return
self.bands_subgrp = bands_subgrp
mpi.report("Reading bands input from %s..."%self.band_file)
R = read_fortran_file(self.band_file)
try:
n_k = int(R.next())
# read the list of n_orbitals for all k points
n_orbitals = numpy.zeros([n_k,self.n_spin_blocs],numpy.int)
for isp in range(self.n_spin_blocs):
for ik in xrange(n_k):
n_orbitals[ik,isp] = int(R.next())
# Initialise the projectors:
#proj_mat = [ [ [numpy.zeros([self.corr_shells[icrsh][3], n_orbitals[ik][isp]], numpy.complex_)
# for icrsh in range (self.n_corr_shells)]
# for isp in range(self.n_spin_blocs)]
# for ik in range(n_k) ]
proj_mat = numpy.zeros([n_k,self.n_spin_blocs,self.n_corr_shells,max(numpy.array(self.corr_shells)[:,3]),max(n_orbitals)],numpy.complex_)
# Read the projectors from the file:
for ik in xrange(n_k):
for icrsh in range(self.n_corr_shells):
no = self.corr_shells[icrsh][3]
# first Real part for BOTH spins, due to conventions in dmftproj:
for isp in range(self.n_spin_blocs):
for i in xrange(no):
for j in xrange(n_orbitals[ik,isp]):
proj_mat[ik,isp,icrsh,i,j] = R.next()
# now Imag part:
for isp in range(self.n_spin_blocs):
for i in xrange(no):
for j in xrange(n_orbitals[ik,isp]):
proj_mat[ik,isp,icrsh,i,j] += 1j * R.next()
#hopping = [ [numpy.zeros([n_orbitals[ik][isp],n_orbitals[ik][isp]],numpy.complex_)
# for isp in range(self.n_spin_blocs)] for ik in xrange(n_k) ]
hopping = numpy.zeros([n_k,self.n_spin_blocs,max(n_orbitals),max(n_orbitals)],numpy.complex_)
# Grab the H
# we use now the convention of a DIAGONAL Hamiltonian!!!!
for isp in range(self.n_spin_blocs):
for ik in xrange(n_k) :
no = n_orbitals[ik,isp]
for i in xrange(no):
hopping[ik,isp,i,i] = R.next() * self.energy_unit
# now read the partial projectors:
n_parproj = [int(R.next()) for i in range(self.n_shells)]
n_parproj = numpy.array(n_parproj)
# Initialise P, here a double list of matrices:
#proj_mat_pc = [ [ [ [numpy.zeros([self.shells[ish][3], n_orbitals[ik][isp]], numpy.complex_)
# for ir in range(n_parproj[ish])]
# for ish in range (self.n_shells) ]
# for isp in range(self.n_spin_blocs) ]
# for ik in range(n_k) ]
proj_mat_pc = numpy.zeros([n_k,self.n_spin_blocs,self.n_shells,max(n_parproj),max(numpy.array(self.shells)[:,3]),max(n_orbitals)],numpy.complex_)
for ish in range(self.n_shells):
for ik in xrange(n_k):
for ir in range(n_parproj[ish]):
for isp in range(self.n_spin_blocs):
for i in xrange(self.shells[ish][3]): # read real part:
for j in xrange(n_orbitals[ik,isp]):
proj_mat_pc[ik,isp,ish,ir,i,j] = R.next()
for i in xrange(self.shells[ish][3]): # read imaginary part:
for j in xrange(n_orbitals[ik,isp]):
proj_mat_pc[ik,isp,ish,ir,i,j] += 1j * R.next()
except StopIteration : # a more explicit error if the file is corrupted.
raise "SumkLDA : reading file HMLT_file failed!"
R.close()
# reading done!
#-----------------------------------------
# Store the input into HDF5:
ar = HDFArchive(self.hdf_file,'a')
if not (self.bands_subgrp in ar): ar.create_group(self.bands_subgrp)
# The subgroup containing the data. If it does not exist, it is created.
# If it exists, the data is overwritten!!!
thingstowrite = ['n_k','n_orbitals','proj_mat','hopping','n_parproj','proj_mat_pc']
for it in thingstowrite: exec "ar['%s']['%s'] = %s"%(self.bands_subgrp,it,it)
#ar[self.bands_subgrp]['n_k'] = n_k
#ar[self.bands_subgrp]['n_orbitals'] = n_orbitals
#ar[self.bands_subgrp]['proj_mat'] = proj_mat
#self.proj_mat = proj_mat
#self.n_orbitals = n_orbitals
#self.n_k = n_k
#self.hopping = hopping
del ar
def read_symmetry_input(self, orbits, symm_file, symm_subgrp, SO, SP):
"""
Reads input for the symmetrisations from symm_file, which is case.sympar or case.symqmc.
"""
if not (mpi.is_master_node()): return
mpi.report("Reading symmetry input from %s..."%symm_file)
n_orbits = len(orbits)
R=read_fortran_file(symm_file)
try:
n_s = int(R.next()) # Number of symmetry operations
n_atoms = int(R.next()) # number of atoms involved
perm = [ [int(R.next()) for i in xrange(n_atoms)] for j in xrange(n_s) ] # list of permutations of the atoms
if SP:
time_inv = [ int(R.next()) for j in xrange(n_s) ] # timeinversion for SO xoupling
else:
time_inv = [ 0 for j in xrange(n_s) ]
# Now read matrices:
mat = []
for in_s in xrange(n_s):
mat.append( [ numpy.zeros([orbits[orb][3], orbits[orb][3]],numpy.complex_) for orb in xrange(n_orbits) ] )
for orb in range(n_orbits):
for i in xrange(orbits[orb][3]):
for j in xrange(orbits[orb][3]):
mat[in_s][orb][i,j] = R.next() # real part
for i in xrange(orbits[orb][3]):
for j in xrange(orbits[orb][3]):
mat[in_s][orb][i,j] += 1j * R.next() # imaginary part
# determine the inequivalent shells:
#SHOULD BE FINALLY REMOVED, PUT IT FOR ALL ORBITALS!!!!!
#self.inequiv_shells(orbits)
mat_tinv = [numpy.identity(orbits[orb][3],numpy.complex_)
for orb in range(n_orbits)]
if ((SO==0) and (SP==0)):
# here we need an additional time inversion operation, so read it:
for orb in range(n_orbits):
for i in xrange(orbits[orb][3]):
for j in xrange(orbits[orb][3]):
mat_tinv[orb][i,j] = R.next() # real part
for i in xrange(orbits[orb][3]):
for j in xrange(orbits[orb][3]):
mat_tinv[orb][i,j] += 1j * R.next() # imaginary part
except StopIteration : # a more explicit error if the file is corrupted.
raise "Symmetry : reading file failed!"
R.close()
# Save it to the HDF:
ar=HDFArchive(self.hdf_file,'a')
if not (symm_subgrp in ar): ar.create_group(symm_subgrp)
thingstowrite = ['n_s','n_atoms','perm','orbits','SO','SP','time_inv','mat','mat_tinv']
for it in thingstowrite: exec "ar['%s']['%s'] = %s"%(symm_subgrp,it,it)
del ar
def __repack(self):
"""Calls the h5repack routine, in order to reduce the file size of the hdf5 archive.
Should only be used BEFORE the first invokation of HDFArchive in the program, otherwise
the hdf5 linking is broken!!!"""
import subprocess
if not (mpi.is_master_node()): return
mpi.report("Repacking the file %s"%self.hdf_file)
retcode = subprocess.call(["h5repack","-i%s"%self.hdf_file, "-otemphgfrt.h5"])
if (retcode!=0):
mpi.report("h5repack failed!")
else:
subprocess.call(["mv","-f","temphgfrt.h5","%s"%self.hdf_file])
def inequiv_shells(self,lst):
"""
The number of inequivalent shells is calculated from lst, and a mapping is given as
map(i_corr_shells) = i_inequiv_corr_shells
invmap(i_inequiv_corr_shells) = i_corr_shells
in order to put the Self energies to all equivalent shells, and for extracting Gloc
"""
tmp = []
self.shellmap = [0 for i in range(len(lst))]
self.invshellmap = [0]
self.n_inequiv_corr_shells = 1
tmp.append( lst[0][1:3] )
if (len(lst)>1):
for i in range(len(lst)-1):
fnd = False
for j in range(self.n_inequiv_corr_shells):
if (tmp[j]==lst[i+1][1:3]):
fnd = True
self.shellmap[i+1] = j
if (fnd==False):
self.shellmap[i+1] = self.n_inequiv_corr_shells
self.n_inequiv_corr_shells += 1
tmp.append( lst[i+1][1:3] )
self.invshellmap.append(i+1)

449
python/solver_multiband.py Normal file
View File

@ -0,0 +1,449 @@
################################################################################
#
# TRIQS: a Toolbox for Research in Interacting Quantum Systems
#
# Copyright (C) 2011 by M. Aichhorn, L. Pourovskii, V. Vildosola
#
# TRIQS is free software: you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.
#
# TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# TRIQS. If not, see <http://www.gnu.org/licenses/>.
#
################################################################################
#from pytriqs.applications.dft.U_matrix import *
from U_matrix import *
#from pytriqs.applications.impurity_solvers.operators import *
from pytriqs.operators import *
from pytriqs.applications.impurity_solvers.ctqmc_hyb import Solver
import pytriqs.utility.mpi as mpi
from types import *
import numpy
def sum_list(L):
""" Can sum any list"""
return reduce(lambda x, y: x+y, L) if len(L)>0 else []
#########################################
#
# Solver for the Multi-Band problem
#
#########################################
class SolverMultiBand(Solver):
"""
This is a general solver for a multiband local Hamiltonian.
Calling arguments:
beta = inverse temperature
n_orb = Number of local orbitals
U_interact = Average Coulomb interaction
J_hund = Hund coupling
use_spinflip = true/false
use_pairhop = true/false
use_matrix: Use the interaction matrix calculated from the Slater integrals
is use_matrix, you need also:
l: angular momentum of the orbital, l=2 is d
T: Transformation matrix for U vertex. If not present, use standard complex harmonics
"""
def __init__(self, beta, n_orb, gf_struct = False, map = False):
self.n_orb = n_orb
# either get or construct gf_struct
if (gf_struct):
assert map, "give also the mapping!"
self.map = map
else:
# standard gf_struct and map
gf_struct = [ ('%s'%(ud),[n for n in range(n_orb)]) for ud in ['up','down'] ]
self.map = {'up' : ['up' for v in range(n_orb)], 'down' : ['down' for v in range(n_orb)]}
# now initialize the solver with the stuff given above:
Solver.__init__(self, beta = beta, gf_struct = gf_struct)
def solve(self, U_interact=None, J_hund=None, use_spinflip=False,
use_matrix = True, l=2, T=None, dim_reps=None, irep=None, deg_orbs = [], sl_int = None, **params):
self.use_spinflip = use_spinflip
self.U, self.Up, self.U4ind, self.offset = set_U_matrix(U_interact,J_hund,self.n_orb,l,use_matrix,T,sl_int,use_spinflip,dim_reps,irep)
# define mapping of indices:
self.map_ind={}
for nm in self.map:
bl_names = self.map[nm]
block = []
for a,al in self.gf_struct:
if a in bl_names: block.append(al)
self.map_ind[nm] = range(self.n_orb)
i = 0
for al in block:
cnt = 0
for a in range(len(al)):
self.map_ind[nm][i] = cnt
i = i+1
cnt = cnt+1
# set the Hamiltonian
if (use_spinflip==False):
Hamiltonian = self.__set_hamiltonian_density()
else:
if (use_matrix):
#Hamiltonian = self.__set_full_hamiltonian_slater()
Hamiltonian = self.__set_spinflip_hamiltonian_slater()
else:
Hamiltonian = self.__set_full_hamiltonian_kanamori(J_hund = J_hund)
# set the Quantum numbers
Quantum_Numbers = self.__set_quantum_numbers(self.gf_struct)
# Determine if there are only blocs of size 1:
self.blocssizeone = True
for ib in self.gf_struct:
if (len(ib[1])>1): self.blocssizeone = False
nc = params.pop("n_cycles",10000)
if ((self.blocssizeone) and (self.use_spinflip==False)):
use_seg = True
else:
use_seg = False
#gm = self.set_global_moves(deg_orbs)
Solver.solve(self,H_local = Hamiltonian, quantum_numbers = Quantum_Numbers, n_cycles = nc, use_segment_picture = use_seg, **params)
def set_global_moves(self, deg_orbs, factor=0.05):
# Sets some global moves given orbital degeneracies:
strbl = ''
strind = ''
inddone = []
for orbs in deg_orbs:
ln = len(orbs)
orbsorted = sorted(orbs)
for ii in range(ln):
if (strbl!=''): strbl += ','
bl1 = orbsorted[ii]
bl2 = orbsorted[(ii+1)%ln]
ind1 = [ll for ll in self.Sigma[bl1].indices ]
ind2 = [ll for ll in self.Sigma[bl2].indices ]
strbl += "'" + bl1 + "':'" + bl2 + "'"
for kk, ind in enumerate(ind1):
if not (ind in inddone):
if (strind!=''): strind += ','
strind += '%s:%s'%(ind1[kk],ind2[kk])
inddone.append(ind)
if len(deg_orbs)>0:
str = 'Global_Moves = [ (%s, lambda (a,alpha,dag) : ({ '%factor + strbl + ' }[a], {' + strind + '}[alpha], dag) )]'
exec str
return Global_Moves
else:
return []
def __set_hamiltonian_density(self):
# density-density Hamiltonian:
spinblocs = [v for v in self.map]
#print spinblocs
Hamiltonian = N(self.map[spinblocs[0]][0],0) # initialize it
for sp1 in spinblocs:
for sp2 in spinblocs:
for i in range(self.n_orb):
for j in range(self.n_orb):
if (sp1==sp2):
Hamiltonian += 0.5 * self.U[self.offset+i,self.offset+j] * N(self.map[sp1][i],self.map_ind[sp1][i]) * N(self.map[sp2][j],self.map_ind[sp2][j])
else:
Hamiltonian += 0.5 * self.Up[self.offset+i,self.offset+j] * N(self.map[sp1][i],self.map_ind[sp1][i]) * N(self.map[sp2][j],self.map_ind[sp2][j])
Hamiltonian -= N(self.map[spinblocs[0]][0],0) # substract the initializing value
return Hamiltonian
def __set_full_hamiltonian_slater(self):
spinblocs = [v for v in self.map]
Hamiltonian = N(self.map[spinblocs[0]][0],0) # initialize it
#print "Starting..."
# use the full 4-index U-matrix:
#for sp1 in spinblocs:
# for sp2 in spinblocs:
for m1 in range(self.n_orb):
for m2 in range(self.n_orb):
for m3 in range(self.n_orb):
for m4 in range(self.n_orb):
if (abs(self.U4ind[self.offset+m1,self.offset+m2,self.offset+m3,self.offset+m4])>0.00001):
for sp1 in spinblocs:
for sp2 in spinblocs:
#print sp1,sp2,m1,m2,m3,m4
Hamiltonian += 0.5 * self.U4ind[self.offset+m1,self.offset+m2,self.offset+m3,self.offset+m4] * \
Cdag(self.map[sp1][m1],self.map_ind[sp1][m1]) * Cdag(self.map[sp2][m2],self.map_ind[sp2][m2]) * C(self.map[sp2][m4],self.map_ind[sp2][m4]) * C(self.map[sp1][m3],self.map_ind[sp1][m3])
#print "end..."
Hamiltonian -= N(self.map[spinblocs[0]][0],0) # substract the initializing value
return Hamiltonian
def __set_spinflip_hamiltonian_slater(self):
"""Takes only spin-flip and pair-hopping terms"""
spinblocs = [v for v in self.map]
Hamiltonian = N(self.map[spinblocs[0]][0],0) # initialize it
#print "Starting..."
# use the full 4-index U-matrix:
#for sp1 in spinblocs:
# for sp2 in spinblocs:
for m1 in range(self.n_orb):
for m2 in range(self.n_orb):
for m3 in range(self.n_orb):
for m4 in range(self.n_orb):
if ((abs(self.U4ind[self.offset+m1,self.offset+m2,self.offset+m3,self.offset+m4])>0.00001) and
( ((m1==m2)and(m3==m4)) or ((m1==m3)and(m2==m4)) or ((m1==m4)and(m2==m3)) ) ):
for sp1 in spinblocs:
for sp2 in spinblocs:
#print sp1,sp2,m1,m2,m3,m4
Hamiltonian += 0.5 * self.U4ind[self.offset+m1,self.offset+m2,self.offset+m3,self.offset+m4] * \
Cdag(self.map[sp1][m1],self.map_ind[sp1][m1]) * Cdag(self.map[sp2][m2],self.map_ind[sp2][m2]) * C(self.map[sp2][m4],self.map_ind[sp2][m4]) * C(self.map[sp1][m3],self.map_ind[sp1][m3])
#print "end..."
Hamiltonian -= N(self.map[spinblocs[0]][0],0) # substract the initializing value
return Hamiltonian
def __set_full_hamiltonian_kanamori(self,J_hund):
spinblocs = [v for v in self.map]
assert len(spinblocs)==2,"spinflips in Kanamori representation only implemented for up/down structure!"
Hamiltonian = N(self.map[spinblocs[0]][0],0) # initialize it
# density terms:
for sp1 in spinblocs:
for sp2 in spinblocs:
for i in range(self.n_orb):
for j in range(self.n_orb):
if (sp1==sp2):
Hamiltonian += 0.5 * self.U[self.offset+i,self.offset+j] * N(self.map[sp1][i],self.map_ind[sp1][i]) * N(self.map[sp2][j],self.map_ind[sp2][j])
else:
Hamiltonian += 0.5 * self.Up[self.offset+i,self.offset+j] * N(self.map[sp1][i],self.map_ind[sp1][i]) * N(self.map[sp2][j],self.map_ind[sp2][j])
# spinflip term:
sp1 = spinblocs[0]
sp2 = spinblocs[1]
for i in range(self.n_orb-1):
for j in range(i+1,self.n_orb):
Hamiltonian -= J_hund * ( Cdag(self.map[sp1][i],self.map_ind[sp1][i]) * C(self.map[sp2][i],self.map_ind[sp2][i]) * Cdag(self.map[sp2][j],self.map_ind[sp2][j]) * C(self.map[sp1][j],self.map_ind[sp1][j]) ) # first term
Hamiltonian -= J_hund * ( Cdag(self.map[sp2][i],self.map_ind[sp2][i]) * C(self.map[sp1][i],self.map_ind[sp1][i]) * Cdag(self.map[sp1][j],self.map_ind[sp1][j]) * C(self.map[sp2][j],self.map_ind[sp2][j]) ) # second term
# pairhop terms:
for i in range(self.n_orb-1):
for j in range(i+1,self.n_orb):
Hamiltonian -= J_hund * ( Cdag(self.map[sp1][i],self.map_ind[sp1][i]) * Cdag(self.map[sp2][i],self.map_ind[sp2][i]) * C(self.map[sp1][j],self.map_ind[sp1][j]) * C(self.map[sp2][j],self.map_ind[sp2][j]) ) # first term
Hamiltonian -= J_hund * ( Cdag(self.map[sp2][j],self.map_ind[sp2][j]) * Cdag(self.map[sp1][j],self.map_ind[sp1][j]) * C(self.map[sp2][i],self.map_ind[sp2][i]) * C(self.map[sp1][i],self.map_ind[sp1][i]) ) # second term
Hamiltonian -= N(self.map[spinblocs[0]][0],0) # substract the initializing value
return Hamiltonian
def __set_quantum_numbers(self,gf_struct):
QN = {}
spinblocs = [v for v in self.map]
# Define the quantum numbers:
if (self.use_spinflip) :
Ntot = sum_list( [ N(self.map[s][i],self.map_ind[s][i]) for s in spinblocs for i in range(self.n_orb) ] )
QN['NtotQN'] = Ntot
#QN['Ntot'] = sum_list( [ N(self.map[s][i],i) for s in spinblocs for i in range(self.n_orb) ] )
if (len(spinblocs)==2):
# Assuming up/down structure:
Sz = sum_list( [ N(self.map[spinblocs[0]][i],self.map_ind[spinblocs[0]][i])-N(self.map[spinblocs[1]][i],self.map_ind[spinblocs[1]][i]) for i in range(self.n_orb) ] )
QN['SzQN'] = Sz
# new quantum number: works only if there are only spin-flip and pair hopping, not any more complicated things
for i in range(self.n_orb):
QN['Sz2_%s'%i] = (N(self.map[spinblocs[0]][i],self.map_ind[spinblocs[0]][i])-N(self.map[spinblocs[1]][i],self.map_ind[spinblocs[1]][i])) * (N(self.map[spinblocs[0]][i],self.map_ind[spinblocs[0]][i])-N(self.map[spinblocs[1]][i],self.map_ind[spinblocs[1]][i]))
else :
for ibl in range(len(gf_struct)):
QN['N%s'%gf_struct[ibl][0]] = sum_list( [ N(gf_struct[ibl][0],gf_struct[ibl][1][i]) for i in range(len(gf_struct[ibl][1])) ] )
return QN
def fit_tails(self):
"""Fits the tails using the constant value for the Re Sigma calculated from F=Sigma*G.
Works only for blocks of size one."""
#if (len(self.gf_struct)==2*self.n_orb):
if (self.blocssizeone):
spinblocs = [v for v in self.map]
mpi.report("Fitting tails manually")
known_coeff = numpy.zeros([1,1,2],numpy.float_)
msh = [x.imag for x in self.G[self.map[spinblocs[0]][0]].mesh ]
fit_start = msh[self.fitting_Frequency_Start]
fit_stop = msh[self.N_Frequencies_Accumulated]
# Fit the tail of G just to get the density
for n,g in self.G:
g.fitTail([[[0,0,1]]],7,fit_start,2*fit_stop)
densmat = self.G.density()
for sig1 in spinblocs:
for i in range(self.n_orb):
coeff = 0.0
for sig2 in spinblocs:
for j in range(self.n_orb):
if (sig1==sig2):
coeff += self.U[self.offset+i,self.offset+j] * densmat[self.map[sig1][j]][0,0].real
else:
coeff += self.Up[self.offset+i,self.offset+j] * densmat[self.map[sig2][j]][0,0].real
known_coeff[0,0,1] = coeff
self.Sigma[self.map[sig1][i]].fitTail(fixed_coef = known_coeff, order_max = 3, fit_start = fit_start, fit_stop = fit_stop)
else:
for n,sig in self.Sigma:
known_coeff = numpy.zeros([sig.N1,sig.N2,1],numpy.float_)
msh = [x.imag for x in sig.mesh]
fit_start = msh[self.fitting_Frequency_Start]
fit_stop = msh[self.N_Frequencies_Accumulated]
sig.fitTail(fixed_coef = known_coeff, order_max = 3, fit_start = fit_start, fit_stop = fit_stop)
class SolverMultiBandOld(SolverMultiBand):
"""
Old MultiBand Solver construct
"""
def __init__(self, Beta, Norb, U_interact=None, J_Hund=None, GFStruct=False, map=False, use_spinflip=False,
useMatrix = True, l=2, T=None, dimreps=None, irep=None, deg_orbs = [], Sl_Int = None):
SolverMultiBand.__init__(self, beta=Beta, n_orb=Norb, gf_struct=GFStruct, map=map)
self.U_interact = U_interact
self.J_Hund = J_Hund
self.use_spinflip = use_spinflip
self.useMatrix = useMatrix
self.l = l
self.T = T
self.dimreps = dimreps
self.irep = irep
self.deg_orbs = deg_orbs
self.Sl_Int = Sl_Int
self.gen_keys = copy.deepcopy(self.__dict__)
msg = """
**********************************************************************************
Warning: You are using the old constructor for the solver. Beware that this will
be deprecated in future versions. Please check the documentation.
**********************************************************************************
"""
mpi.report(msg)
def Solve(self):
params = copy.deepcopy(self.__dict__)
for i in self.gen_keys: self.params.pop(i)
self.params.pop("gen_keys")
self.solve(self, U_interact=self.U_interact, J_hund=self.J_Hund, use_spinflip=self.use_spinflip,
use_matrix = self.useMatrix, l=self.l, T=self.T, dim_reps=self.dimreps, irep=self.irep,
deg_orbs = self.deg_orbs, sl_int = self.Sl_Int, **params)
def set_U_matrix(U_interact,J_hund,n_orb,l,use_matrix=True,T=None,sl_int=None,use_spinflip=False,dim_reps=None,irep=None):
""" Set up the interaction vertex"""
offset = 0
U4ind = None
U = None
Up = None
if (use_matrix):
if not (sl_int is None):
Umat = Umatrix(l=l)
assert len(sl_int)==(l+1),"sl_int has the wrong length"
if (type(sl_int)==ListType):
Rcl = numpy.array(sl_int)
else:
Rcl = sl_int
Umat(T=T,Rcl=Rcl)
else:
if ((U_interact==None)and(J_hund==None)):
mpi.report("Give U,J or Slater integrals!!!")
assert 0
Umat = Umatrix(U_interact=U_interact, J_hund=J_hund, l=l)
Umat(T=T)
Umat.reduce_matrix()
if (Umat.N==Umat.Nmat):
# Transformation T is of size 2l+1
U = Umat.U
Up = Umat.Up
else:
# Transformation is of size 2(2l+1)
U = Umat.U
# now we have the reduced matrices U and Up, we need it for tail fitting anyways
if (use_spinflip):
#Take the 4index Umatrix
# check for imaginary matrix elements:
if (abs(Umat.Ufull.imag)>0.0001).any():
mpi.report("WARNING: complex interaction matrix!! Ignoring imaginary part for the moment!")
mpi.report("If you want to change this, look into Wien2k/solver_multiband.py")
U4ind = Umat.Ufull.real
# this will be changed for arbitrary irep:
# use only one subgroup of orbitals?
if not (irep is None):
#print irep, dim_reps
assert not (dim_reps is None), "Dimensions of the representatives are missing!"
assert n_orb==dim_reps[irep-1],"Dimensions of dimrep and n_orb do not fit!"
for ii in range(irep-1):
offset += dim_reps[ii]
else:
if ((U_interact==None)and(J_hund==None)):
mpi.report("For Kanamori representation, give U and J!!")
assert 0
U = numpy.zeros([n_orb,n_orb],numpy.float_)
Up = numpy.zeros([n_orb,n_orb],numpy.float_)
for i in range(n_orb):
for j in range(n_orb):
if (i==j):
Up[i,i] = U_interact + 2.0*J_hund
else:
Up[i,j] = U_interact
U[i,j] = U_interact - J_hund
return U, Up, U4ind, offset

1149
python/sumk_lda.py Normal file

File diff suppressed because it is too large Load Diff

625
python/sumk_lda_tools.py Normal file
View File

@ -0,0 +1,625 @@
################################################################################
#
# TRIQS: a Toolbox for Research in Interacting Quantum Systems
#
# Copyright (C) 2011 by M. Aichhorn, L. Pourovskii, V. Vildosola
#
# TRIQS is free software: you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.
#
# TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# TRIQS. If not, see <http://www.gnu.org/licenses/>.
#
################################################################################
from types import *
import numpy
import pytriqs.utility.dichotomy as dichotomy
from pytriqs.gf.local import *
#from pytriqs.applications.impurity_solvers.operators import *
from pytriqs.operators import *
import pytriqs.utility.mpi as mpi
from datetime import datetime
#from pytriqs.applications.dft.symmetry import *
#from pytriqs.applications.dft.sumk_lda import SumkLDA
from symmetry import *
from sumk_lda import SumkLDA
import string
def read_fortran_file (filename):
""" Returns a generator that yields all numbers in the Fortran file as float, one by one"""
import os.path
if not(os.path.exists(filename)) : raise IOError, "File %s does not exists"%filename
for line in open(filename,'r') :
for x in line.replace('D','E').split() :
yield string.atof(x)
class SumkLDATools(SumkLDA):
"""Extends the SumkLDA class with some tools for analysing the data."""
def __init__(self, hdf_file, mu = 0.0, h_field = 0.0, use_lda_blocks = False, lda_data = 'SumK_LDA', symm_corr_data = 'SymmCorr',
par_proj_data = 'SumK_LDA_ParProj', symm_par_data = 'SymmPar', bands_data = 'SumK_LDA_Bands'):
self.Gupf_refreq = None
SumkLDA.__init__(self,hdf_file=hdf_file,mu=mu,h_field=h_field,use_lda_blocks=use_lda_blocks,lda_data=lda_data,
symm_corr_data=symm_corr_data,par_proj_data=par_proj_data,symm_par_data=symm_par_data,
bands_data=bands_data)
def downfold_pc(self,ik,ir,ish,sig,gf_to_downfold,gf_inp):
"""Downfolding a block of the Greens function"""
gf_downfolded = gf_inp.copy()
isp = self.names_to_ind[self.SO][sig] # get spin index for proj. matrices
dim = self.shells[ish][3]
n_orb = self.n_orbitals[ik,isp]
L=self.proj_mat_pc[ik,isp,ish,ir,0:dim,0:n_orb]
R=self.proj_mat_pc[ik,isp,ish,ir,0:dim,0:n_orb].conjugate().transpose()
gf_downfolded.from_L_G_R(L,gf_to_downfold,R)
return gf_downfolded
def rotloc_all(self,ish,gf_to_rotate,direction):
"""Local <-> Global rotation of a GF block.
direction: 'toLocal' / 'toGlobal' """
assert ((direction=='toLocal')or(direction=='toGlobal')),"Give direction 'toLocal' or 'toGlobal' in rotloc!"
gf_rotated = gf_to_rotate.copy()
if (direction=='toGlobal'):
if ((self.rot_mat_all_time_inv[ish]==1) and (self.SO)):
gf_rotated <<= gf_rotated.transpose()
gf_rotated.from_L_G_R(self.rot_mat_all[ish].conjugate(),gf_rotated,self.rot_mat_all[ish].transpose())
else:
gf_rotated.from_L_G_R(self.rot_mat_all[ish],gf_rotated,self.rot_mat_all[ish].conjugate().transpose())
elif (direction=='toLocal'):
if ((self.rot_mat_all_time_inv[ish]==1)and(self.SO)):
gf_rotated <<= gf_rotated.transpose()
gf_rotated.from_L_G_R(self.rot_mat_all[ish].transpose(),gf_rotated,self.rot_mat_all[ish].conjugate())
else:
gf_rotated.from_L_G_R(self.rot_mat_all[ish].conjugate().transpose(),gf_rotated,self.rot_mat_all[ish])
return gf_rotated
def lattice_gf_realfreq(self, ik, mu, broadening, mesh=None, beta=40, with_Sigma=True):
"""Calculates the lattice Green function on the real frequency axis. If self energy is
present and with_Sigma=True, the mesh is taken from Sigma. Otherwise, the mesh has to be given."""
ntoi = self.names_to_ind[self.SO]
bln = self.blocnames[self.SO]
if (not hasattr(self,"Sigma_imp")): with_Sigma=False
if (with_Sigma):
assert type(self.Sigma_imp[0]) == GfReFreq, "Real frequency Sigma needed for lattice_gf_realfreq!"
beta = self.Sigma_imp[0].mesh.beta
stmp = self.add_dc()
else:
assert (not (mesh is None)),"Without Sigma, give the mesh for lattice_gf_realfreq!"
if (self.Gupf_refreq is None):
# first setting up of Gupf_refreq
BS = [ range(self.n_orbitals[ik,ntoi[ib]]) for ib in bln ]
gf_struct = [ (bln[ib], BS[ib]) for ib in range(self.n_spin_blocks_gf[self.SO]) ]
a_list = [a for a,al in gf_struct]
if (with_Sigma):
glist = lambda : [ GfReFreq(indices = al, mesh =self.Sigma_imp[0].mesh) for a,al in gf_struct]
else:
glist = lambda : [ GfReFreq(indices = al, beta = beta, mesh_array = mesh) for a,al in gf_struct]
self.Gupf_refreq = BlockGf(name_list = a_list, block_list = glist(),make_copies=False)
self.Gupf_refreq.zero()
GFsize = [ gf.N1 for sig,gf in self.Gupf_refreq]
unchangedsize = all( [ self.n_orbitals[ik,ntoi[bln[ib]]]==GFsize[ib]
for ib in range(self.n_spin_blocks_gf[self.SO]) ] )
if (not unchangedsize):
BS = [ range(self.n_orbitals[ik,ntoi[ib]]) for ib in bln ]
gf_struct = [ (bln[ib], BS[ib]) for ib in range(self.n_spin_blocks_gf[self.SO]) ]
a_list = [a for a,al in gf_struct]
if (with_Sigma):
glist = lambda : [ GfReFreq(indices = al, mesh =self.Sigma_imp[0].mesh) for a,al in gf_struct]
else:
glist = lambda : [ GfReFreq(indices = al, beta = beta, mesh_array = mesh) for a,al in gf_struct]
self.Gupf_refreq = BlockGf(name_list = a_list, block_list = glist(),make_copies=False)
self.Gupf_refreq.zero()
idmat = [numpy.identity(self.n_orbitals[ik,ntoi[bl]],numpy.complex_) for bl in bln]
self.Gupf_refreq <<= Omega + 1j*broadening
M = copy.deepcopy(idmat)
for ibl in range(self.n_spin_blocks_gf[self.SO]):
ind = ntoi[bln[ibl]]
n_orb = self.n_orbitals[ik,ind]
M[ibl] = self.hopping[ik,ind,0:n_orb,0:n_orb] - (idmat[ibl]*mu) - (idmat[ibl] * self.h_field * (1-2*ibl))
self.Gupf_refreq -= M
if (with_Sigma):
tmp = self.Gupf_refreq.copy() # init temporary storage
for icrsh in xrange(self.n_corr_shells):
for sig,gf in tmp: tmp[sig] <<= self.upfold(ik,icrsh,sig,stmp[icrsh][sig],gf)
self.Gupf_refreq -= tmp # adding to the upfolded GF
self.Gupf_refreq.invert()
return self.Gupf_refreq
def check_input_dos(self, om_min, om_max, n_om, beta=10, broadening=0.01):
delta_om = (om_max-om_min)/(n_om-1)
mesh = numpy.zeros([n_om],numpy.float_)
DOS = {}
for bn in self.block_names[self.SO]:
DOS[bn] = numpy.zeros([n_om],numpy.float_)
DOSproj = [ {} for icrsh in range(self.n_inequiv_corr_shells) ]
DOSproj_orb = [ {} for icrsh in range(self.n_inequiv_corr_shells) ]
for icrsh in range(self.n_inequiv_corr_shells):
for bn in self.block_names[self.corr_shells[self.invshellmap[icrsh]][4]]:
dl = self.corr_shells[self.invshellmap[icrsh]][3]
DOSproj[icrsh][bn] = numpy.zeros([n_om],numpy.float_)
DOSproj_orb[icrsh][bn] = numpy.zeros([dl,dl,n_om],numpy.float_)
for i in range(n_om): mesh[i] = om_min + delta_om * i
# init:
Gloc = []
for icrsh in range(self.n_corr_shells):
b_list = [a for a,al in self.gf_struct_corr[icrsh]]
glist = lambda : [ GfReFreq(indices = al, beta = beta, mesh_array = mesh) for a,al in self.gf_struct_corr[icrsh]]
Gloc.append(BlockGf(name_list = b_list, block_list = glist(),make_copies=False))
for icrsh in xrange(self.n_corr_shells): Gloc[icrsh].zero() # initialize to zero
for ik in xrange(self.n_k):
Gupf=self.lattice_gf_realfreq(ik=ik,mu=self.chemical_potential,broadening=broadening,beta=beta,mesh=mesh,with_Sigma=False)
Gupf *= self.bz_weights[ik]
# non-projected DOS
for iom in range(n_om):
for sig,gf in Gupf:
asd = gf.data[iom,:,:].imag.trace()/(-3.1415926535)
DOS[sig][iom] += asd
for icrsh in xrange(self.n_corr_shells):
tmp = Gloc[icrsh].copy()
for sig,gf in tmp: tmp[sig] <<= self.downfold(ik,icrsh,sig,Gupf[sig],gf) # downfolding G
Gloc[icrsh] += tmp
if (self.symm_op!=0): Gloc = self.Symm_corr.symmetrize(Gloc)
if (self.use_rotations):
for icrsh in xrange(self.n_corr_shells):
for sig,gf in Gloc[icrsh]: Gloc[icrsh][sig] <<= self.rotloc(icrsh,gf,direction='toLocal')
# Gloc can now also be used to look at orbitally resolved quantities
for ish in range(self.n_inequiv_corr_shells):
for sig,gf in Gloc[self.invshellmap[ish]]: # loop over spins
for iom in range(n_om): DOSproj[ish][sig][iom] += gf.data[iom,:,:].imag.trace()/(-3.1415926535)
DOSproj_orb[ish][sig][:,:,:] += gf.data[:,:,:].imag/(-3.1415926535)
# output:
if (mpi.is_master_node()):
for bn in self.block_names[self.SO]:
f=open('DOS%s.dat'%bn, 'w')
for i in range(n_om): f.write("%s %s\n"%(mesh[i],DOS[bn][i]))
f.close()
for ish in range(self.n_inequiv_corr_shells):
f=open('DOS%s_proj%s.dat'%(bn,ish),'w')
for i in range(n_om): f.write("%s %s\n"%(mesh[i],DOSproj[ish][bn][i]))
f.close()
for i in range(self.corr_shells[self.invshellmap[ish]][3]):
for j in range(i,self.corr_shells[self.invshellmap[ish]][3]):
Fname = 'DOS'+bn+'_proj'+str(ish)+'_'+str(i)+'_'+str(j)+'.dat'
f=open(Fname,'w')
for iom in range(n_om): f.write("%s %s\n"%(mesh[iom],DOSproj_orb[ish][bn][i,j,iom]))
f.close()
def read_par_proj_input_from_hdf(self):
"""
Reads the data for the partial projectors from the HDF file
"""
thingstoread = ['dens_mat_below','n_parproj','proj_mat_pc','rot_mat_all','rot_mat_all_time_inv']
retval = self.read_input_from_hdf(subgrp=self.par_proj_data,things_to_read = thingstoread)
return retval
def dos_partial(self,broadening=0.01):
"""calculates the orbitally-resolved DOS"""
assert hasattr(self,"Sigma_imp"), "Set Sigma First!!"
#thingstoread = ['Dens_Mat_below','N_parproj','Proj_Mat_pc','rotmat_all']
#retval = self.read_input_from_HDF(SubGrp=self.par_proj_data, thingstoread=thingstoread)
retval = self.read_par_proj_input_from_hdf()
if not retval: return retval
if self.symm_op: self.Symm_par = Symmetry(self.hdf_file,subgroup=self.symm_par_data)
mu = self.chemical_potential
gf_struct_proj = [ [ (al, range(self.shells[i][3])) for al in self.block_names[self.SO] ] for i in xrange(self.n_shells) ]
Gproj = [BlockGf(name_block_generator = [ (a,GfReFreq(indices = al, mesh = self.Sigma_imp[0].mesh)) for a,al in gf_struct_proj[ish] ], make_copies = False )
for ish in xrange(self.n_shells)]
for ish in range(self.n_shells): Gproj[ish].zero()
Msh = [x for x in self.Sigma_imp[0].mesh]
n_om = len(Msh)
DOS = {}
for bn in self.block_names[self.SO]:
DOS[bn] = numpy.zeros([n_om],numpy.float_)
DOSproj = [ {} for ish in range(self.n_shells) ]
DOSproj_orb = [ {} for ish in range(self.n_shells) ]
for ish in range(self.n_shells):
for bn in self.block_names[self.SO]:
dl = self.shells[ish][3]
DOSproj[ish][bn] = numpy.zeros([n_om],numpy.float_)
DOSproj_orb[ish][bn] = numpy.zeros([dl,dl,n_om],numpy.float_)
ikarray=numpy.array(range(self.n_k))
for ik in mpi.slice_array(ikarray):
S = self.lattice_gf_realfreq(ik=ik,mu=mu,broadening=broadening)
S *= self.bz_weights[ik]
# non-projected DOS
for iom in range(n_om):
for sig,gf in S: DOS[sig][iom] += gf.data[iom,:,:].imag.trace()/(-3.1415926535)
#projected DOS:
for ish in xrange(self.n_shells):
tmp = Gproj[ish].copy()
for ir in xrange(self.n_parproj[ish]):
for sig,gf in tmp: tmp[sig] <<= self.downfold_pc(ik,ir,ish,sig,S[sig],gf)
Gproj[ish] += tmp
# collect data from mpi:
for sig in DOS:
DOS[sig] = mpi.all_reduce(mpi.world,DOS[sig],lambda x,y : x+y)
for ish in xrange(self.n_shells):
Gproj[ish] <<= mpi.all_reduce(mpi.world,Gproj[ish],lambda x,y : x+y)
mpi.barrier()
if (self.symm_op!=0): Gproj = self.Symm_par.symmetrize(Gproj)
# rotation to local coord. system:
if (self.use_rotations):
for ish in xrange(self.n_shells):
for sig,gf in Gproj[ish]: Gproj[ish][sig] <<= self.rotloc_all(ish,gf,direction='toLocal')
for ish in range(self.n_shells):
for sig,gf in Gproj[ish]:
for iom in range(n_om): DOSproj[ish][sig][iom] += gf.data[iom,:,:].imag.trace()/(-3.1415926535)
DOSproj_orb[ish][sig][:,:,:] += gf.data[:,:,:].imag / (-3.1415926535)
if (mpi.is_master_node()):
# output to files
for bn in self.block_names[self.SO]:
f=open('./DOScorr%s.dat'%bn, 'w')
for i in range(n_om): f.write("%s %s\n"%(Msh[i],DOS[bn][i]))
f.close()
# partial
for ish in range(self.n_shells):
f=open('DOScorr%s_proj%s.dat'%(bn,ish),'w')
for i in range(n_om): f.write("%s %s\n"%(Msh[i],DOSproj[ish][bn][i]))
f.close()
for i in range(self.shells[ish][3]):
for j in range(i,self.shells[ish][3]):
Fname = './DOScorr'+bn+'_proj'+str(ish)+'_'+str(i)+'_'+str(j)+'.dat'
f=open(Fname,'w')
for iom in range(n_om): f.write("%s %s\n"%(Msh[iom],DOSproj_orb[ish][bn][i,j,iom]))
f.close()
def spaghettis(self,broadening,shift=0.0,plot_range=None, ishell=None, invert_Akw=False, fermi_surface=False):
""" Calculates the correlated band structure with a real-frequency self energy.
ATTENTION: Many things from the original input file are are overwritten!!!"""
assert hasattr(self,"Sigma_imp"), "Set Sigma First!!"
thingstoread = ['n_k','n_orbitals','proj_mat','hopping','n_parproj','proj_mat_pc']
retval = self.read_input_from_hdf(subgrp=self.bands_data,things_to_read=thingstoread)
if not retval: return retval
if fermi_surface: ishell=None
# print hamiltonian for checks:
if ((self.SP==1)and(self.SO==0)):
f1=open('hamup.dat','w')
f2=open('hamdn.dat','w')
for ik in xrange(self.n_k):
for i in xrange(self.n_orbitals[ik,0]):
f1.write('%s %s\n'%(ik,self.hopping[ik,0,i,i].real))
for i in xrange(self.n_orbitals[ik,1]):
f2.write('%s %s\n'%(ik,self.hopping[ik,1,i,i].real))
f1.write('\n')
f2.write('\n')
f1.close()
f2.close()
else:
f=open('ham.dat','w')
for ik in xrange(self.n_k):
for i in xrange(self.n_orbitals[ik,0]):
f.write('%s %s\n'%(ik,self.hopping[ik,0,i,i].real))
f.write('\n')
f.close()
#=========================================
# calculate A(k,w):
mu = self.chemical_potential
bln = self.block_names[self.SO]
# init DOS:
M = [x for x in self.Sigma_imp[0].mesh]
n_om = len(M)
if plot_range is None:
om_minplot = M[0]-0.001
om_maxplot = M[n_om-1] + 0.001
else:
om_minplot = plot_range[0]
om_maxplot = plot_range[1]
if (ishell is None):
Akw = {}
for ibn in bln: Akw[ibn] = numpy.zeros([self.n_k, n_om ],numpy.float_)
else:
Akw = {}
for ibn in bln: Akw[ibn] = numpy.zeros([self.shells[ishell][3],self.n_k, n_om ],numpy.float_)
if fermi_surface:
om_minplot = -2.0*broadening
om_maxplot = 2.0*broadening
Akw = {}
for ibn in bln: Akw[ibn] = numpy.zeros([self.n_k,1],numpy.float_)
if not (ishell is None):
GFStruct_proj = [ (al, range(self.shells[ishell][3])) for al in bln ]
Gproj = BlockGf(name_block_generator = [ (a,GfReFreq(indices = al, mesh = self.Sigma_imp[0].mesh)) for a,al in GFStruct_proj ], make_copies = False)
Gproj.zero()
for ik in xrange(self.n_k):
S = self.lattice_gf_realfreq(ik=ik,mu=mu,broadening=broadening)
if (ishell is None):
# non-projected A(k,w)
for iom in range(n_om):
if (M[iom]>om_minplot) and (M[iom]<om_maxplot):
if fermi_surface:
for sig,gf in S: Akw[sig][ik,0] += gf.data[iom,:,:].imag.trace()/(-3.1415926535) * (M[1]-M[0])
else:
for sig,gf in S: Akw[sig][ik,iom] += gf.data[iom,:,:].imag.trace()/(-3.1415926535)
Akw[sig][ik,iom] += ik*shift # shift Akw for plotting in xmgrace
else:
# projected A(k,w):
Gproj.zero()
tmp = Gproj.copy()
for ir in xrange(self.n_parproj[ishell]):
for sig,gf in tmp: tmp[sig] <<= self.downfold_pc(ik,ir,ishell,sig,S[sig],gf)
Gproj += tmp
# TO BE FIXED:
# rotate to local frame
#if (self.use_rotations):
# for sig,gf in Gproj: Gproj[sig] <<= self.rotloc(0,gf,direction='toLocal')
for iom in range(n_om):
if (M[iom]>om_minplot) and (M[iom]<om_maxplot):
for ish in range(self.shells[ishell][3]):
for ibn in bln:
Akw[ibn][ish,ik,iom] = Gproj[ibn].data[iom,ish,ish].imag/(-3.1415926535)
# END k-LOOP
if (mpi.is_master_node()):
if (ishell is None):
for ibn in bln:
# loop over GF blocs:
if (invert_Akw):
maxAkw=Akw[ibn].max()
minAkw=Akw[ibn].min()
# open file for storage:
if fermi_surface:
f=open('FS_'+ibn+'.dat','w')
else:
f=open('Akw_'+ibn+'.dat','w')
for ik in range(self.n_k):
if fermi_surface:
if (invert_Akw):
Akw[ibn][ik,0] = 1.0/(minAkw-maxAkw)*(Akw[ibn][ik,0] - maxAkw)
f.write('%s %s\n'%(ik,Akw[ibn][ik,0]))
else:
for iom in range(n_om):
if (M[iom]>om_minplot) and (M[iom]<om_maxplot):
if (invert_Akw):
Akw[ibn][ik,iom] = 1.0/(minAkw-maxAkw)*(Akw[ibn][ik,iom] - maxAkw)
if (shift>0.0001):
f.write('%s %s\n'%(M[iom],Akw[ibn][ik,iom]))
else:
f.write('%s %s %s\n'%(ik,M[iom],Akw[ibn][ik,iom]))
f.write('\n')
f.close()
else:
for ibn in bln:
for ish in range(self.shells[ishell][3]):
if (invert_Akw):
maxAkw=Akw[ibn][ish,:,:].max()
minAkw=Akw[ibn][ish,:,:].min()
f=open('Akw_'+ibn+'_proj'+str(ish)+'.dat','w')
for ik in range(self.n_k):
for iom in range(n_om):
if (M[iom]>om_minplot) and (M[iom]<om_maxplot):
if (invert_Akw):
Akw[ibn][ish,ik,iom] = 1.0/(minAkw-maxAkw)*(Akw[ibn][ish,ik,iom] - maxAkw)
if (shift>0.0001):
f.write('%s %s\n'%(M[iom],Akw[ibn][ish,ik,iom]))
else:
f.write('%s %s %s\n'%(ik,M[iom],Akw[ibn][ish,ik,iom]))
f.write('\n')
f.close()
def constr_Sigma_ME(self, filename, beta, n_om, orb = 0):
"""Uses Data from files to construct a GF object on the real axis."""
#first get the mesh out of one of the files:
if (len(self.gf_struct_solver[orb][0][1])==1):
Fname = filename+'_'+self.gf_struct_solver[orb][0][0]+'.dat'
else:
Fname = filename+'_'+self.gf_struct_solver[orb][0][0]+'/'+str(self.gf_struct_solver[orb][0][1][0])+'_'+str(self.gf_struct_solver[orb][0][1][0])+'.dat'
R = read_fortran_file(Fname)
mesh = numpy.zeros([n_om],numpy.float_)
try:
for i in xrange(n_om):
mesh[i] = R.next()
sk = R.next()
sk = R.next()
except StopIteration : # a more explicit error if the file is corrupted.
raise "SumkLDA.read_Sigma_ME : reading file failed!"
R.close()
# now initialize the GF with the mesh
a_list = [a for a,al in self.gf_struct_solver[orb]]
glist = lambda : [ GfReFreq(indices = al, beta = beta, mesh_array = mesh) for a,al in self.gf_struct_solver[orb] ]
SigmaME = BlockGf(name_list = a_list, block_list = glist(),make_copies=False)
SigmaME.load(filename)
return SigmaME
def partial_charges(self,beta=40):
"""Calculates the orbitally-resolved density matrix for all the orbitals considered in the input.
The theta-projectors are used, hence case.parproj data is necessary"""
#thingstoread = ['Dens_Mat_below','N_parproj','Proj_Mat_pc','rotmat_all']
#retval = self.read_input_from_HDF(SubGrp=self.par_proj_data,thingstoread=thingstoread)
retval = self.read_par_proj_input_from_hdf()
if not retval: return retval
if self.symm_op: self.Symm_par = Symmetry(self.hdf_file,subgroup=self.symm_par_data)
# Density matrix in the window
bln = self.block_names[self.SO]
ntoi = self.names_to_ind[self.SO]
self.dens_mat_window = [ [numpy.zeros([self.shells[ish][3],self.shells[ish][3]],numpy.complex_) for ish in range(self.n_shells)]
for isp in range(len(bln)) ] # init the density matrix
mu = self.chemical_potential
GFStruct_proj = [ [ (al, range(self.shells[i][3])) for al in bln ] for i in xrange(self.n_shells) ]
if hasattr(self,"Sigma_imp"):
Gproj = [BlockGf(name_block_generator = [ (a,GfImFreq(indices = al, mesh = self.Sigma_imp[0].mesh)) for a,al in GFStruct_proj[ish] ], make_copies = False)
for ish in xrange(self.n_shells)]
beta = self.Sigma_imp[0].mesh.beta
else:
Gproj = [BlockGf(name_block_generator = [ (a,GfImFreq(indices = al, beta = beta)) for a,al in GFStruct_proj[ish] ], make_copies = False)
for ish in xrange(self.n_shells)]
for ish in xrange(self.n_shells): Gproj[ish].zero()
ikarray=numpy.array(range(self.n_k))
#print mpi.rank, mpi.slice_array(ikarray)
#print "K-Sum starts on node",mpi.rank," at ",datetime.now()
for ik in mpi.slice_array(ikarray):
#print mpi.rank, ik, datetime.now()
S = self.lattice_gf_matsubara(ik=ik,mu=mu,beta=beta)
S *= self.bz_weights[ik]
for ish in xrange(self.n_shells):
tmp = Gproj[ish].copy()
for ir in xrange(self.n_parproj[ish]):
for sig,gf in tmp: tmp[sig] <<= self.downfold_pc(ik,ir,ish,sig,S[sig],gf)
Gproj[ish] += tmp
#print "K-Sum done on node",mpi.rank," at ",datetime.now()
#collect data from mpi:
for ish in xrange(self.n_shells):
Gproj[ish] <<= mpi.all_reduce(mpi.world,Gproj[ish],lambda x,y : x+y)
mpi.barrier()
#print "Data collected on node",mpi.rank," at ",datetime.now()
# Symmetrisation:
if (self.symm_op!=0): Gproj = self.Symm_par.symmetrize(Gproj)
#print "Symmetrisation done on node",mpi.rank," at ",datetime.now()
for ish in xrange(self.n_shells):
# Rotation to local:
if (self.use_rotations):
for sig,gf in Gproj[ish]: Gproj[ish][sig] <<= self.rotloc_all(ish,gf,direction='toLocal')
isp = 0
for sig,gf in Gproj[ish]: #dmg.append(Gproj[ish].density()[sig])
self.dens_mat_window[isp][ish] = Gproj[ish].density()[sig]
isp+=1
# add Density matrices to get the total:
dens_mat = [ [ self.dens_mat_below[ntoi[bln[isp]]][ish]+self.dens_mat_window[isp][ish] for ish in range(self.n_shells)]
for isp in range(len(bln)) ]
return dens_mat

176
python/symmetry.py Normal file
View File

@ -0,0 +1,176 @@
################################################################################
#
# TRIQS: a Toolbox for Research in Interacting Quantum Systems
#
# Copyright (C) 2011 by M. Aichhorn, L. Pourovskii, V. Vildosola
#
# TRIQS is free software: you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.
#
# TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# TRIQS. If not, see <http://www.gnu.org/licenses/>.
#
################################################################################
import copy,numpy
import string
from types import *
from pytriqs.gf.local import *
from pytriqs.archive import *
import pytriqs.utility.mpi as mpi
class Symmetry:
"""This class provides the routines for applying symmetry operations for the k sums.
It contains the permutations of the atoms in the unti cell, and the corresponding
rotational matrices for each symmetry operation."""
def __init__(self, hdf_file, subgroup = None):
"""Initialises the class.
Reads the permutations and rotation matrizes from the file, and constructs the mapping for
the given orbitals. For each orbit a matrix is read!!!
SO: Flag for SO coupled calculations.
SP: Spin polarisation yes/no
"""
assert type(hdf_file)==StringType,"hdf_file must be a filename"; self.hdf_file = hdf_file
thingstoread = ['n_s','n_atoms','perm','orbits','SO','SP','time_inv','mat','mat_tinv']
for it in thingstoread: exec "self.%s = 0"%it
if (mpi.is_master_node()):
#Read the stuff on master:
ar = HDFArchive(hdf_file,'a')
if (subgroup is None):
ar2 = ar
else:
ar2 = ar[subgroup]
for it in thingstoread: exec "self.%s = ar2['%s']"%(it,it)
del ar2
del ar
#broadcasting
for it in thingstoread: exec "self.%s = mpi.bcast(self.%s)"%(it,it)
# now define the mapping of orbitals:
# self.map[iorb]=jorb gives the permutation of the orbitals as given in the list, when the
# permutation of the atoms is done:
self.n_orbits = len(self.orbits)
self.map = [ [0 for iorb in range(self.n_orbits)] for in_s in range(self.n_s) ]
for in_s in range(self.n_s):
for iorb in range(self.n_orbits):
srch = copy.deepcopy(self.orbits[iorb])
srch[0] = self.perm[in_s][self.orbits[iorb][0]-1]
self.map[in_s][iorb] = self.orbits.index(srch)
def symmetrize(self,obj):
assert isinstance(obj,list),"obj has to be a list of objects!"
assert len(obj)==self.n_orbits,"obj has to be a list of the same length as defined in the init"
if (isinstance(obj[0],BlockGf)):
symm_obj = [ obj[i].copy() for i in range(len(obj)) ] # here the result is stored, it is a BlockGf!
for iorb in range(self.n_orbits): symm_obj[iorb].zero() # set to zero
else:
# if not a BlockGf, we assume it is a matrix (density matrix), has to be complex since self.mat is complex!
#symm_obj = [ numpy.zeros([self.orbits[iorb][3],self.orbits[iorb][3]],numpy.complex_) for iorb in range(self.n_orbits) ]
symm_obj = [ copy.deepcopy(obj[i]) for i in range(len(obj)) ]
for iorb in range(self.n_orbits):
if (type(symm_obj[iorb])==DictType):
for ii in symm_obj[iorb]: symm_obj[iorb][ii] *= 0.0
else:
symm_obj[iorb] *= 0.0
for in_s in range(self.n_s):
for iorb in range(self.n_orbits):
l = self.orbits[iorb][2] # s, p, d, or f
dim = self.orbits[iorb][3]
jorb = self.map[in_s][iorb]
if (isinstance(obj[0],BlockGf)):
#if l==0:
# symm_obj[jorb] += obj[iorb]
#else:
tmp = obj[iorb].copy()
if (self.time_inv[in_s]): tmp <<= tmp.transpose()
for sig,gf in tmp: tmp[sig].from_L_G_R(self.mat[in_s][iorb],tmp[sig],self.mat[in_s][iorb].conjugate().transpose())
tmp *= 1.0/self.n_s
symm_obj[jorb] += tmp
else:
if (type(obj[iorb])==DictType):
for ii in obj[iorb]:
#if (l==0):
# symm_obj[jorb][ii] += obj[iorb][ii]/self.n_s
#else:
if (self.time_inv[in_s]==0):
symm_obj[jorb][ii] += numpy.dot(numpy.dot(self.mat[in_s][iorb],obj[iorb][ii]),
self.mat[in_s][iorb].conjugate().transpose()) / self.n_s
else:
symm_obj[jorb][ii] += numpy.dot(numpy.dot(self.mat[in_s][iorb],obj[iorb][ii].conjugate()),
self.mat[in_s][iorb].conjugate().transpose()) / self.n_s
else:
#if (l==0):
# symm_obj[jorb] += obj[iorb]/self.n_s
#else:
if (self.time_inv[in_s]==0):
symm_obj[jorb] += numpy.dot(numpy.dot(self.mat[in_s][iorb],obj[iorb]),self.mat[in_s][iorb].conjugate().transpose()) / self.n_s
else:
symm_obj[jorb] += numpy.dot(numpy.dot(self.mat[in_s][iorb],obj[iorb].conjugate()),
self.mat[in_s][iorb].conjugate().transpose()) / self.n_s
# This does not what it is supposed to do, check how this should work:
# if ((self.SO==0) and (self.SP==0)):
# # add time inv:
#mpi.report("Add time inversion")
# for iorb in range(self.n_orbits):
# if (isinstance(symm_obj[0],BlockGf)):
# tmp = symm_obj[iorb].copy()
# tmp <<= tmp.transpose()
# for sig,gf in tmp: tmp[sig].from_L_G_R(self.mat_tinv[iorb],tmp[sig],self.mat_tinv[iorb].transpose().conjugate())
# symm_obj[iorb] += tmp
# symm_obj[iorb] /= 2.0
#
# else:
# if (type(symm_obj[iorb])==DictType):
# for ii in symm_obj[iorb]:
# symm_obj[iorb][ii] += numpy.dot(numpy.dot(self.mat_tinv[iorb],symm_obj[iorb][ii].conjugate()),
# self.mat_tinv[iorb].transpose().conjugate())
# symm_obj[iorb][ii] /= 2.0
# else:
# symm_obj[iorb] += numpy.dot(numpy.dot(self.mat_tinv[iorb],symm_obj[iorb].conjugate()),
# self.mat_tinv[iorb].transpose().conjugate())
# symm_obj[iorb] /= 2.0
return symm_obj

10
test/CMakeLists.txt Normal file
View File

@ -0,0 +1,10 @@
# load triqs helper to set up tests
find_package(TriqsTest)
FILE(COPY SrVO3.h5 SrVO3.ctqmcout SrVO3.symqmc SrVO3.sympar SrVO3.parproj DESTINATION ${CMAKE_CURRENT_BINARY_DIR})
triqs_add_test_hdf(wien2k_convert " -p 1.e-6" )
triqs_add_test_hdf(sumklda_basic " -d 1.e-6" )
triqs_add_test_hdf(srvo3_Gloc " -d 1.e-6" )
triqs_add_test_hdf(U_mat " -d 1.e-6" )

144
test/SrVO3.ctqmcout Normal file
View File

@ -0,0 +1,144 @@
13.605698
10
0
0
40.000000558793545
40.999999999899998
4
2 2 2 5
3 3 1 3
4 3 1 3
5 3 1 3
1
2 2 2 3 0 2
0.99999996577145822 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.99999996577145822 0.0000000000000000
0.0000000000000000 0.0000000000000000 0.99999996577145822
0.0000000000000000 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.0000000000000000 2.44921262381177494E-016
0.0000000000000000 2.44921262381177494E-016 0.0000000000000000
2 2 3
0.0000000000000000 0.0000000000000000 1.0000000000000000 0.0000000000000000 0.0000000000000000
0.70710676908493042 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.70710676908493042
-0.70710676908493042 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.70710676908493042
0.0000000000000000 0.70710676908493042 0.0000000000000000 -0.70710676908493042 0.0000000000000000
0.0000000000000000 0.70710676908493042 0.0000000000000000 0.70710676908493042 0.0000000000000000
-0.0000000000000000 -0.0000000000000000 -0.0000000000000000 -0.0000000000000000 -0.0000000000000000
-0.0000000000000000 -0.0000000000000000 -0.0000000000000000 -0.0000000000000000 -0.0000000000000000
-0.0000000000000000 -0.0000000000000000 -0.0000000000000000 -0.0000000000000000 -0.0000000000000000
-0.0000000000000000 -0.0000000000000000 -0.0000000000000000 -0.0000000000000000 -0.0000000000000000
-0.0000000000000000 -0.0000000000000000 -0.0000000000000000 -0.0000000000000000 -0.0000000000000000
5
4
4
3
3
3
3
3
3
3
-0.46708618649548778 0.19645730518187726 -0.63056665528388278 6.83053983665041654E-003 -9.08691151343342385E-003
0.33935797752807517 -0.32538794744732463 -0.35267852306925346 -3.23618480665549069E-003 -7.59881871370310900E-003
0.46708618649568096 0.64431539484614131 -0.14514631059489275 1.12847661308980683E-002 1.37196526338472175E-003
-0.33935797752757074 0.14273458662350322 -0.45813349010965299 4.96267764149193984E-003 -6.60202761075715308E-003
-0.46708618649618328 0.44785808966386337 0.48542034468820755 4.45422629424984794E-003 1.04588767768159212E-002
0.33935797752771030 0.46812253407111870 -0.10545496703983014 8.19886244814681947E-003 9.96791102947829641E-004
0.99826715704840852 5.88445536524223808E-002 -3.49963547724430057E-013 -4.08006961549745029E-015
-5.73331637397004314E-017 -2.22963225794033998E-016 6.67419027347909574E-016 -5.52608570410996464E-017
-4.16093832710137529E-002 0.70588146512886052 0.70589348533334861 -4.14051797814691258E-002
-2.37410433123357658E-016 -1.15179437842109803E-016 5.46535311198398768E-017 1.62250970413085672E-018
4.16093832710091732E-002 -0.70588146512038852 0.70589348534182028 -4.14051797814873335E-002
-4.60501593104564975E-017 2.25474017253259800E-016 -2.24885400355293418E-016 -1.23616057093388723E-017
-0.80901699302050045 5.28329945561139539E-015 -1.00485967602252993E-014 3.28854063015805595E-016
-2.41765092694703728E-015 0.41562693759835523 0.41562693091774439 -1.14174156173996546E-015
-1.07540656458753083E-014 -0.57206140619004631 0.57206139701899683 1.67465711372787897E-014
0.58778524906798113 -3.70392842145962037E-015 7.30564534122176327E-015 -3.94624875618954910E-016
-3.46340437064908524E-015 0.57206140619033075 0.57206139701871328 -1.53174293258064799E-015
7.90499832123160669E-015 0.41562693759814934 -0.41562693091795117 -1.20899404781238648E-014
-0.57178804263232708 -0.57206141562539525 -1.76831731114629846E-002
-0.41542832776788530 0.41562694478460188 -1.28475772191668849E-002
2.50077774151022392E-002 3.10030734639631734E-014 -0.80863039610344722
0.41542832776748106 0.41562694478500528 1.28475772191862844E-002
-0.57178804263288330 0.57206141562483992 -1.76831731114364156E-002
-1.81692137263105395E-002 -2.24502870808414751E-014 0.58750436871445022
-0.30901699755010820 8.30685616456098959E-015 1.13094225530553555E-014
2.77559360298106587E-014 0.94947206837583287 5.48754814934267268E-002
1.06369999682261657E-014 -1.78301216293698939E-002 0.30850216700265437
0.95105652571985522 -2.58598085453039374E-014 -3.45268162554044509E-014
9.10854694143261225E-015 0.30850217616971171 1.78301247853450730E-002
-3.30338201117143659E-014 5.48754717811704498E-002 -0.94947204014807729
-1.48156062447880746E-003 0.30901343690548655 4.10927180414781041E-015
0.95104556712349397 4.55977474133240947E-003 -5.97388470915485219E-015
-1.75496203951254199E-015 4.25836636595950224E-015 -0.30901699312287373
-4.55977474133809502E-003 0.95104556712349708 1.29149252058973871E-014
-0.30901343690548577 -1.48156062447705691E-003 2.19628991981426472E-015
-6.18552465852348384E-015 1.28342536232335992E-014 -0.95105651199665908
0.17841104221945517 0.24977702070023830 3.56713339103273616E-002
0.54909272726567093 -0.47944397783425541 0.61085117483420970
-0.17841104221968385 9.39962289969131642E-002 0.23414891216298114
-0.54909272726562619 -0.76873462425507377 -0.10978507707937714
0.17841104221946952 -0.15578079170319165 0.19847757825293733
0.54909272726632985 -0.28929064642040853 -0.72063625191271308
-0.30901699537826771 -2.11675140892306026E-014 3.44721631930676906E-015
-5.37370006947479601E-014 0.67249851215815792 -0.67249852437822588
-1.26814506226421840E-014 0.21850801238703932 0.21850801635742351
-0.95105651898278010 -6.54767957184185343E-014 1.05752817797426024E-014
1.75281540921277077E-014 -0.21850801238656717 0.21850801635789530
-3.87720729467512397E-014 0.67249851215961043 0.67249852437677304
7.19230203862877421E-002 0.80581361060730794 1.37190868566293966E-015
0.58545785368647119 -5.22551326903864244E-002 8.46043775456040912E-015
-1.17881563119053437E-014 -3.96851412450703462E-016 0.80901698213359652
5.22551326903867436E-002 0.58545785368647141 1.07178199520420086E-015
-0.80581361060730761 7.19230203862874784E-002 -1.18435083685779214E-014
-8.70172955532340337E-015 -2.00759389631078690E-016 0.58778523914547964
-0.76240262055144414 0.60075375721974744 -0.24049351322467949
8.00999090849681899E-017 -5.62259099552636245E-017 2.83358748161481193E-017
-0.38253927615517225 -0.11866388983419603 0.91628737085512313
-2.63580298927137477E-017 -1.00122764526663028E-016 1.81720663439987169E-017
0.52192519475061538 0.79057812199445354 0.32028157400755408
-7.72358669497583500E-019 -1.16991835722606990E-018 -4.73961120967276270E-019
0.12800000607967377
0.38400000333786011
0.19200000166893005
0.38400000333786011
0.38400000333786011
9.60000008344650269E-002
0.12800000607967377
0.19200000166893005
9.60000008344650269E-002
1.60000007599592209E-002
-4.74549500865790730E-002
-4.11531615285409824E-002
-4.11531615285409824E-002
0.12907948625126198
0.12907948625126198
-3.93779894118470031E-002
2.74007323726870311E-002
2.82756371285759478E-002
0.12939984622214795
-3.65958535778190264E-002
6.68520221825620320E-002
6.85164156244559841E-002
0.12896064023265197
2.57618807855359844E-002
3.43283643776219893E-002
5.13251111589240194E-002
3.17279643821369861E-002
6.86994690914339845E-002
7.79247028501099948E-002
6.95685007827629986E-002
6.95685007827629986E-002
9.40738009384869400E-002
5.71698495686069341E-002
6.18165727833269729E-002
6.18165727833269729E-002
6.56165915190369819E-002
8.52776906906369536E-002
8.74546342278249567E-002
9.18198298086789766E-002
9.18198298086789766E-002
0.10357757356761899
0.11030741646618503
0.11030741646618503
0.11030741646622499

BIN
test/SrVO3.h5 Normal file

Binary file not shown.

620
test/SrVO3.parproj Normal file
View File

@ -0,0 +1,620 @@
2
2
2
2
1.12192725451350996E-014 6.61073466263034214E-003 -2.12183957288695213E-002 -0.31091873505993201 0.41362631664894800
1.04360964314764715E-014 -2.12183953657400642E-002 -6.61073454948429839E-003 0.41362630957003543 0.31091872973878382
-0.38765847172758239 0.16202659294907901 -0.52005481134111453 5.63343316101602709E-003 -7.49435767526351881E-003
0.28165036505177354 -0.26836111012912139 -0.29086879434858337 -2.66901756537143379E-003 -6.26706502707642232E-003
0.38765847172774071 0.53139397445624725 -0.11970826008758886 9.30702071233161302E-003 1.13151739033028140E-003
-1.54083428710300797E-014 -9.09889570516930583E-003 2.92046163733298385E-002 0.42794292907813802 -0.56930778859766096
-1.46549439250520663E-014 2.92046158735241451E-002 9.09889554943746348E-003 -0.56930777885437389 -0.42794292175420651
-0.28165036505135904 0.11771921000947748 -0.37784193593421012 4.09292873793165590E-003 -5.44496952829737202E-003
-0.38765847172815388 0.36936738150683501 0.40034655125287377 3.67358755131741172E-003 8.62587506559191024E-003
0.28165036505147351 0.38608032013884064 -8.69731415851523193E-002 6.76194630330257795E-003 8.22095498780636702E-004
4.26769777578522545E-016 3.77981355810454124E-004 -1.21320222260026659E-003 -3.73225730009532353E-002 4.96515541119442530E-002
2.94902990916057206E-016 -1.21320220183724920E-003 -3.77981349341560344E-004 4.96515532621950098E-002 3.73225723622038347E-002
-2.07657547403230780E-002 9.04791573770536914E-003 -2.90409865834865000E-002 6.68904153342864127E-004 -8.89867125843057244E-004
1.50872035787772939E-002 -1.49858650828965916E-002 -1.62427428729717063E-002 -3.16914544739255719E-004 -7.44140497865150921E-004
2.07657547403318037E-002 2.96741900011138690E-002 -6.68476841156730346E-003 1.10509961364398113E-003 1.34354426570527648E-004
-5.87398220320796958E-016 -5.20246717040900647E-004 1.66982964559507377E-003 5.13701159509106706E-002 -6.83395030618155486E-002
-4.11996825544491685E-016 1.66982961701722709E-003 5.20246708137233130E-004 -6.83395018922359626E-002 -5.13701150717472618E-002
-1.50872035787543157E-002 6.57369541368531263E-003 -2.10995112959769457E-002 4.85987302766416329E-004 -6.46526295505302218E-004
-2.07657547403547089E-002 2.06262742633910832E-002 2.23562181718840423E-002 4.36195460301456680E-004 1.02422155241345186E-003
1.50872035787606544E-002 2.15595604965945660E-002 -4.85676842297969036E-003 8.02901847505403383E-004 9.76142023598206769E-005
4.38558201034523900E-017 5.01022241662824700E-017 4.05146406197567194E-017 1.02071487715999598E-017
0.0000000000000000 0.0000000000000000 8.62167273785022528E-017 3.41993018601457798E-016
0.83570562902110612 4.82982532177768861E-002 -2.86896737200228569E-013 -3.44504753214828034E-015
-5.89805981832114412E-017 0.0000000000000000 7.21644966006351751E-016 -5.55111512312578270E-017
-3.46259351716538405E-002 0.57584904099953071 0.57088641994100753 -3.34861496013032708E-002
-2.57998102479547915E-002 1.02827532877326107E-002 -7.80009446007697982E-014 -1.78747719386812387E-014
1.01734485776558272E-014 4.21735882978209737E-013 7.22791578786721456E-002 0.88157167326580477
-2.00225103946549423E-016 -6.99661828217457239E-017 6.93889390390722838E-017 0.0000000000000000
3.46259351716506972E-002 -0.57584904099268142 0.57088641994792111 -3.34861496013182727E-002
-6.24500451351650554E-017 0.0000000000000000 0.0000000000000000 -2.08166817117216851E-017
-6.33608870479360267E-018 1.64479862787327824E-017 1.48328853860066325E-017 3.73695695015249611E-018
0.0000000000000000 0.0000000000000000 4.98280720033578408E-017 4.18555804828206514E-017
4.72039233350999149E-002 3.90414630826862834E-003 -2.33335588244030838E-014 -5.08178996989620493E-016
-1.08420217248550443E-018 -3.46944695195361419E-018 3.46944695195361419E-018 -5.20417042793042128E-018
-1.95576235435646843E-003 4.65484343086274427E-002 4.63309671677722690E-002 -3.98015727584843070E-003
-1.49208288743942603E-003 8.45966747000719390E-004 -7.25322352371600908E-015 -2.61998300409755365E-015
8.02038957998634593E-017 3.44487697891673635E-014 5.96195185599895493E-003 0.10592900356543820
-7.41701108731754904E-018 -3.30662688923062122E-018 1.64798730217796674E-017 0.0000000000000000
1.95576235435593934E-003 -4.65484343080733165E-002 4.63309671683329594E-002 -3.98015727584998501E-003
-1.08420217248550443E-018 -3.46944695195361419E-018 -2.77555756156289135E-017 -2.29850860566926940E-017
1.38656832596730697E-002 -3.38337557135760494E-015 -6.70493115624216766E-015 7.72216159242709066E-017
-4.99600361081320443E-016 9.13122747886696336E-015 -6.39440728057347999E-015 0.52033860917403696
-0.68281754277829076 6.70515996073356992E-015 -7.38671007488757673E-015 2.77555756156289135E-016
-3.66995869541228752E-015 0.34177439239247137 0.33930610124645921 -9.71375128464644466E-016
-7.98079506433822847E-015 -0.47041209754485619 0.46701478623514603 1.37257029986602042E-014
1.90844758280409692E-002 -4.63960397717473802E-015 -9.26450064325020046E-015 9.75430937990790438E-017
-1.11022302462515654E-015 1.25685951276451106E-014 -8.73088059253134132E-015 0.71618465988796653
0.49609598180560627 -4.77046600177331782E-015 5.36711575423840322E-015 -3.33066907387546962E-016
-5.17875142453636804E-015 0.47041209754508645 0.46701478623491077 -1.30474647432824904E-015
5.87998080721498534E-015 0.34177439239230462 -0.33930610124663074 -9.90917586670443632E-015
8.15812744693330725E-004 -7.12042724006876118E-016 -1.74575577399174521E-015 3.03010406606225961E-016
6.93889390390722838E-018 1.15401986210711216E-015 -8.76974067259100996E-016 6.24370406492669588E-002
-3.92553044254847563E-002 2.33392024193263174E-016 -6.31775550728609874E-016 -4.57966997657877073E-016
-2.19243516814775052E-017 3.26125716232898641E-002 3.25868728146177372E-002 -1.23573618568327792E-016
-6.75668656365534830E-016 -4.48873550519190215E-002 4.48519836754704693E-002 9.54705859584339764E-016
1.12286993954185824E-003 -9.76153219244981137E-016 -2.41017865184983730E-015 4.17167815606711277E-016
1.21430643318376497E-017 1.58837211262422452E-015 -1.21181871112166680E-015 8.59372160033720495E-002
2.85206474226156331E-002 -1.69319449328971503E-016 4.62591992038069604E-016 2.22044604925031308E-016
-3.48796504023506168E-017 4.48873550519407610E-002 4.48519836754481191E-002 -1.71408567691551422E-016
4.97284158593512979E-016 3.26125716232740087E-002 -3.25868728146337175E-002 -6.87627393646340688E-016
1.61323597853321003E-002 7.01333942218092341E-003 1.01608814684605898E-002
-2.79420663159793137E-002 4.04915333400110433E-003 -1.75991626518636132E-002
-0.46943247729306226 -0.46960202192573863 -1.13755925423107054E-002
-0.34106265696638938 0.34118583827977700 -8.26485171410307196E-003
2.54089624599350972E-002 2.88657986402540701E-014 -0.67791724006563969
2.22042884631573900E-002 9.65303363702076263E-003 1.39852536335692799E-002
-3.84589551059224821E-002 5.57318147342938941E-003 -2.42231694355196508E-002
0.34106265696605775 0.34118583828010790 8.26485171411840171E-003
-0.46943247729351906 0.46960202192528255 -1.13755925422902582E-002
-1.84606917214297783E-002 -2.11775041947248610E-014 0.49253570244774048
1.31597929556344687E-003 5.93973436698259070E-004 9.24106558550324866E-004
-2.27934296261714936E-003 3.42930717699606313E-004 -1.60059948362375223E-003
-3.76634711142005557E-002 -3.91578409108100309E-002 -1.01994345770417658E-003
-2.73641128525740490E-002 2.84498360359687341E-002 -7.41032280194699883E-004
2.03869403823715538E-003 2.65759636519646847E-015 -6.07835774850491173E-002
1.81129015409427978E-003 8.17534319356023041E-004 1.27192359065154644E-003
-3.13724652045142653E-003 4.72003651273126060E-004 -2.20303624465065196E-003
2.73641128525452179E-002 2.84498360359944150E-002 7.41032280195465221E-004
-3.76634711142402462E-002 3.91578409107747050E-002 -1.01994345770325262E-003
-1.48119788441640823E-003 -1.93248195223816310E-015 4.41618529752342698E-002
2.50183733195353114E-002 5.12716962291341332E-015 -9.16009753726071989E-016
-2.78635800559031283E-002 -2.77760005298557899E-015 -2.54804072536051984E-015
-0.25516531095992645 7.05351834078361871E-015 9.24712014948801768E-015
2.23013934819102222E-014 0.78508897164047187 4.25859031543667915E-002
9.05850415656971646E-015 -1.60152254032029373E-002 0.26142131879933317
8.12896226224197466E-003 1.59468967401852701E-015 -2.21492125352624190E-016
-9.05342597108665936E-003 -9.70779256150601460E-016 -9.12003918640951924E-016
0.78531807651267882 -2.19072995549732822E-014 -2.82818535581966809E-014
7.33416960899934009E-015 0.25509087028988320 1.38369987228253999E-002
-2.81871220709504228E-014 4.92897955465944060E-002 -0.80457208878039466
2.09521755935312146E-003 1.95071562794472258E-015 2.78135724042629284E-017
-2.33396039423676080E-003 3.02414801719625602E-016 -3.44162469583541548E-016
-2.10326056562136730E-002 7.19854738876179965E-016 6.02536352999948676E-016
2.40769243920226030E-015 7.54534326753910911E-002 4.23907570996588136E-003
1.00453393158769761E-015 -1.53921363715101706E-003 2.60225424008792769E-002
6.80777454031507192E-004 6.37607039234237397E-016 8.68613907343628788E-018
-7.58349703545685427E-004 9.82097437030617104E-017 -1.12930819606734392E-016
6.47317040669934535E-002 -2.22971284847583078E-015 -1.84564422621464205E-015
7.93262906293459792E-016 2.45163064643986045E-002 1.37735919422533187E-003
-3.08136797268765954E-015 4.73721246356812765E-003 -8.00891502126776234E-002
1.10888144558322605E-014 4.99232797086386184E-015 1.04208491056554194E-014
-1.64578637176782117E-014 -6.66133814775093924E-015 -2.48014175064181655E-014
-1.23035111670592679E-003 0.25661793442132258 3.86651493571252647E-015
0.78978879177487649 3.78663137520820082E-003 -5.46784839627889596E-015
-1.44328993201270350E-015 3.19709536622525548E-015 -0.26632298856281256
-3.56552443356260273E-015 -1.55930211481793202E-015 -3.41722516033444606E-015
5.39021952072893384E-015 2.66453525910037570E-015 8.13586111393910537E-015
-3.78663137521277789E-003 0.78978879177487926 1.21551379697344064E-014
-0.25661793442132186 -1.23035111670452470E-003 2.10942374678779743E-015
-4.74620343027254421E-015 9.64007519643761412E-015 -0.81965787708755611
2.96468037622837458E-015 6.41448801955727705E-016 1.74612622719173991E-015
-2.68448457907410898E-015 -9.83588210878849623E-016 -3.33986538948440408E-015
-1.18644473567049464E-004 2.47460251986617100E-002 6.73482511653182856E-016
7.61604342408613855E-002 3.65150142479693529E-004 -6.47051856539349046E-016
6.93889390390722838E-018 -4.21212544010618473E-017 -2.81169662282370059E-002
-9.60934541438567721E-016 -2.07059796679228235E-016 -5.66986646549486291E-016
8.70776974831732886E-016 2.35922392732845765E-016 1.08628897279541059E-015
-3.65150142481637287E-004 7.61604342408660345E-002 2.07860329480731411E-015
-2.47460251986602077E-002 -1.18644473566424679E-004 2.35922392732845765E-016
-1.59594559789866253E-016 -1.27068494615301120E-016 -8.65351239355447166E-002
6.48361767119616621E-015 -2.85555318175357911E-002 -4.07809296304074368E-003
-1.08385522779030907E-014 -4.07809289324570501E-003 2.85555313288339205E-002
0.15072177669527320 0.20796328367520334 2.96998006953149082E-002
0.46387393064009752 -0.39918301407066803 0.50859208665089817
-0.15072177669546352 7.82608599481372791E-002 0.19495138706466059
2.00625217625967697E-015 -9.27825472782249812E-003 -1.32505272731767393E-003
-3.60822483003175876E-015 -1.32505270464039482E-003 9.27825456903350748E-003
-0.46387393064005866 -0.64004517423870588 -9.14065876194578852E-002
0.15072177669528516 -0.12970242372695423 0.16525158636958581
0.46387393064064497 -0.24086216016769291 -0.59999867426961684
6.93245607662720090E-016 -2.70800641183694020E-003 -3.86737741833876832E-004
-1.51875040321769461E-015 -3.86737735214946060E-004 2.70800636549285972E-003
1.38404184898647496E-002 1.94551447964928653E-002 2.77844200544907077E-003
4.25964280647588706E-002 -3.73439156778900688E-002 4.75792288971765842E-002
-1.38404184898824716E-002 7.32137103858686300E-003 1.82378706307781274E-002
2.25249152622060020E-016 -8.79884622158535351E-004 -1.25658709802360533E-004
-4.89192020225459601E-016 -1.25658707651667145E-004 8.79884607100430739E-004
-4.25964280647551791E-002 -5.98767787563698750E-002 -8.55116520529155752E-003
1.38404184898658095E-002 -1.21337737578957362E-002 1.54594286253511397E-002
4.25964280648093857E-002 -2.25328630784483487E-002 -5.61303941023996167E-002
-2.25471023417728698E-002 -1.20323679784540392E-015 -5.63962776351218616E-018
3.13638004456606723E-015 -3.10086930611804109E-015 -5.77517452996175711E-015
-0.25809045768868732 -1.79825830132884581E-014 3.14964962349297934E-015
-4.42579200543063407E-014 0.57002522289177071 -0.56617703023692956
-1.07368564495382163E-014 0.18521242235144922 0.18396206876229104
7.32599764694656739E-003 4.39544999587100910E-016 -3.63392704316965123E-019
-1.27675647831893002E-015 1.00701647833182521E-015 1.77839952217441931E-015
-0.79432075239618971 -5.56224350767323085E-014 9.66060773360039847E-015
1.44384279449892882E-014 -0.18521242235105181 0.18396206876269133
-3.28313297857399991E-014 0.57002522289299284 0.56617703023569743
-2.17045470729172957E-003 -1.32734703584162609E-016 -1.39018318217815842E-016
-3.98986399474665632E-017 -5.31127456443959083E-017 -4.31566417438699871E-016
-2.45088316485976496E-002 -1.49693813473881108E-015 1.94648193694425881E-016
-5.10438769602399561E-015 5.83056552055562574E-002 -5.83723788026307977E-002
-1.04638951207051939E-015 1.89446558088305836E-002 1.89663356196768072E-002
7.05223485324816190E-004 4.30446776835130279E-017 4.53616424898868208E-017
1.38777878078144568E-017 1.72573772088727439E-017 1.39300129313490486E-016
-7.54304275578944750E-002 -4.60574070430158638E-015 6.02180501672679329E-016
1.65827823627175473E-015 -1.89446558087896406E-002 1.89663356197179687E-002
-3.20494159125598931E-015 5.83056552056815808E-002 5.83723788025042739E-002
-5.88715134610011246E-016 3.46228286711041296E-015 -1.63443903984480105E-015
3.15719672627778891E-016 3.77475828372553224E-015 2.81807723123217306E-015
6.05867336011169377E-002 0.67880373065265420 8.22900075458416348E-016
0.49317977506331839 -4.40188382884854693E-002 6.88338275267597055E-015
-1.04360964314764715E-014 -6.66133814775093924E-016 0.69386707443556817
8.23772368050386913E-016 -4.68088723461457117E-015 2.26058592550034199E-015
-4.09394740330526474E-016 -5.27355936696949357E-015 -3.89151333882548254E-015
4.40188382884859064E-002 0.49317977506331839 6.39346064969465703E-016
-0.67880373065265420 6.05867336011164867E-002 -9.76996261670137756E-015
-7.60502771868232230E-015 -3.95516952522712018E-016 0.50412393471233163
-3.53089262582016655E-016 7.78866127290165149E-016 -4.19813202229787951E-016
4.20670442924375720E-017 2.70616862252381907E-016 7.04981432017994359E-016
6.34533375078095811E-003 7.10920686139553948E-002 3.59975954041923670E-016
5.16514099981528890E-002 -4.61015471242496450E-003 9.71445146547011973E-016
-9.61036805691151130E-016 3.14852310889790488E-016 7.57264512500950837E-002
4.84826329869395993E-016 -1.07133136093573334E-015 5.78572944320415573E-016
-5.76795555762288359E-017 -5.30825383648902971E-016 -9.68335574006863446E-016
4.61015471242552308E-003 5.16514099981528890E-002 2.59349335896442881E-016
-7.10920686139553948E-002 6.34533375078019570E-003 -1.20736753927985774E-015
-7.28583859910258980E-016 2.31585584042903747E-016 5.50184859926274930E-002
-8.71195572540541111E-031 -3.24969884813390093E-031 -1.16010963677714894E-030
0.0000000000000000 0.0000000000000000 0.0000000000000000
-0.65037657163083196 0.51248009710711162 -0.20515583553134853
0.0000000000000000 6.93889390390722838E-018 0.0000000000000000
-0.32632965343165832 -0.10122763454160452 0.78164977771764110
-4.16779314099982603E-015 -3.14947355565427692E-015 -4.09534183218605394E-015
-2.72285557082974741E-015 -9.87490886795515299E-016 -3.06374604643844848E-015
2.68852339823548375E-017 -1.29547973506905880E-017 3.99859782958334687E-017
0.44523445966664904 0.67441201634012471 0.27321998435537126
0.0000000000000000 0.0000000000000000 0.0000000000000000
-1.74198715827041609E-031 -2.47376728670618130E-031 -5.05347189241515802E-031
0.0000000000000000 0.0000000000000000 0.0000000000000000
-7.26241597714078896E-002 5.72259796484475489E-002 -2.29086821813164129E-002
-6.93889390390722838E-018 8.67361737988403547E-018 0.0000000000000000
-3.64395304547060483E-002 -1.13035620053111002E-002 8.72827540510988514E-002
-5.88529434125788411E-016 -8.17727565077062364E-016 -1.68536697768549449E-015
-8.35867871562259447E-016 -4.26884282982102447E-016 -1.08805949604943179E-015
7.47562799363042497E-018 -3.78115859630573455E-018 1.53626994728239038E-017
4.97170100292624456E-002 7.53080725273167773E-002 3.05090506978301854E-002
0.0000000000000000 0.0000000000000000 -6.93889390390722838E-018
0.41817867075133863 -2.89120564485163549E-019 -2.69094067099371175E-058 1.15011257050450273E-016 -4.25949569859629402E-036
-2.89120564485163597E-019 0.41817861349675745 -8.64049795617284125E-036 -1.22297992498118223E-016 6.26211089345960796E-036
-8.07282199988879703E-058 -8.71250211458908545E-036 0.23694791318277272 1.13650710051734720E-035 1.16551721574012134E-018
1.15020292068090411E-016 -1.22803953459989879E-016 1.13650710051734720E-035 0.23694791318277281 1.00919019337563083E-035
-4.18692902289996420E-036 6.22610882546187290E-036 1.16551721574012134E-018 1.00919019337563083E-035 0.23694791318277281
0.0000000000000000 -5.49348095123475589E-043 8.31944424306175295E-017 -1.57059059526142817E-036 -1.05434138351877840E-016
1.64804428269766238E-042 3.62511435074819255E-042 -3.22999699855629360E-015 -4.32024897948764843E-037 -1.33320713453179212E-016
-8.30498821483749372E-017 3.23006927869370371E-015 6.76169999827390752E-052 -4.35849228583720016E-017 -2.03886359996511426E-036
1.58859163548163833E-036 5.40031122260795479E-037 4.35849228583720016E-017 3.38808232136927840E-051 5.58364061494068534E-017
1.05253437999074584E-016 1.33465273727999671E-016 2.03886359996511426E-036 -5.58364061494068410E-017 2.58482446071429651E-051
1.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.99999996577145822 0.0000000000000000 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.0000000000000000 0.99999996577145822 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.0000000000000000 0.0000000000000000 0.99999996577145822 0.0000000000000000
0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.99999996577145822
0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.0000000000000000 -4.89842524762354989E-016 0.0000000000000000 0.0000000000000000
0.0000000000000000 -4.89842524762354989E-016 0.0000000000000000 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 2.44921262381177494E-016
0.0000000000000000 0.0000000000000000 0.0000000000000000 2.44921262381177494E-016 0.0000000000000000
-2.07797077872564455E-002 2.05410266584096432E-002 -8.64578310216322643E-002 -0.10457207919524197 -3.24952655729267709E-002
5.66597153129049652E-002 -7.73878777470444479E-002 -6.66463941706798429E-002 2.00801732266639096E-002 -1.78841754458678101E-002
-8.95083138632063596E-002 5.99190081241931655E-002 -9.53285933442331174E-002 7.49659361434691501E-002 -1.06676160102681904E-002
8.73628745130652917E-002 -5.63283894381524791E-002 7.21425624304153773E-002 -0.11280137917334043 6.58243221882444797E-004
7.79854079928449656E-002 -0.10651527610617767 -9.17308922690443646E-002 2.76379875705640848E-002 -2.46154559074702045E-002
-7.23393667751476288E-003 -2.12924746508222351E-003 5.99330054994748063E-002 0.13431150104935075 3.07014256740454732E-002
-2.70315510644238567E-004 5.25280061682239108E-004 -3.40274195212106507E-003 -1.06846153157256762E-002 -3.07967256492031310E-003
2.16713503149908128E-003 -3.10930199855847557E-003 -2.67424807090518813E-003 1.81115727513137177E-003 -1.60942109020046601E-003
-3.94800855063443500E-003 2.71036090590835894E-003 -3.89497979934590090E-003 8.01254126850473036E-003 -8.06532912748049013E-004
4.06335104259474608E-003 -2.67916827650575579E-003 2.98980618561361716E-003 -1.18965267626283296E-002 -1.52607456171693597E-004
2.98280554897820951E-003 -4.27958715998135245E-003 -3.68078678499440988E-003 2.49284418913072120E-003 -2.21517814474706930E-003
-9.98559289560734973E-004 3.28337565257673727E-004 2.31229889567622412E-003 1.38379021487897609E-002 2.97610093972906081E-003
-9.83675599390266761E-003 4.29526763736691741E-002 -2.09045606335887986E-002 0.13361696819317317
1.48139085889470098E-003 3.27612204520540407E-002 -4.41770541624951496E-002 -9.30071322510488303E-003
9.29847088731313859E-002 -2.68397187849785460E-002 3.59620051436917165E-002 -0.11526521181750425
-0.14465590240777693 -1.34568302243756755E-002 -3.24095581760059925E-002 1.21929119585056176E-002
4.81333067976499884E-004 1.06447658005582209E-002 -1.43539950231005003E-002 -3.02198491718699835E-003
-0.11124718326787206 -3.61337540670073135E-002 -1.39324908910119297E-002 -6.86738104093583962E-002
-1.18474463532241767E-003 3.11546698964290918E-003 -1.70454629511681633E-003 1.37978720662982959E-002
6.43064657801538982E-005 1.93393885073834745E-003 -2.62997010606225634E-003 -8.45390491388064037E-004
4.56205784628266331E-003 -2.14499730942053872E-003 2.61642737351435980E-003 -1.21422027308622556E-002
-6.13077528602718608E-003 -6.38785044216270189E-004 -2.10522541620601243E-003 1.66640749430961273E-003
2.08944373610029169E-005 6.28374824934529877E-004 -8.54529089349943816E-004 -2.74684022105704719E-004
-4.26352596636372407E-003 -2.34801350908543129E-003 -7.01255962085883203E-004 -6.76203374271877079E-003
9.09736185598007119E-002 6.48005954451136290E-015 -3.92047505570758403E-016 0.11058997393287555
-7.32747196252603317E-015 -1.42146021515280746E-002 -1.64837071121163511E-002 -3.85282084014448856E-015
-8.61100727208410563E-003 -3.65939917257307457E-015 2.60381993744118745E-015 -0.13041179765476915
0.11056452320210131 2.60316941613769615E-015 3.86127761708987549E-015 -6.96557614872087838E-002
2.10942374678779743E-015 4.61860421469256245E-003 5.35588110947372679E-003 1.28716481917479086E-015
0.14292152958579168 5.93730793696511938E-015 2.92496062093139386E-015 8.65046096828617217E-003
4.52848747532721106E-003 2.12666256133031695E-016 2.54191199339226515E-016 1.16452530364722605E-002
3.30681662608078852E-016 -9.78143338557296241E-004 -1.14655056517422868E-003 -1.96240593219876303E-016
-1.11778030109720432E-003 -2.04643160056638962E-016 -3.76489204395591415E-016 -1.34307927650927222E-002
4.33124684473911326E-003 -5.61481200075930609E-017 -2.87828571740589290E-016 -6.82151370830913484E-003
-1.07119174641567838E-016 3.17818036951975210E-004 3.72536861956560949E-004 6.48352899146331652E-017
6.16583045848140276E-003 8.03529335083319474E-017 -8.30769914667017773E-017 1.32618748947837465E-003
8.74601389463915968E-002 1.27162586379921949E-002 2.43680424053171162E-003
5.93863232581116687E-002 -5.53475385811665610E-002 2.08649552273506185E-002
-6.01717765203201027E-002 1.27162586379238780E-002 7.15076456374988054E-003
1.80082133128973455E-002 3.91366198527594369E-002 1.55195806088568068E-002
-1.92957861189678032E-002 1.79835054284242339E-002 -6.77943491659489632E-003
6.59767304581252434E-002 3.91366198527816345E-002 1.39879220519925976E-002
6.34201471112452557E-003 7.83648978218010354E-004 1.34647443155688036E-004
3.51233851737402930E-003 -3.41083358190284345E-003 1.39843485103202333E-003
-4.72807464387209504E-003 7.83648978213096533E-004 5.07941540326711251E-004
6.85153345288747116E-004 2.41182355526396242E-003 1.04948806864004754E-003
-1.14122796598407905E-003 1.10824701313112458E-003 -4.54379027736117474E-004
4.28204342162174199E-003 2.41182355526555836E-003 9.28197463784893916E-004
9.07799005162825551E-002 2.17187379192296248E-015 -1.34072440649557478E-015
2.06085148946044683E-015 -2.94666473661206914E-002 -4.17109128898674256E-003
2.49556078829755654E-002 -1.16573417585641437E-015 8.79721642754738298E-016
-3.25629916771322941E-003 -1.92901250528620949E-015 1.31969088434935600E-015
-2.79637424327461304E-015 4.05573609017660791E-002 5.74101466966779259E-003
8.73430676465513089E-002 2.66106581214842208E-015 -1.71607519861005642E-015
6.05681964141315237E-003 -2.24646690138996519E-016 -1.82457673102154327E-016
-2.13804668414141474E-016 -2.09745616400605368E-003 -3.08140380813099032E-004
1.00649735709771085E-003 -1.19262238973405488E-017 2.73124079776254636E-016
-9.09686194889612739E-004 6.07153216591882483E-017 3.45481022262505988E-016
2.94902990916057206E-016 2.88690081319395182E-003 4.24118859413101740E-004
6.04148625852415390E-003 -2.31585584042903747E-016 -2.82163615389352529E-016
-2.27090105550003629E-004 4.73648481504733709E-002 -2.16370174009247789E-015
9.13440330319037486E-018 -2.08166817117216851E-017 -4.55335373460501719E-018
-2.27090105549971049E-004 4.73648481504733432E-002 -2.16370174009247867E-015
4.08700850940135751E-015 2.60896989776049359E-015 4.96037486572978596E-015
6.69840106341425545E-002 3.21153907156119232E-004 6.99730726515255170E-016
-4.06619182768963583E-015 -2.62496187980465479E-015 -4.96520442668410788E-015
-1.62935033321088020E-005 3.39838369140103586E-003 1.38419107489534012E-017
2.55126323712995262E-018 -1.73472347597680709E-018 1.27462229859215202E-018
-1.62935033321119495E-005 3.39838369140103933E-003 1.38419107489534474E-017
8.25945214999457278E-016 1.76309907970982616E-016 5.40322998952743292E-016
4.80604030652744853E-003 2.30424933922251649E-005 2.34537855237281228E-016
-8.22909448916497865E-016 -1.79914880194496918E-016 -5.38520410811171122E-016
-4.97681909375340473E-002 -4.82602650487707896E-002 -1.46021088389601678E-002
-0.13306352760101450 0.11808066001021725 -0.16555133387992260
-1.13752772521286127E-002 -4.35373620716415638E-002 -2.83714117859083098E-003
-8.78528157666330078E-002 -0.14049474072151610 -2.49249114707128933E-002
4.32349609821794864E-002 -3.83667321945202339E-002 5.37908891334768491E-002
-0.10032742962390717 -0.14202930492284091 -2.87475811907503889E-002
-3.70753929738527411E-003 -3.40982281634516233E-003 -1.12762486019539303E-003
-9.09477845258517548E-003 8.23454020777469181E-003 -1.15496522113857115E-002
-4.71564531820597380E-004 -2.99331262005517488E-003 -9.00788819465864546E-005
-5.90526354743614503E-003 -9.78574606013009676E-003 -1.70529381481935444E-003
2.95507265691450065E-003 -2.67556430726921275E-003 3.75270949420835817E-003
-6.95669548698683859E-003 -9.92107842680614235E-003 -2.04241293944664544E-003
-0.16549551573140581 -7.44196371194050244E-015 3.06352165857504133E-015
5.63438184997266944E-015 -7.05599611135910298E-002 7.31096210246516415E-002
-0.14791088193959218 -1.02591546369268372E-014 2.96637714392034013E-015
-0.10174995154926955 -8.34055047249648851E-015 2.08860706507607574E-015
-7.74380559676046687E-015 9.71174553254823270E-002 -0.10062676115457860
-0.12595312373213546 -4.46864767411625508E-015 2.21350715534640585E-015
-1.18811414602991612E-002 -1.36739577993871819E-015 2.76688394418300732E-016
4.97865637605343636E-016 -5.38578883027934514E-003 5.62696066361230082E-003
-1.03469397124761608E-002 -3.16587034365767295E-016 1.67400815431761885E-016
-7.01899914832604388E-003 1.11455983331509856E-016 8.19656842399041352E-017
-6.87817858224804013E-016 7.41290255340920114E-003 -7.74484711259303387E-003
-9.13064674764198225E-003 -1.33443603389515886E-015 2.33753988387874756E-016
1.26488672483826697E-002 0.14171581411306849 3.09586375006299123E-015
6.93889390390722838E-018 -7.07767178198537295E-016 -1.70750765047714769E-017
1.26488672483826940E-002 0.14171581411306849 3.09586375006299202E-015
-9.15933995315754146E-016 1.32706345912225743E-016 -1.99695422954461413E-015
0.20041642632144666 -1.78881996113155681E-002 1.42050566637746718E-015
9.15933995315754146E-016 -1.22298005056364900E-016 1.98246554668165074E-015
9.91996630582853275E-004 1.11141659833950916E-002 2.43359219856367378E-016
-8.67361737988403547E-019 5.20417042793042128E-018 -1.27462229859222444E-018
9.91996630582853058E-004 1.11141659833950916E-002 2.43359219856367378E-016
5.11743425413158093E-017 -2.74194729421584071E-016 -6.11955931208841114E-018
1.57178042681822179E-002 -1.40289508879840432E-003 1.68499356284896464E-016
-5.11743425413158093E-017 2.77013655070046383E-016 4.31697117051619789E-018
-0.14977258725759401 0.11801696649264197 -4.72445066732259389E-002
0.0000000000000000 0.0000000000000000 0.0000000000000000
-0.14977258725759401 0.11801696649264198 -4.72445066732259389E-002
-2.08166817117216851E-016 -4.57966997657877073E-016 6.03683769639928869E-016
-0.14500107148885677 -0.21963813193500981 -8.89805126794487311E-002
2.08166817117216851E-016 4.57966997657877073E-016 -5.75928194024299955E-016
-1.25726996218183448E-002 9.90696560137734397E-003 -3.96595266236427543E-003
-1.73472347597680709E-018 0.0000000000000000 1.73472347597680709E-018
-1.25726996218183448E-002 9.90696560137734744E-003 -3.96595266236427543E-003
2.03830008427274834E-016 -8.67361737988403547E-019 1.55257751099924235E-016
-1.21721534631411919E-002 -1.84375813283295040E-002 -7.46949277300029517E-003
-2.05564731903251641E-016 8.67361737988403547E-019 -1.55257751099924235E-016
1.2482676900126699 5.55111512312578270E-017 1.11022302462515654E-016
-5.55111512312578270E-017 1.2546793328920534 5.55111512312578270E-017
1.11022302462515654E-016 -5.55111512312578270E-017 1.2482676900126699
-7.66646708341677054E-019 -4.06572133302594693E-017 -3.60835050726154072E-017
4.05166614337302473E-017 0.0000000000000000 4.05166614337302411E-017
3.60835050726154072E-017 -4.06572133302594755E-017 7.66646708341677825E-019
-0.50000000000000011 -0.70710678118654757 -0.49999999999999989
0.70710678118654757 -2.22044604925031308E-016 -0.70710678118654757
-0.49999999999999989 0.70710678118654757 -0.50000000000000011
-1.22460635382237750E-016 -8.65927457071935541E-017 0.0000000000000000
8.65927457071935541E-017 0.0000000000000000 8.65927457071935541E-017
0.0000000000000000 -8.65927457071935541E-017 1.22460635382237750E-016
-7.23393667748174068E-003 -3.22883468892037825E-002 5.05367341458976826E-002 -6.68203298548044194E-002 -0.12048734527179344
5.66597153128270623E-002 0.10154733296234247 -1.08979193606268676E-002 1.15988203030693345E-002 -2.42595229913602495E-002
-8.73628745130365508E-002 -5.38501056846820564E-003 -9.13697894924953014E-002 -3.07179510424373525E-002 -0.10854027782948107
8.95083138631868058E-002 -4.82898478244610935E-003 0.11249226262082226 1.05875234170278304E-002 7.49772896356132590E-002
7.79854079927378430E-002 0.13976791356999854 -1.49996992223005651E-002 1.59644066683986632E-002 -3.33903690636822015E-002
-2.07797077872818141E-002 3.22002810376368007E-002 -8.28253114829508585E-002 6.02781852261610601E-002 9.14210173740812038E-002
-9.98559289559889512E-004 -1.58357726347470740E-003 1.71662890291182256E-003 -6.70474266049944818E-003 -1.24655982022292729E-002
2.16713503149542708E-003 4.07800717161719076E-003 -4.34993300214066118E-004 1.04264973150577684E-003 -2.18710046825328942E-003
-4.06335104259296104E-003 -5.06914181742375508E-004 -3.98245171894527020E-003 -3.45293084332606425E-003 -1.13854251848937733E-002
3.94800855063283471E-003 1.84656332040936035E-005 4.74516415922476148E-003 1.45212325220534714E-003 7.92102587921776624E-003
2.98280554897317838E-003 5.61289547881033482E-003 -5.98716928473685310E-004 1.43508427466320070E-003 -3.01028561582804277E-003
-2.70315510644548703E-004 1.50036526931015537E-003 -3.09894756241104212E-003 5.92785835477908571E-003 9.40775652734730100E-003
-0.11124718326789813 -3.61337540668439650E-002 1.39324908914463079E-002 6.86738104093560509E-002
1.48139085888879599E-003 3.27612204525930886E-002 4.41770541621010204E-002 9.30071322510593601E-003
0.14465590240778986 1.34568302239894463E-002 -3.24095581761701390E-002 1.21929119585050105E-002
-9.29847088731175081E-002 2.68397187854108391E-002 3.59620051433731241E-002 -0.11526521181750028
4.81333067974334949E-004 1.06447658007333777E-002 1.43539950229724812E-002 3.02198491718731754E-003
-9.83675599387604654E-003 4.29526763739229017E-002 2.09045606330756778E-002 -0.13361696819316862
-4.26352596636396866E-003 -2.34801350907664491E-003 7.01255962113849331E-004 6.76203374271841604E-003
6.43064657801489109E-005 1.93393885076870056E-003 2.62997010603967761E-003 8.45390491387986082E-004
6.13077528602741766E-003 6.38785044190189597E-004 -2.10522541621358710E-003 1.66640749430960731E-003
-4.56205784628272402E-003 2.14499730945281455E-003 2.61642737348875354E-003 -1.21422027308617664E-002
2.08944373610050853E-005 6.28374824944392322E-004 8.54529089342605393E-004 2.74684022105676313E-004
-1.18474463532232139E-003 3.11546698966385510E-003 1.70454629507966549E-003 -1.37978720662976905E-002
0.14292152958578991 4.02152269818323305E-015 1.70956998557514339E-015 -8.65046096828107729E-003
-2.18228213277882332E-015 -1.42146021515185232E-002 1.64837071121287267E-002 1.77982628635220408E-015
-0.11056452320209906 -2.95119831350554307E-015 8.64325971905444135E-016 -6.96557614872116565E-002
8.61100727208556280E-003 4.36282954208166984E-016 3.86843335142827982E-015 -0.13041179765476693
6.80011602582908381E-016 4.61860421468946424E-003 -5.35588110947775396E-003 -5.79397640976253570E-016
9.09736185598006702E-002 2.72785266597352916E-015 4.13731549020468492E-015 -0.11058997393287072
6.16583045848150338E-003 -1.95969542676754926E-016 3.23281982780865285E-016 -1.32618748947850671E-003
4.26308294221300343E-016 -9.78143338557119300E-004 1.14655056517537555E-003 -2.71592644207618861E-016
-4.33124684473912280E-003 -9.37021727570597207E-017 1.38235776991901815E-018 -6.82151370830896657E-003
1.11778030109732727E-003 -4.30645102911242361E-016 4.46257614195033625E-016 -1.34307927650926164E-002
-1.39211558947138769E-016 3.17818036951914604E-004 -3.72536861956934348E-004 8.71698546678345565E-017
4.52848747532736979E-003 -4.61328024392582137E-016 5.48823139712162344E-016 -1.16452530364722570E-002
0.16735768665965786 0.19249437142024067 7.14582922943898455E-003
-1.04414994163611052E-003 -3.74636467818307423E-003 -0.21237417108479634
-0.17612074529228414 -0.19434382010184931 7.63364973426352428E-004
6.92864145419245930E-002 6.56916827382872798E-002 -1.11341042163357745E-002
-3.39264881965103959E-004 -1.21726767358626420E-003 -6.90045511789277172E-002
-4.23164932627057219E-002 -5.99996649802401888E-002 -1.32078925642908213E-002
9.87499473115223923E-003 1.19076973511338322E-002 5.42021079353118863E-004
-6.79213491091368651E-005 -2.36050357327317276E-004 -1.41304936039820875E-002
-1.05238165057809120E-002 -1.20539548689669700E-002 1.15983183688934564E-004
4.31242182623335808E-003 4.11787356365975448E-003 -9.43350390301065690E-004
-2.20689841560805025E-005 -7.66974105229113745E-005 -4.59127569687675478E-003
-2.31555373513800053E-003 -3.66773920956698762E-003 -1.08177849416859432E-003
0.25745109348442474 -1.05479860956769755E-014 -1.03632380454854456E-014
7.79931674799172470E-015 -9.82039353108784749E-003 0.12532506723377224
-0.24944725335581133 9.16974829401340230E-015 1.05332409461311727E-014
-7.00339849682093674E-002 1.06512021424975956E-015 3.73312492030208887E-015
-2.85882428840977809E-015 3.19083928411979497E-003 -4.07205827905833678E-002
9.46672719570883781E-002 -5.32820315646276299E-015 -3.13638004456606723E-015
1.58033667267171336E-002 -3.05501067152103012E-016 -8.17922118923064545E-016
-3.20923843055709312E-016 -7.02808569980538215E-004 9.24576506543691064E-003
-1.51932332775242315E-002 3.40493692269072668E-016 8.34401991944844212E-016
-4.09680410247950221E-003 1.59486139572617702E-016 2.94902990916057206E-016
1.02348685082631619E-016 2.28356347438493537E-004 -3.00413118137712399E-003
5.97460177149350749E-003 -4.94396190653390022E-017 -2.42861286636752993E-016
-1.36924776914605097E-003 0.28558801585901250 4.09741685025721836E-015
4.45514935706881055E-015 -2.44249065417534439E-015 0.20930386747707047
1.36924776914760810E-003 -0.28558801585901250 -1.33573707650214146E-015
4.44895569377440326E-004 -9.27931713932656638E-002 3.24740234702858288E-015
-1.44860252265788247E-015 6.66133814775093924E-016 -6.80069490671225962E-002
-4.44895569372682630E-004 9.27931713932654972E-002 5.21804821573823574E-015
-9.88515197648512280E-005 2.06177508778895881E-002 2.79941000935757245E-016
5.22416040548562277E-017 -6.07153216591882483E-017 1.65088928407490440E-002
9.88515197652019132E-005 -2.06177508778896817E-002 2.79724160501260144E-017
3.21188058268702379E-005 -6.69911336311985670E-003 4.34548230732190177E-016
-1.65205306032478738E-017 1.73472347597680709E-017 -5.36406445566158484E-003
-3.21188058257895729E-005 6.69911336311956353E-003 5.14345510627123303E-016
-0.10032742962392399 -0.14439851476441501 -1.21579527475881057E-002
-0.13306352760119203 6.70197792007354298E-002 0.19198602973578399
8.78528157666487591E-002 0.14185526777724500 1.53982591896807998E-002
1.13752772521324430E-002 4.25910913602506117E-002 9.46309690148613991E-003
4.32349609822370515E-002 -2.17760463068868981E-002 -6.23800424838870937E-002
-4.97681909375411319E-002 -5.04184007402754958E-002 5.09540886466139376E-004
-6.95669548698783606E-003 -1.00961820379056079E-002 -8.16306329463770434E-004
-9.09477845259757181E-003 4.67242230180037275E-003 1.33929305408054880E-002
5.90526354743657264E-003 9.87189449521493415E-003 1.10206715927220716E-003
4.71564531819949895E-004 2.89886764770599980E-003 7.51399366138332143E-004
2.95507265691852868E-003 -1.51816203743622338E-003 -4.35162693004794311E-003
-3.70753929738638303E-003 -3.58915372431850652E-003 1.28082033905575245E-004
-0.12595312373213746 -6.69603261727047538E-015 1.78329573330415769E-015
3.49720252756924310E-015 -7.05599611137471272E-002 -7.31096210244965988E-002
0.10174995154927152 6.98746616123457898E-015 7.63278329429795122E-017
0.14791088193959567 9.59649026910369685E-015 -5.82867087928207184E-016
-4.89885909615850323E-015 9.71174553256971274E-002 0.10062676115436511
-0.16549551573140930 -9.38138455808257277E-015 1.90819582357448780E-015
-9.13064674764183307E-003 -8.29197821516913791E-016 6.16260514840760720E-016
1.92554305833425587E-016 -5.38578883029163479E-003 -5.62696066360074063E-003
7.01899914832559285E-003 5.61183044478497095E-016 3.90746462963775798E-016
1.03469397124756370E-002 8.57170237567039806E-016 2.10768902331182062E-016
-2.64545330086463082E-016 7.41290255342612510E-003 7.74484711257712125E-003
-1.18811414602988542E-002 -1.05232662861443060E-015 5.18682319317065321E-016
1.28873396408269274E-002 0.14438761930909616 1.13797860024078545E-015
3.55271367880050093E-015 5.55111512312578270E-017 -0.14937971605056932
-1.28873396408220701E-002 -0.14438761930909583 8.32667268468867405E-017
-1.77379013861425697E-002 -0.19873250989457386 -1.10328413072124931E-015
-4.90059381963448004E-015 -5.55111512312578270E-017 0.20560354168230310
1.77379013861461120E-002 0.19873250989457414 1.96370697480574563E-015
1.01352428808786435E-003 1.13553582932923638E-002 9.71445146547011973E-017
3.66243493865603398E-016 1.90819582357448780E-017 -1.22289414573233668E-002
-1.01352428808754690E-003 -1.13553582932931444E-002 -2.49800180540660222E-016
-1.39499653994367518E-003 -1.56293102347389717E-002 -2.94035629178068803E-016
-5.04587691074753764E-016 -2.94902990916057206E-017 1.68316943369245034E-002
1.39499653994390590E-003 1.56293102347384028E-002 1.86482773667506763E-016
-9.78384040450919201E-016 -1.73472347597680709E-015 -3.37230243729891299E-015
0.0000000000000000 0.0000000000000000 2.08166817117216851E-017
-9.92261828258733658E-016 -1.73472347597680709E-015 -3.37230243729891299E-015
0.14977258725760201 -0.11801696649264498 4.72445066732283189E-002
-0.10627692528922106 -3.29671595585876998E-002 0.25456263062599588
-0.14977258725760201 0.11801696649264498 -4.72445066732283189E-002
-4.50160742015981441E-016 -2.00143721040824119E-016 -4.40619762898109002E-016
-1.73472347597680709E-018 -8.67361737988403547E-019 1.73472347597680709E-018
-4.50160742015981441E-016 -1.98408997564847311E-016 -4.44089209850062616E-016
1.25726996218184766E-002 -9.90696560137710631E-003 3.96595266236452002E-003
-8.92144472401773699E-003 -2.76743696629797638E-003 2.13693276480291239E-002
-1.25726996218184783E-002 9.90696560137710458E-003 -3.96595266236452089E-003
1.2482676900126699 0.0000000000000000 0.0000000000000000
5.55111512312578270E-017 1.2546793328920531 -5.55111512312578270E-017
0.0000000000000000 0.0000000000000000 1.2482676900126699
1.69940020349077541E-018 5.89190682441513498E-017 -5.37036019193351980E-017
-5.85868546705368215E-017 0.0000000000000000 -5.85868546705368338E-017
5.37036019193351980E-017 5.89190682441513745E-017 -1.69940020349080469E-018
-2.14306111918916069E-016 1.29889118560790344E-016 3.06151588455594253E-017
0.70710678118654757 2.22044604925031308E-016 -0.70710678118654757
3.06151588455594253E-017 -1.29889118560790344E-016 -2.14306111918916069E-016
0.50000000000000011 -0.70710678118654757 0.49999999999999989
1.73185491414387108E-016 0.0000000000000000 1.73185491414387108E-016
-0.49999999999999989 -0.70710678118654757 -0.50000000000000011
-1.50795419074140850E-002 -0.13640829624214801 -2.55365402000995133E-002 -2.42589879031426710E-002 -2.41533808958149104E-002
4.85984634178143818E-002 8.49000853202113749E-003 -2.72502785192462495E-002 7.68429249915899004E-002 -0.10222689224139500
-9.52084797431169139E-002 -5.12563176472887461E-002 9.11270423682219860E-002 1.36543429529967821E-002 -2.71018584309838696E-002
9.52084797431361485E-002 9.57233921067532530E-003 -0.10411396770641200 -2.22392489885207198E-002 2.06486710545183486E-002
6.68900466714981434E-002 1.16854942953190308E-002 -3.75067908331889674E-002 0.10576521347628901 -0.14070324733359801
-1.50795419075361748E-002 0.12677398338326101 5.64596785875912111E-002 2.99439744889411393E-002 1.65904398551926409E-002
-5.76766154120704846E-004 -5.47524608870895556E-003 -1.02411926324771376E-003 -2.18311290934133017E-003 -2.17496598129218559E-003
2.60052168770015957E-003 4.71109851752039442E-004 -1.51211563863431131E-003 8.00245117028562832E-003 -1.06459470867530884E-002
-3.64155790716051003E-003 -2.05890375040413028E-003 3.66281239333306457E-003 1.23279186791963938E-003 -2.44449964221066067E-003
3.64155790716125163E-003 3.85844097444244718E-004 -4.18406544100883519E-003 -2.00557052825278822E-003 1.86360970875878301E-003
3.57931112162610931E-003 6.48427098246959210E-004 -2.08124867719718977E-003 1.10144293775933273E-002 -1.46528894521766959E-002
-5.76766154125398032E-004 5.08803604016589816E-003 2.26694271018153563E-003 2.69601916334438535E-003 1.49262844190716990E-003
4.67727687377428444E-004 -4.32867160218594060E-002 -0.27964380753549600 3.49486817857128235E-002
-6.57161750847209264E-003 1.10597303328769797E-002 -6.71579126216509295E-014 -4.35948368810047473E-015
2.95311636916156719E-003 -0.27330156517026899 -4.42912285422496985E-002 5.53532751638176421E-003
-2.95311636916046087E-003 0.27330156516973902 -4.42912285455315247E-002 5.53532751639198694E-003
-9.04505556290319084E-003 1.52224129587035604E-002 -9.24375954339986104E-014 -5.99992455891819387E-015
4.67727687370654945E-004 -4.32867160185103142E-002 0.27964380753601598 -3.49486817857144680E-002
1.79945995248569212E-005 -2.59307575247800463E-003 -1.68287033270216983E-002 3.14739886416364693E-003
-3.59231478871621288E-004 8.30895790715511628E-004 -5.56953262770313752E-015 -4.63265152384079569E-016
1.13613421518616559E-004 -1.63720347361626210E-002 -2.66540495686490601E-003 4.98499044819294230E-004
-1.13613421518626073E-004 1.63720347361306882E-002 -2.66540495706033215E-003 4.98499044819903986E-004
-4.94439724784803301E-004 1.14362997189634006E-003 -7.66443578532712122E-015 -6.38116202116591903E-016
1.79945995249208587E-005 -2.59307575227637858E-003 1.68287033270526527E-002 -3.14739886416373930E-003
6.00512529280325162E-016 4.83014513826511976E-002 -0.31420171782806899 -4.19205890835067794E-015
6.10936521215701793E-003 -2.63057094519514910E-015 -4.43792170088951939E-015 2.50493228164118907E-015
3.29588044886067713E-015 0.30496335694996701 -4.97646640291250358E-002 -5.96450777858650638E-015
-3.27334409626018095E-015 -0.30496335694999099 -4.97646640289804432E-002 4.88993046625007088E-015
8.40881985734547033E-003 -3.62568372926905519E-015 -6.11715846071092585E-015 3.45152622868811582E-015
4.38164886777023389E-016 4.83014513828051509E-002 0.31420171782804601 2.46629579400662043E-015
3.96335830974985890E-016 3.44922957355754114E-003 -2.25986677342188934E-002 -6.23695496984013556E-016
3.37139145093812316E-004 -2.37625076780027879E-016 -2.30806864970610415E-016 3.65024098668389593E-017
-2.07969827579228295E-016 2.17775768176256650E-002 -3.57927760856407463E-003 -1.31138287299384324E-016
3.47019668792166565E-016 -2.17775768176274170E-002 -3.57927760855265321E-003 -6.46678495789060771E-017
4.64032235253920313E-004 -3.27974205429721047E-016 -3.11306605978022447E-016 5.22750561055965201E-017
-4.83826429817133529E-016 3.44922957356861258E-003 2.25986677342170823E-002 6.14682556276152213E-016
0.17197911247482200 -0.19427983398739401 5.19848181993564501E-002
1.90706142246010284E-002 -4.02486435533055097E-003 -1.72123909911998003E-002
-0.17149931947750000 0.19255835753436601 4.56023539433592154E-002
5.50631283980561118E-002 -6.01965939904634262E-002 -0.14913432234896901
6.19641818306470703E-003 -1.30775770421586303E-003 -5.59264485456664739E-003
-5.65397794066978474E-002 6.54947537279569891E-002 -0.15120811069691800
1.02150107468288003E-002 -1.20350593691208162E-002 3.45954112739013100E-003
1.41199896834820590E-003 -3.18293054222637864E-004 -1.43198236698535123E-003
-1.01838004901271626E-002 1.19265928509594728E-002 3.03350323172712089E-003
3.26596013414648997E-003 -3.72589357824092832E-003 -9.92255379695554905E-003
4.58786276621309444E-004 -1.03419682658873054E-004 -4.65279276446727030E-004
-3.36201542723227852E-003 4.05971919497914550E-003 -1.00609819008226995E-002
-1.13092219013684804E-014 -0.28810618702164897 -8.56436428999100829E-002
1.02782933167652607E-002 3.25512408321239305E-015 2.47917462321814324E-016
8.15068903724250446E-015 0.29119866673636402 -5.07555641147239833E-002
1.69396850472811028E-015 -9.88726155394779177E-002 0.20422888489774799
3.33961994349149483E-003 1.05183812950983999E-015 8.25049996363180725E-017
8.00902191591575448E-015 8.93549416357163340E-002 0.21556470886290099
-7.12022315921056252E-017 -2.07299530819920821E-002 -6.37966165574329214E-003
7.68748091380159386E-004 -1.86117225617339309E-016 9.14813481847939072E-017
-3.00581572607179827E-016 2.09478957552860848E-002 -3.77363027084409415E-003
6.07246880192166345E-016 -7.10635629118965429E-003 1.52009342162795786E-002
2.49781396736166786E-004 -6.09500115369131805E-017 3.04186748890324537E-017
5.32664795834612852E-016 6.43559771463311867E-003 1.60476851436083916E-002
-0.28558801585901300 -1.36924776915090494E-003 4.80881748531702818E-002
6.00779394287980520E-015 1.75020211270886506E-015 6.54870816005769512E-015
0.28558801585901300 1.36924776914961409E-003 4.80881748531675202E-002
9.27931713932659830E-002 4.44895569374169505E-004 0.14800018402160101
-1.94804349069185405E-015 -5.63731050215842007E-016 -2.12823270212489800E-015
-9.27931713932654140E-002 -4.44895569378162188E-004 0.14800018402160200
-2.06177508778895499E-002 -9.88515197656002898E-005 3.79296635132005512E-003
6.12396823600567392E-016 1.32033494470117687E-017 1.77913883040690966E-016
2.06177508778897407E-002 9.88515197653758870E-005 3.79296635131991374E-003
6.69911336312000328E-003 3.21188058261303444E-005 1.16735500775755185E-002
-1.98540563895858818E-016 -4.82733065298246439E-018 -5.73517972903385152E-017
-6.69911336311942822E-003 -3.21188058268280353E-005 1.16735500775755601E-002
-0.12466185679016900 0.11324725201916699 -6.64056967088707123E-002
-2.71478896164634095E-002 8.87434026305112221E-003 1.26736860686911795E-003
6.35183886004177523E-002 -7.44965129321115971E-002 0.15143105766846399
-6.35183886005671744E-002 2.91304323014038961E-002 0.16623030283178900
8.82088405116335586E-003 -2.88344794377531303E-003 -4.11793022935740308E-004
-0.12466185679024500 9.01320793997051894E-002 9.54508507471238110E-002
-8.52053143181878345E-003 7.90161177013297064E-003 -4.63115363095057374E-003
-2.28817970048057458E-003 7.82623149960785195E-004 1.11768535110055690E-004
4.34142760260679793E-003 -5.19740972845290656E-003 1.05616036255323370E-002
-4.34142760261753500E-003 2.03327399909753511E-003 1.15942371837379869E-002
7.43474654412823238E-004 -2.54289676562712203E-004 -3.63157985352822101E-005
-8.52053143182424956E-003 6.28940409227242078E-003 6.65781110301136292E-003
1.79756689860263513E-014 -0.20809014417360799 0.10958647151514002
-9.28143401042499060E-003 2.59061047644929014E-015 -2.72844718194727288E-015
-1.39940969384627796E-014 0.10602722421651199 -0.21507556031533800
9.21903494137304094E-016 -0.10602722421697601 -0.21507556031511499
3.01572072051816418E-003 -8.45172856407111179E-016 8.86619853018173467E-016
1.13172540098759310E-014 -0.20809014417384400 -0.10958647151470098
6.92324402537856718E-016 -1.59523355059288871E-002 8.47502403109675999E-003
-7.87540339117633482E-004 5.22514257383202247E-016 -4.05641199356195283E-016
-2.55755380696690675E-016 8.12812090954843046E-003 -1.66331712174236784E-002
5.18776090108323751E-016 -8.12812090958543211E-003 -1.66331712174066816E-002
2.55887368172468476E-004 -1.69355139519552566E-016 1.31903961147217203E-016
8.26556814828890593E-016 -1.59523355059477435E-002 -8.47502403106339605E-003
-0.14438761930909799 1.28873396408254112E-002 -0.14538365855953500
6.66086226493359972E-016 2.91844622307080418E-015 8.70592432422673456E-016
0.14438761930909200 -1.28873396408256576E-002 -0.14538365855953100
0.19873250989457100 -1.77379013861458587E-002 -0.10562741019108002
-9.16457586453385841E-016 -4.04394056326882176E-015 -1.18054310431887391E-015
-0.19873250989457500 1.77379013861456714E-002 -0.10562741019108499
-1.13553582932925355E-002 1.01352428808768177E-003 -1.19018052044983537E-002
2.48973932497921740E-017 4.48518204211582205E-016 -4.04312430957292107E-018
1.13553582932924106E-002 -1.01352428808752738E-003 -1.19018052044983103E-002
1.56293102347382570E-002 -1.39499653994359690E-003 -8.64716743120648446E-003
-3.40567994557545713E-017 -6.16856010767378209E-016 6.80540823116269591E-018
-1.56293102347383438E-002 1.39499653994370814E-003 -8.64716743120654170E-003
7.51491345556577622E-002 2.33113020803429917E-002 -0.18000296235232099
3.26486110657078499E-018 -2.57262701321034599E-018 1.02987305728525806E-018
7.51491345556577761E-002 2.33113020803429917E-002 -0.18000296235232099
-0.10253124092908200 -0.15530761249839301 -6.29187239090966549E-002
-8.07890843330895009E-016 -2.51547589515145494E-015 -2.93762381528901684E-015
0.10253124092908200 0.15530761249839301 6.29187239090966827E-002
6.30841406233379788E-003 1.95687344537574500E-003 -1.51103964893183878E-002
1.08874058558177154E-018 -8.57899723577699479E-019 3.43434087657616159E-019
6.30841406233380048E-003 1.95687344537574760E-003 -1.51103964893183895E-002
-8.60701225543038240E-003 -1.30373387859403344E-002 -5.28172899181251869E-003
-3.34930091441267792E-016 -4.93822588672297332E-016 1.97136808569230149E-016
8.60701225543038066E-003 1.30373387859403327E-002 5.28172899181251869E-003
1.2482676900126695 -2.00216001185656475E-017 -3.46944695195361573E-018
-2.13407127617563436E-017 1.2546793328920545 2.13407127617563436E-017
-3.46944695195361573E-018 2.00216001185656475E-017 1.2482676900126695
2.41827906441238332E-019 1.40946282423115692E-018 -6.64977332457776001E-018
-3.77663756749117481E-018 0.0000000000000000 -3.77663756749117481E-018
6.64977332457776001E-018 1.40946282423115692E-018 -2.41827906441238332E-019
-6.12303176911188629E-017 0.0000000000000000 0.0000000000000000
0.0000000000000000 -1.0000000000000000 0.0000000000000000
0.0000000000000000 0.0000000000000000 -6.12303176911188629E-017
1.0000000000000000 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.0000000000000000 -1.0000000000000000

1421
test/SrVO3.sympar Normal file

File diff suppressed because it is too large Load Diff

343
test/SrVO3.symqmc Normal file
View File

@ -0,0 +1,343 @@
48 5
1 2 3 4 5
1 2 3 4 5
1 2 3 5 4
1 2 3 5 4
1 2 3 5 4
1 2 3 5 4
1 2 3 4 5
1 2 3 4 5
1 2 4 3 5
1 2 4 3 5
1 2 4 5 3
1 2 4 5 3
1 2 4 5 3
1 2 4 5 3
1 2 4 3 5
1 2 4 3 5
1 2 5 3 4
1 2 5 3 4
1 2 5 4 3
1 2 5 4 3
1 2 5 4 3
1 2 5 4 3
1 2 5 3 4
1 2 5 3 4
1 2 5 3 4
1 2 5 3 4
1 2 5 4 3
1 2 5 4 3
1 2 5 4 3
1 2 5 4 3
1 2 5 3 4
1 2 5 3 4
1 2 4 3 5
1 2 4 3 5
1 2 4 5 3
1 2 4 5 3
1 2 4 5 3
1 2 4 5 3
1 2 4 3 5
1 2 4 3 5
1 2 3 4 5
1 2 3 4 5
1 2 3 5 4
1 2 3 5 4
1 2 3 5 4
1 2 3 5 4
1 2 3 4 5
1 2 3 4 5
0.99999996577145822 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.99999996577145822 0.0000000000000000
0.0000000000000000 0.0000000000000000 0.99999996577145822
0.0000000000000000 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.0000000000000000 -1.39659329664039914E-014
0.0000000000000000 -1.39659329664039914E-014 0.0000000000000000
0.99999996577145822 0.0000000000000000 0.0000000000000000
0.0000000000000000 -0.99999996577145822 0.0000000000000000
0.0000000000000000 0.0000000000000000 -0.99999996577145822
0.0000000000000000 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.0000000000000000 6.98296648320199568E-015
0.0000000000000000 6.98296648320199568E-015 0.0000000000000000
-3.61121259316941049E-015 0.0000000000000000 -1.04744497248029186E-014
0.0000000000000000 3.68971721476004985E-015 0.0000000000000000
1.04744497248029186E-014 0.0000000000000000 0.99999996577145822
0.0000000000000000 -0.99999996577145822 0.0000000000000000
0.99999996577145822 0.0000000000000000 -1.04744497248030322E-014
0.0000000000000000 -1.04744497248030322E-014 0.0000000000000000
-3.61121259316941049E-015 0.0000000000000000 3.49148324160092211E-015
0.0000000000000000 -3.68971721476004985E-015 0.0000000000000000
1.04744497248029691E-014 0.0000000000000000 -0.99999996577145822
0.0000000000000000 0.99999996577145822 0.0000000000000000
0.99999996577145822 0.0000000000000000 1.04744497248030053E-014
0.0000000000000000 3.49148324160103531E-015 0.0000000000000000
-3.61121259316941049E-015 0.0000000000000000 -1.04744497248029691E-014
0.0000000000000000 -3.68971721476004985E-015 0.0000000000000000
-3.49148324160092211E-015 0.0000000000000000 -0.99999996577145822
0.0000000000000000 -0.99999996577145822 0.0000000000000000
-0.99999996577145822 0.0000000000000000 3.49148324160103531E-015
0.0000000000000000 1.04744497248030053E-014 0.0000000000000000
-3.61121259316941049E-015 0.0000000000000000 3.49148324160097299E-015
0.0000000000000000 3.68971721476004985E-015 0.0000000000000000
-3.49148324160097299E-015 0.0000000000000000 0.99999996577145822
0.0000000000000000 0.99999996577145822 0.0000000000000000
-0.99999996577145822 0.0000000000000000 -3.49148324160101006E-015
0.0000000000000000 -3.49148324160101006E-015 0.0000000000000000
-0.99999996577145822 0.0000000000000000 -6.98296243866963709E-015
0.0000000000000000 0.99999996577145822 0.0000000000000000
6.98296243866963709E-015 0.0000000000000000 -0.99999996577145822
0.0000000000000000 -1.95047177326934654E-028 0.0000000000000000
-9.75235886634673268E-029 0.0000000000000000 1.39659329664039914E-014
0.0000000000000000 -1.39659329664039914E-014 0.0000000000000000
-0.99999996577145822 0.0000000000000000 -6.98296243866963709E-015
0.0000000000000000 -0.99999996577145822 0.0000000000000000
-6.98296243866963709E-015 0.0000000000000000 0.99999996577145822
0.0000000000000000 -9.75235886634673268E-029 0.0000000000000000
4.87617943317336634E-029 0.0000000000000000 -6.98296648320199568E-015
0.0000000000000000 6.98296648320199568E-015 0.0000000000000000
0.99999996577145822 0.0000000000000000 6.98296243866963709E-015
0.0000000000000000 1.04744497248029943E-014 0.0000000000000000
7.31426914976004895E-029 0.0000000000000000 -1.04744497248029943E-014
0.0000000000000000 1.46285382995200979E-028 0.0000000000000000
6.98296243866963709E-015 0.0000000000000000 -0.99999996577145822
0.0000000000000000 0.99999996577145822 0.0000000000000000
0.99999996577145822 0.0000000000000000 6.98296243866963709E-015
0.0000000000000000 -3.49148324160099784E-015 0.0000000000000000
-2.43808971658668317E-029 0.0000000000000000 3.49148324160099784E-015
0.0000000000000000 4.87617943317336634E-029 0.0000000000000000
-6.98296243866963709E-015 0.0000000000000000 0.99999996577145822
0.0000000000000000 -0.99999996577145822 0.0000000000000000
3.61121259316941049E-015 0.0000000000000000 -3.49148324160094774E-015
0.0000000000000000 -3.49148324160102348E-015 0.0000000000000000
-0.99999996577145822 0.0000000000000000 -6.98296648320200830E-015
0.0000000000000000 -0.99999996577145822 0.0000000000000000
6.98296648320197043E-015 0.0000000000000000 -0.99999996577145822
0.0000000000000000 -3.68971721476004985E-015 0.0000000000000000
3.61121259316941049E-015 0.0000000000000000 1.04744497248029422E-014
0.0000000000000000 1.04744497248030180E-014 0.0000000000000000
-0.99999996577145822 0.0000000000000000 6.98296648320203354E-015
0.0000000000000000 0.99999996577145822 0.0000000000000000
6.98296648320191994E-015 0.0000000000000000 0.99999996577145822
0.0000000000000000 3.68971721476004985E-015 0.0000000000000000
3.61121259316941049E-015 0.0000000000000000 -3.49148324160089765E-015
0.0000000000000000 3.49148324160104911E-015 0.0000000000000000
0.99999996577145822 0.0000000000000000 1.39659329664040024E-014
0.0000000000000000 -0.99999996577145822 0.0000000000000000
-1.39659329664039645E-014 0.0000000000000000 0.99999996577145822
0.0000000000000000 3.68971721476004985E-015 0.0000000000000000
3.61121259316941049E-015 0.0000000000000000 1.04744497248028933E-014
0.0000000000000000 -1.04744497248030448E-014 0.0000000000000000
0.99999996577145822 0.0000000000000000 -1.39659329664040292E-014
0.0000000000000000 0.99999996577145822 0.0000000000000000
-1.39659329664039156E-014 0.0000000000000000 -0.99999996577145822
0.0000000000000000 -3.68971721476004985E-015 0.0000000000000000
-0.99999996577145822 0.0000000000000000 0.0000000000000000
0.0000000000000000 1.04744497248029943E-014 0.0000000000000000
0.0000000000000000 0.0000000000000000 1.04744497248029943E-014
0.0000000000000000 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.0000000000000000 0.99999996577145822
0.0000000000000000 0.99999996577145822 0.0000000000000000
-0.99999996577145822 0.0000000000000000 0.0000000000000000
0.0000000000000000 -3.49148324160099784E-015 0.0000000000000000
0.0000000000000000 0.0000000000000000 -3.49148324160099784E-015
0.0000000000000000 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.0000000000000000 -0.99999996577145822
0.0000000000000000 -0.99999996577145822 0.0000000000000000
3.61121259316941049E-015 0.0000000000000000 -0.99999996577145822
0.0000000000000000 3.49148324160099784E-015 0.0000000000000000
3.49148324160099784E-015 0.0000000000000000 1.25506999338354715E-029
0.0000000000000000 -2.51013998676709429E-029 0.0000000000000000
0.99999996577145822 0.0000000000000000 3.68971721476004985E-015
0.0000000000000000 0.99999996577145822 0.0000000000000000
3.61121259316941049E-015 0.0000000000000000 0.99999996577145822
0.0000000000000000 -3.49148324160102348E-015 0.0000000000000000
3.49148324160094774E-015 0.0000000000000000 -6.98296648320200830E-015
0.0000000000000000 -6.98296648320197043E-015 0.0000000000000000
0.99999996577145822 0.0000000000000000 -3.68971721476004985E-015
0.0000000000000000 -0.99999996577145822 0.0000000000000000
-3.61121259316941049E-015 0.0000000000000000 -0.99999996577145822
0.0000000000000000 0.99999996577145822 0.0000000000000000
-0.99999996577145822 0.0000000000000000 3.68971721476004985E-015
0.0000000000000000 6.98296648320189549E-015 0.0000000000000000
1.39659329664039409E-014 0.0000000000000000 -6.98296648320204695E-015
0.0000000000000000 -1.39659329664040166E-014 0.0000000000000000
-3.61121259316941049E-015 0.0000000000000000 0.99999996577145822
0.0000000000000000 -0.99999996577145822 0.0000000000000000
-0.99999996577145822 0.0000000000000000 -3.68971721476004985E-015
0.0000000000000000 1.00405599470683772E-028 0.0000000000000000
1.39659329664039914E-014 0.0000000000000000 5.02027997353418859E-029
0.0000000000000000 1.39659329664039914E-014 0.0000000000000000
-3.61121259316941049E-015 0.0000000000000000 0.99999996577145822
0.0000000000000000 0.99999996577145822 0.0000000000000000
0.99999996577145822 0.0000000000000000 3.68971721476004985E-015
0.0000000000000000 -1.39659329664039409E-014 0.0000000000000000
-6.98296648320189549E-015 0.0000000000000000 -1.39659329664040166E-014
0.0000000000000000 -6.98296648320204695E-015 0.0000000000000000
-3.61121259316941049E-015 0.0000000000000000 -0.99999996577145822
0.0000000000000000 -0.99999996577145822 0.0000000000000000
0.99999996577145822 0.0000000000000000 -3.68971721476004985E-015
0.0000000000000000 6.98296648320194598E-015 0.0000000000000000
-6.98296648320194598E-015 0.0000000000000000 6.98296648320202013E-015
0.0000000000000000 6.98296648320202013E-015 0.0000000000000000
3.61121259316941049E-015 0.0000000000000000 0.99999996577145822
0.0000000000000000 1.04744497248030180E-014 0.0000000000000000
-1.04744497248029422E-014 0.0000000000000000 6.98296648320203354E-015
0.0000000000000000 -6.98296648320191994E-015 0.0000000000000000
-0.99999996577145822 0.0000000000000000 3.68971721476004985E-015
0.0000000000000000 0.99999996577145822 0.0000000000000000
3.61121259316941049E-015 0.0000000000000000 -0.99999996577145822
0.0000000000000000 -1.04744497248030448E-014 0.0000000000000000
-1.04744497248028933E-014 0.0000000000000000 -1.39659329664040292E-014
0.0000000000000000 1.39659329664039156E-014 0.0000000000000000
-0.99999996577145822 0.0000000000000000 -3.68971721476004985E-015
0.0000000000000000 -0.99999996577145822 0.0000000000000000
3.61121259316941049E-015 0.0000000000000000 -0.99999996577145822
0.0000000000000000 -1.04744497248030448E-014 0.0000000000000000
-1.04744497248028933E-014 0.0000000000000000 -1.39659329664040292E-014
0.0000000000000000 1.39659329664039156E-014 0.0000000000000000
-0.99999996577145822 0.0000000000000000 -3.68971721476004985E-015
0.0000000000000000 -0.99999996577145822 0.0000000000000000
3.61121259316941049E-015 0.0000000000000000 0.99999996577145822
0.0000000000000000 1.04744497248030180E-014 0.0000000000000000
-1.04744497248029422E-014 0.0000000000000000 6.98296648320203354E-015
0.0000000000000000 -6.98296648320191994E-015 0.0000000000000000
-0.99999996577145822 0.0000000000000000 3.68971721476004985E-015
0.0000000000000000 0.99999996577145822 0.0000000000000000
-3.61121259316941049E-015 0.0000000000000000 -0.99999996577145822
0.0000000000000000 -0.99999996577145822 0.0000000000000000
0.99999996577145822 0.0000000000000000 -3.68971721476004985E-015
0.0000000000000000 6.98296648320194598E-015 0.0000000000000000
-6.98296648320194598E-015 0.0000000000000000 6.98296648320202013E-015
0.0000000000000000 6.98296648320202013E-015 0.0000000000000000
-3.61121259316941049E-015 0.0000000000000000 0.99999996577145822
0.0000000000000000 0.99999996577145822 0.0000000000000000
0.99999996577145822 0.0000000000000000 3.68971721476004985E-015
0.0000000000000000 -1.39659329664039409E-014 0.0000000000000000
-6.98296648320189549E-015 0.0000000000000000 -1.39659329664040166E-014
0.0000000000000000 -6.98296648320204695E-015 0.0000000000000000
-3.61121259316941049E-015 0.0000000000000000 0.99999996577145822
0.0000000000000000 -0.99999996577145822 0.0000000000000000
-0.99999996577145822 0.0000000000000000 -3.68971721476004985E-015
0.0000000000000000 1.00405599470683772E-028 0.0000000000000000
1.39659329664039914E-014 0.0000000000000000 5.02027997353418859E-029
0.0000000000000000 1.39659329664039914E-014 0.0000000000000000
-3.61121259316941049E-015 0.0000000000000000 -0.99999996577145822
0.0000000000000000 0.99999996577145822 0.0000000000000000
-0.99999996577145822 0.0000000000000000 3.68971721476004985E-015
0.0000000000000000 6.98296648320189549E-015 0.0000000000000000
1.39659329664039409E-014 0.0000000000000000 -6.98296648320204695E-015
0.0000000000000000 -1.39659329664040166E-014 0.0000000000000000
3.61121259316941049E-015 0.0000000000000000 0.99999996577145822
0.0000000000000000 -3.49148324160102348E-015 0.0000000000000000
3.49148324160094774E-015 0.0000000000000000 -6.98296648320200830E-015
0.0000000000000000 -6.98296648320197043E-015 0.0000000000000000
0.99999996577145822 0.0000000000000000 -3.68971721476004985E-015
0.0000000000000000 -0.99999996577145822 0.0000000000000000
3.61121259316941049E-015 0.0000000000000000 -0.99999996577145822
0.0000000000000000 3.49148324160099784E-015 0.0000000000000000
3.49148324160099784E-015 0.0000000000000000 1.25506999338354715E-029
0.0000000000000000 -2.51013998676709429E-029 0.0000000000000000
0.99999996577145822 0.0000000000000000 3.68971721476004985E-015
0.0000000000000000 0.99999996577145822 0.0000000000000000
-0.99999996577145822 0.0000000000000000 0.0000000000000000
0.0000000000000000 -3.49148324160099784E-015 0.0000000000000000
0.0000000000000000 0.0000000000000000 -3.49148324160099784E-015
0.0000000000000000 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.0000000000000000 -0.99999996577145822
0.0000000000000000 -0.99999996577145822 0.0000000000000000
-0.99999996577145822 0.0000000000000000 0.0000000000000000
0.0000000000000000 1.04744497248029943E-014 0.0000000000000000
0.0000000000000000 0.0000000000000000 1.04744497248029943E-014
0.0000000000000000 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.0000000000000000 0.99999996577145822
0.0000000000000000 0.99999996577145822 0.0000000000000000
3.61121259316941049E-015 0.0000000000000000 1.04744497248028933E-014
0.0000000000000000 -1.04744497248030448E-014 0.0000000000000000
0.99999996577145822 0.0000000000000000 -1.39659329664040292E-014
0.0000000000000000 0.99999996577145822 0.0000000000000000
-1.39659329664039156E-014 0.0000000000000000 -0.99999996577145822
0.0000000000000000 -3.68971721476004985E-015 0.0000000000000000
3.61121259316941049E-015 0.0000000000000000 -3.49148324160089765E-015
0.0000000000000000 3.49148324160104911E-015 0.0000000000000000
0.99999996577145822 0.0000000000000000 1.39659329664040024E-014
0.0000000000000000 -0.99999996577145822 0.0000000000000000
-1.39659329664039645E-014 0.0000000000000000 0.99999996577145822
0.0000000000000000 3.68971721476004985E-015 0.0000000000000000
3.61121259316941049E-015 0.0000000000000000 1.04744497248029422E-014
0.0000000000000000 1.04744497248030180E-014 0.0000000000000000
-0.99999996577145822 0.0000000000000000 6.98296648320203354E-015
0.0000000000000000 0.99999996577145822 0.0000000000000000
6.98296648320191994E-015 0.0000000000000000 0.99999996577145822
0.0000000000000000 3.68971721476004985E-015 0.0000000000000000
3.61121259316941049E-015 0.0000000000000000 -3.49148324160094774E-015
0.0000000000000000 -3.49148324160102348E-015 0.0000000000000000
-0.99999996577145822 0.0000000000000000 -6.98296648320200830E-015
0.0000000000000000 -0.99999996577145822 0.0000000000000000
6.98296648320197043E-015 0.0000000000000000 -0.99999996577145822
0.0000000000000000 -3.68971721476004985E-015 0.0000000000000000
0.99999996577145822 0.0000000000000000 6.98296243866963709E-015
0.0000000000000000 -3.49148324160099784E-015 0.0000000000000000
-2.43808971658668317E-029 0.0000000000000000 3.49148324160099784E-015
0.0000000000000000 4.87617943317336634E-029 0.0000000000000000
-6.98296243866963709E-015 0.0000000000000000 0.99999996577145822
0.0000000000000000 -0.99999996577145822 0.0000000000000000
0.99999996577145822 0.0000000000000000 6.98296243866963709E-015
0.0000000000000000 1.04744497248029943E-014 0.0000000000000000
7.31426914976004895E-029 0.0000000000000000 -1.04744497248029943E-014
0.0000000000000000 1.46285382995200979E-028 0.0000000000000000
6.98296243866963709E-015 0.0000000000000000 -0.99999996577145822
0.0000000000000000 0.99999996577145822 0.0000000000000000
-0.99999996577145822 0.0000000000000000 -6.98296243866963709E-015
0.0000000000000000 -0.99999996577145822 0.0000000000000000
-6.98296243866963709E-015 0.0000000000000000 0.99999996577145822
0.0000000000000000 -9.75235886634673268E-029 0.0000000000000000
4.87617943317336634E-029 0.0000000000000000 -6.98296648320199568E-015
0.0000000000000000 6.98296648320199568E-015 0.0000000000000000
-0.99999996577145822 0.0000000000000000 -6.98296243866963709E-015
0.0000000000000000 0.99999996577145822 0.0000000000000000
6.98296243866963709E-015 0.0000000000000000 -0.99999996577145822
0.0000000000000000 -1.95047177326934654E-028 0.0000000000000000
-9.75235886634673268E-029 0.0000000000000000 1.39659329664039914E-014
0.0000000000000000 -1.39659329664039914E-014 0.0000000000000000
-3.61121259316941049E-015 0.0000000000000000 3.49148324160097299E-015
0.0000000000000000 3.68971721476004985E-015 0.0000000000000000
-3.49148324160097299E-015 0.0000000000000000 0.99999996577145822
0.0000000000000000 0.99999996577145822 0.0000000000000000
-0.99999996577145822 0.0000000000000000 -3.49148324160101006E-015
0.0000000000000000 -3.49148324160101006E-015 0.0000000000000000
-3.61121259316941049E-015 0.0000000000000000 -1.04744497248029691E-014
0.0000000000000000 -3.68971721476004985E-015 0.0000000000000000
-3.49148324160092211E-015 0.0000000000000000 -0.99999996577145822
0.0000000000000000 -0.99999996577145822 0.0000000000000000
-0.99999996577145822 0.0000000000000000 3.49148324160103531E-015
0.0000000000000000 1.04744497248030053E-014 0.0000000000000000
-3.61121259316941049E-015 0.0000000000000000 3.49148324160092211E-015
0.0000000000000000 -3.68971721476004985E-015 0.0000000000000000
1.04744497248029691E-014 0.0000000000000000 -0.99999996577145822
0.0000000000000000 0.99999996577145822 0.0000000000000000
0.99999996577145822 0.0000000000000000 1.04744497248030053E-014
0.0000000000000000 3.49148324160103531E-015 0.0000000000000000
-3.61121259316941049E-015 0.0000000000000000 -1.04744497248029186E-014
0.0000000000000000 3.68971721476004985E-015 0.0000000000000000
1.04744497248029186E-014 0.0000000000000000 0.99999996577145822
0.0000000000000000 -0.99999996577145822 0.0000000000000000
0.99999996577145822 0.0000000000000000 -1.04744497248030322E-014
0.0000000000000000 -1.04744497248030322E-014 0.0000000000000000
0.99999996577145822 0.0000000000000000 0.0000000000000000
0.0000000000000000 -0.99999996577145822 0.0000000000000000
0.0000000000000000 0.0000000000000000 -0.99999996577145822
0.0000000000000000 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.0000000000000000 6.98296648320199568E-015
0.0000000000000000 6.98296648320199568E-015 0.0000000000000000
0.99999996577145822 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.99999996577145822 0.0000000000000000
0.0000000000000000 0.0000000000000000 0.99999996577145822
0.0000000000000000 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.0000000000000000 -1.39659329664039914E-014
0.0000000000000000 -1.39659329664039914E-014 0.0000000000000000
-0.99999996577145822 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.99999996577145822 0.0000000000000000
0.0000000000000000 0.0000000000000000 -0.99999996577145822
0.0000000000000000 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.0000000000000000 0.0000000000000000

BIN
test/U_mat.output.h5 Normal file

Binary file not shown.

51
test/U_mat.py Normal file
View File

@ -0,0 +1,51 @@
################################################################################
#
# TRIQS: a Toolbox for Research in Interacting Quantum Systems
#
# Copyright (C) 2011 by M. Aichhorn, L. Pourovskii, V. Vildosola
#
# TRIQS is free software: you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.
#
# TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# TRIQS. If not, see <http://www.gnu.org/licenses/>.
#
################################################################################
from pytriqs.archive import *
import numpy
#from pytriqs.applications.dft.U_matrix import Umatrix
from U_matrix import Umatrix
U = Umatrix(U_interact = 2.0, J_hund = 0.5, l=2)
T = numpy.zeros([5,5],numpy.complex_)
sqtwo = 1.0/numpy.sqrt(2.0)
T[0,0] = 1j*sqtwo
T[0,4] = -1j*sqtwo
T[1,1] = -1j*sqtwo
T[1,3] = -1j*sqtwo
T[2,2] = 1.0
T[3,1] = -sqtwo
T[3,3] = sqtwo
T[4,0] = sqtwo
T[4,4] = sqtwo
U(T=T)
U.reduce_matrix()
ar = HDFArchive('U_mat.output.h5')
ar['U'] = U.U
ar['Up'] = U.Up
ar['Ufull'] = U.Ufull
del ar

BIN
test/srvo3_Gloc.output.h5 Normal file

Binary file not shown.

64
test/srvo3_Gloc.py Normal file
View File

@ -0,0 +1,64 @@
################################################################################
#
# TRIQS: a Toolbox for Research in Interacting Quantum Systems
#
# Copyright (C) 2011 by M. Aichhorn, L. Pourovskii, V. Vildosola
#
# TRIQS is free software: you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.
#
# TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# TRIQS. If not, see <http://www.gnu.org/licenses/>.
#
################################################################################
#from pytriqs.applications.dft.sumk_lda import *
#from pytriqs.applications.dft.converters.wien2k_converter import *
from sumk_lda import *
from converters.wien2k_converter import *
from pytriqs.archive import *
#=====================================================
#Basic input parameters:
LDAFilename = 'SrVO3'
U = 4.0
J = 0.6
Beta = 40
DC_type = 1 # DC type: 0 FLL, 1 Held, 2 AMF
useBlocs = True # use bloc structure from LDA input
useMatrix = False # True: Slater parameters, False: Kanamori parameters U+2J, U, U-J
use_spinflip = False # use the full rotational invariant interaction?
#=====================================================
U=U-2*J
HDFfilename = LDAFilename+'.h5'
# Init the SumK class
SK=SumkLDA(hdf_file='SrVO3.h5',use_lda_blocks=True)
Norb = SK.corr_shells[0][3]
l = SK.corr_shells[0][2]
from solver_multiband import *
#from pytriqs.applications.dft.solver_multiband import *
S=SolverMultiBand(beta=Beta,n_orb=Norb,gf_struct=SK.gf_struct_solver[0],map=SK.map[0])
SK.put_Sigma([S.Sigma])
Gloc=SK.extract_G_loc()
ar = HDFArchive('srvo3_Gloc.output.h5','w')
ar['Gloc'] = Gloc[0]
del ar

Binary file not shown.

36
test/sumklda_basic.py Normal file
View File

@ -0,0 +1,36 @@
################################################################################
#
# TRIQS: a Toolbox for Research in Interacting Quantum Systems
#
# Copyright (C) 2011 by M. Aichhorn, L. Pourovskii, V. Vildosola
#
# TRIQS is free software: you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.
#
# TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# TRIQS. If not, see <http://www.gnu.org/licenses/>.
#
################################################################################
from pytriqs.archive import *
#from pytriqs.applications.dft.sumk_lda_tools import SumkLDATools
from sumk_lda_tools import SumkLDATools
SK = SumkLDATools(hdf_file = 'SrVO3.h5')
dm = SK.density_gf(40)
dm_pc = SK.partial_charges(40)
ar = HDFArchive('sumklda_basic.output.h5','w')
ar['dm'] = dm
ar['dm_pc'] = dm_pc
del ar

Binary file not shown.

36
test/wien2k_convert.py Normal file
View File

@ -0,0 +1,36 @@
################################################################################
#
# TRIQS: a Toolbox for Research in Interacting Quantum Systems
#
# Copyright (C) 2011 by M. Aichhorn, L. Pourovskii, V. Vildosola
#
# TRIQS is free software: you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.
#
# TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# TRIQS. If not, see <http://www.gnu.org/licenses/>.
#
################################################################################
from pytriqs.archive import *
#from pytriqs.applications.dft.converters import Wien2kConverter
from converters import Wien2kConverter
Converter = Wien2kConverter(filename='SrVO3')
Converter.hdf_file = 'wien2k_convert.output.h5'
Converter.convert_dmft_input()
Converter.convert_parproj_input()