CV

program dispersion_110
implicit none
real a(3,3) , s(3) , c(3) ,q(3) ,pi ,a1 , a2 , b1 ,
b2 ,m ,w1 ,w2 ,w3 ,f1 ,f2 ,f3,d(3) ,v(3,3),x1,x2,x3,h,kb,ef1,ef2,ef3,Na,Sv,ef
integer i,j,k,z,n,nrot,ii,iw,it
m=(63.54/0.6023)
h=6.62
Na=6.023
kb=1.38
!q(1)=1
!q(2)=0
!q(3)=0
a1=31260.
a2=1772.
b1=-4347.
b2=2369.
pi=4*atan(1.)
!it=300
do it=10,300,10
Sv=0.
do ii=1,47
open(unit=15,file='kbz.dat',status='unknown')
read(15,*) q(1),q(2),q(3),iw
q(1)=0.1*q(1)
q(2)=0.1*q(2)
q(3)=0.1*q(3)
!do z=1,20
!q(1)=0.05*z
!q(2)=0.05*z
do i=1,3
c(i)=cos(pi*q(i))
s(i)=sin(pi*q(i))
end do
do i=1,3
if (i==1) then
j=2
k=3
end if
if (i==2) then
j=3
k=1
end if
if (i==3) then
j=1
k=2
end if
a(i,i)=2*a1*(2-c(i)*(c(j)+c(k)))+4*a2*s(i)**2+2*b1*(4-c(i)*(c(j)+c(k))-
2*c(j)*c(k))+4*b2*(s(j)**2+s(k)**2)
end do
do i=1,3
do j=1,3
do k=1,3
if (i==j.or.j==k) goto 200
a(i,j)=2*(a1-2*b1)*s(i)*s(j)
200 continue
end do
end do
enddo
!do i=1,3
!write (*,*) (d(i,j),j=1,3)
!end do
!do i=1,3
!write (*,10)(d(i,j) ,j=1,3)
!10 format (3(5xf10.3))
!end do
call jacobi(a,3,d,v,nrot)
w1=sqrt(d(1)/m)
w2=sqrt(d(2)/m)
w3=sqrt(d(3)/m)
f1=w1/(2*pi)
f2=w2/(2*pi)
f3=w3/(2*pi)
x1=10*h*f1/(kb*it)
x2=10*h*f2/(kb*it)
x3=10*h*f3/(kb*it)
ef1=(x1**2)*exp(x1)/(exp(x1)-1)**2
ef2=(x2**2)*exp(x2)/(exp(x2)-1)**2
ef3=(x3**2)*exp(x3)/(exp(x3)-1)**2
ef=ef1+ef2+ef3
Sv=Sv+3*Na*kb*((ef*iw)/(3000*4.186))
!write (20,*) w1/(2*pi), w2/(2*pi), w3/(2*pi)
!write(*,*) d(1),d(2),d(3)
!write(*,*) f1,f2,f3
!write (*,*) ef1,ef2,ef3,ef
end do
close(15)
write (*,*) it,Sv
end do
end
!1234567890123456
! In the following routine the n×n symmetric matrix a(1:n,1:n) is stored in
! an np×np array. On output, the superdiagonal elements of a are destroyed, but the
! diagonal and subdiagonal are unchanged and give full information on the original
! symmetric matrix a. The parameter d is a vector of length np. On output, it
returns
! the eigenvalues of a in its first n elements. During the computation, it contains
the
! current diagonal of a. The matrix v outputs the normalized eigenvector belonging
! to d(k) in its kth column. The parameter nrot is the number of Jacobi rotations
! that were needed to achieve convergence.
! Typical matrices require 6 to 10 sweeps to achieve convergence, or 3n 2 to 5n2
! Jacobi rotations. Each rotation requires of order 4n operations, each consisting
! of a multiply and an add, so the total labor is of order 12n3 to 20n3 operations.
! Calculation of the eigenvectors as well as the eigenvalues changes the operation
! count from 4n to 6n per rotation, which is only a 50 percent overhead.
!program eigenv
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Calcul des valeurs propres de la matrice a(nxn)
! dans ce cas on a pris n=3.
! les valeurs propres sont données dans le vecteur d(3).
! les vecteurs propres sont donnés dans la matrice v(3x3), ou
! la colonne i contient les composantes du ieme vecteur.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE jacobi(a,n,d,v,nrot)
! dimension a(3,3),d(3),c(3),s(3),v(3,3),q(3)
! INTEGER n,np,nrot,NMAX
! REAL a(3,3),d(3),v(3,3)
! REAL a(np,np),d(np),v(np,np)
! PARAMETER (NMAX=500)
! INTEGER i,ip,iq,j
! REAL c1,g,h,s1,sm,t,tau,theta,tresh,b(NMAX),z(NMAX)
dimension a(3,3),d(3),v(3,3)
! integer n,nrot,nmax
parameter (nmax=500)
integer i,ip,iq,j
real c,g,h,s,sm,t,tau,theta,tresh,b(nmax),z(nmax)
!
do 12 ip=1,n
do 11 iq=1,n
v(ip,iq)=0.
11 continue
v(ip,ip)=1.
12 continue
do 13 ip=1,n
b(ip)=a(ip,ip)
d(ip)=b(ip)
z(ip)=0.
13 continue
nrot=0
do 24 i=1,50
sm=0.
do 15 ip=1,n-1
do 14 iq=ip+1,n
sm=sm+abs(a(ip,iq))
14 continue
15 continue
if(sm.eq.0.) goto 24
! if(sm.eq.0.)return
if(i<4)then
tresh=0.2*sm/n**2
else
tresh=0.
endif
do 22 ip=1,n-1
do 21 iq=ip+1,n
g=100.*abs(a(ip,iq))
!
if((i>4).and.(abs(d(ip))+g==abs(d(ip))).and.(abs(d(iq))+g==abs(d(iq))))then
a(ip,iq)=0.
else if(abs(a(ip,iq))>tresh)then
h=d(iq)-d(ip)
if(abs(h)+g==abs(h))then
!
t=a(ip,iq)/h
else
theta=0.5*h/a(ip,iq)
t=1./(abs(theta)+sqrt(1.+theta**2))
if(theta<0.)t=-t
endif
c1=1./sqrt(1+t**2)
s1=t*c1
tau=s1/(1.+c1)
h=t*a(ip,iq)
z(ip)=z(ip)-h
z(iq)=z(iq)+h
d(ip)=d(ip)-h
d(iq)=d(iq)+h
a(ip,iq)=0.
do 16 j=1,ip-1
g=a(j,ip)
h=a(j,iq)
a(j,ip)=g-s1*(h+g*tau)
a(j,iq)=h+s1*(g-h*tau)
16 continue
do 17 j=ip+1,iq-1
g=a(ip,j)
h=a(j,iq)
a(ip,j)=g-s1*(h+g*tau)
a(j,iq)=h+s1*(g-h*tau)
17 continue
do 18 j=iq+1,n
g=a(ip,j)
h=a(iq,j)
a(ip,j)=g-s1*(h+g*tau)
a(iq,j)=h+s1*(g-h*tau)
18 continue
do 19 j=1,n
g=v(j,ip)
h=v(j,iq)
v(j,ip)=g-s1*(h+g*tau)
v(j,iq)=h+s1*(g-h*tau)
19 continue
nrot=nrot+1
endif
21 continue
22 continue
do 23 ip=1,n
b(ip)=b(ip)+z(ip)
d(ip)=b(ip)
z(ip)=0.
23 continue
24 continue
!
! pause
return
END

CV

Uploaded by

Copyright:

Available Formats

CV

Uploaded by

Document Information

Original Title

Copyright

Available Formats

Share this document

Share or Embed Document

Sharing Options

Did you find this document useful?

Is this content inappropriate?

Copyright:

Available Formats

CV

Uploaded by

Copyright:

Available Formats

program dispersion_110

You might also like

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.