Révision 205
| TrouNoir/trou_noir.f (revision 205) | ||
|---|---|---|
| 26 | 26 |
REAL*8 rs,ri,re ! rayons de Schwarzschild,interieur et exterieur |
| 27 | 27 |
REAL*8 tho ! angle normale-disque & direction-observateur |
| 28 | 28 |
REAL*8 ro ! distance entre l'observateur et le trou noir |
| 29 |
INTEGER*4 q ! parametre de spectre
|
|
| 29 |
REAL*8 q ! parametre de spectre
|
|
| 30 | 30 |
REAL*4 bss ! borne superieure du spectre |
| 31 | 31 |
|
| 32 | 32 |
c |
| ... | ... | |
| 34 | 34 |
c |
| 35 | 35 |
|
| 36 | 36 |
INTEGER*4 dim ! dimension de la plaque photographique (en pixels) |
| 37 |
PARAMETER (dim=512)
|
|
| 37 |
PARAMETER (dim=1024)
|
|
| 38 | 38 |
REAL*4 stp ! pas d'iteration en pixels sur la plaque |
| 39 | 39 |
INTEGER*4 nmx ! nombre total d'iterations |
| 40 | 40 |
REAL*8 d ! distance exploree du centre de la plaque |
| ... | ... | |
| 59 | 59 |
c RESULTATS DE L'INTEGRATION DE L'EQUATION DIFFERENTIELLE |
| 60 | 60 |
c |
| 61 | 61 |
|
| 62 |
REAL*8 rp(2000) ! vecteur polaire
|
|
| 63 |
REAL*8 nh ! nombre d'avancements angulaires
|
|
| 62 |
REAL*8 rp(2048) ! vecteur polaire
|
|
| 63 |
INTEGER*4 nh ! nombre d'avancements angulaires
|
|
| 64 | 64 |
|
| 65 | 65 |
c |
| 66 | 66 |
c RESULTATS DE LA SIMULATION |
| ... | ... | |
| 68 | 68 |
|
| 69 | 69 |
REAL*4 zp(dim,dim) ! image en decalage spectral |
| 70 | 70 |
REAL*4 fp(dim,dim) ! image en flux |
| 71 |
REAL*8 fx(200) ! flux par tranche de decalage de frequence |
|
| 72 |
INTEGER*4 nt(200) ! nombre de photon par tranche de decalage |
|
| 73 | 71 |
|
| 74 | 72 |
c |
| 75 | 73 |
c AUTRES VARIABLES... |
| ... | ... | |
| 92 | 90 |
LOGICAL raie ! variable interactive de type de spectre |
| 93 | 91 |
LOGICAL dist ! variable interactive de distance |
| 94 | 92 |
|
| 93 |
REAL*4 t_start,t_stop |
|
| 95 | 94 |
c |
| 96 | 95 |
c TYPE DE SPECTRE |
| 97 | 96 |
c |
| 98 | 97 |
|
| 99 |
raie=.TRUE. ! TRUE -> raie infiniment fine |
|
| 100 |
c ! FALSE -> corps noir
|
|
| 98 |
c raie=.TRUE. ! TRUE -> raie infiniment fine
|
|
| 99 |
raie=.FALSE. ! FALSE -> corps noir
|
|
| 101 | 100 |
|
| 102 | 101 |
c |
| 103 | 102 |
c TYPE DE DISTANCE |
| 104 | 103 |
c |
| 105 | 104 |
|
| 106 |
dist=.TRUE. ! TRUE -> distance infinie |
|
| 107 |
c ! FALSE -> distance finie
|
|
| 105 |
c dist=.TRUE. ! TRUE -> distance infinie
|
|
| 106 |
dist=.FALSE. ! FALSE -> distance finie
|
|
| 108 | 107 |
|
| 109 | 108 |
c |
| 110 | 109 |
c INITIALISATION DES TABLEAUX |
| 111 | 110 |
c |
| 112 | 111 |
|
| 113 |
DO i=1,200 |
|
| 114 |
fx(i)=0. |
|
| 115 |
nt(i)=0 |
|
| 116 |
END DO |
|
| 117 |
|
|
| 118 | 112 |
DO i=1,dim |
| 119 | 113 |
DO j=1,dim |
| 120 | 114 |
zp(i,j)=0. |
| ... | ... | |
| 148 | 142 |
b=0. |
| 149 | 143 |
thx=asin(bmx/ro) |
| 150 | 144 |
pc=0 |
| 151 |
nbr=200
|
|
| 145 |
nbr=256
|
|
| 152 | 146 |
IF (raie .EQV. .TRUE.) THEN |
| 153 | 147 |
bss=2. |
| 154 | 148 |
ELSE |
| ... | ... | |
| 159 | 153 |
c BOUCLE PRINCIPALE DE LA SIMULATION |
| 160 | 154 |
c |
| 161 | 155 |
|
| 156 |
CALL TIMER(t_start) |
|
| 157 |
|
|
| 162 | 158 |
DO n=1,nmx |
| 163 |
pc=INT(100./nmx*n) |
|
| 164 |
IF (pc.NE.INT(100./nmx*(n-1))) WRITE (*,*) pc, ' %' |
|
| 165 | 159 |
|
| 166 | 160 |
c |
| 167 | 161 |
c Affectation des conditions initiales de la resolution Runge-Kutta |
| 168 | 162 |
c ( Premier etage d'imbrication -> n ) |
| 169 | 163 |
c |
| 170 |
h=pi/500.
|
|
| 164 |
h=4*pi/2048.
|
|
| 171 | 165 |
d=stp*n |
| 172 | 166 |
IF (dist .EQV. .TRUE.) THEN |
| 173 | 167 |
db=bmx/nmx |
| ... | ... | |
| 206 | 200 |
c ( Deuxieme etage d'imbrication -> n & 1 ) |
| 207 | 201 |
c |
| 208 | 202 |
|
| 209 |
DO i=nh+1,2000
|
|
| 203 |
DO i=nh+1,2048
|
|
| 210 | 204 |
rp(i)=0. |
| 211 | 205 |
END DO |
| 212 | 206 |
|
| ... | ... | |
| 261 | 255 |
c S'il y a impact calcul - du rapport de frequence |
| 262 | 256 |
c - du spectre de photons et de flux |
| 263 | 257 |
|
| 264 |
CALL impact(raie,d,phi,dim,r,b,tho,m,zp,fp,nt,
|
|
| 265 |
& fx,q,db,h,nbr,bss)
|
|
| 258 |
CALL impact(raie,d,phi,dim,r,b,tho,m,zp,fp, |
|
| 259 |
& q,db,h,nbr,bss) |
|
| 266 | 260 |
|
| 267 | 261 |
END IF |
| 268 | 262 |
|
| ... | ... | |
| 271 | 265 |
END DO |
| 272 | 266 |
END DO |
| 273 | 267 |
|
| 268 |
|
|
| 269 |
CALL TIMER(t_stop) |
|
| 270 |
|
|
| 271 |
WRITE (*,*) 'Elapsed time = ', t_stop - t_start |
|
| 272 |
|
|
| 274 | 273 |
c Appel de la routine d'affichage |
| 275 | 274 |
|
| 276 |
CALL affichage(zp,fp,nt,fx,dim,nbr,bss,bmx,m,ri,re,tho,pi)
|
|
| 275 |
CALL affichage(zp,fp,dim,nbr,bss,bmx,m,ri,re,tho,pi) |
|
| 277 | 276 |
|
| 278 | 277 |
WRITE(*,*) |
| 279 | 278 |
WRITE(*,*) 'C''est TERMINE ! ' |
| 280 | 279 |
WRITE(*,*) |
| 281 | 280 |
|
| 282 | 281 |
STOP |
| 283 |
END |
|
| 282 |
END PROGRAM
|
|
| 284 | 283 |
|
| 285 | 284 |
c |
| 286 | 285 |
c Cette fonction permet de trouver un arctangente entre 0 et 2*pi |
| ... | ... | |
| 311 | 310 |
END |
| 312 | 311 |
|
| 313 | 312 |
c |
| 313 |
c |
|
| 314 |
c |
|
| 315 |
SUBROUTINE timer(ytime) |
|
| 316 |
REAL*4 ytime |
|
| 317 |
INTEGER*4 clk_max,clk_rate,clk_read |
|
| 318 |
|
|
| 319 |
CALL SYSTEM_CLOCK(clk_read,clk_rate,clk_max) |
|
| 320 |
|
|
| 321 |
ytime=FLOAT(clk_read)/FLOAT(clk_rate) |
|
| 322 |
|
|
| 323 |
RETURN |
|
| 324 |
END |
|
| 325 |
c |
|
| 314 | 326 |
c Premiere fonction du systeme -> ( d(u)/d(phi)=f(phi,u,v) ) |
| 315 | 327 |
c |
| 316 | 328 |
|
| ... | ... | |
| 366 | 378 |
c |
| 367 | 379 |
|
| 368 | 380 |
SUBROUTINE impact(raie,d,phi,dim,r,b,tho,m,zp,fp, |
| 369 |
& nt,fx,q,db,h,nbr,bss)
|
|
| 370 |
REAL*8 d,phi,r,b,tho,m,fx(200),db,h
|
|
| 371 |
INTEGER*4 dim,nt(200),q,nbr
|
|
| 381 |
& q,db,h,nbr,bss) |
|
| 382 |
REAL*8 d,phi,r,b,tho,m,db,h,q
|
|
| 383 |
INTEGER*4 dim |
|
| 372 | 384 |
REAL*4 zp(dim,dim),fp(dim,dim),bss |
| 373 | 385 |
REAL*4 xe,ye |
| 374 | 386 |
INTEGER*4 xi,yi |
| ... | ... | |
| 390 | 402 |
c pour le cas d'une raie infiniment fine ou un corps noir |
| 391 | 403 |
|
| 392 | 404 |
IF (raie .EQV. .TRUE.) THEN |
| 393 |
CALL spectre(nt,fx,rf,q,b,db,h,r,m,nbr,bss,flx)
|
|
| 405 |
CALL spectre(rf,q,b,db,h,r,m,bss,flx)
|
|
| 394 | 406 |
ELSE |
| 395 |
CALL spectre_bb(nt,fx,rf,q,b,db,h,r,m,nbr,bss,flx)
|
|
| 407 |
CALL spectre_bb(rf,b,db,h,r,m,nbr,bss,flx)
|
|
| 396 | 408 |
END IF |
| 397 | 409 |
|
| 398 | 410 |
c Affectation sur chacune des images du decalage spectral et du flux |
| ... | ... | |
| 413 | 425 |
|
| 414 | 426 |
c Calcul du flux puis du spectre pour une raie infiniment fine |
| 415 | 427 |
|
| 416 |
SUBROUTINE spectre(nt,fx,rf,q,b,db,h,r,m,nbr,bss,flx) |
|
| 417 |
REAL*8 fx(200) |
|
| 418 |
REAL*8 rf,b,db,h,r,m,flx |
|
| 428 |
SUBROUTINE spectre(rf,q,b,db,h,r,m,bss,flx) |
|
| 429 |
REAL*8 rf,b,db,h,r,m,flx,q |
|
| 419 | 430 |
REAL*4 bss |
| 420 |
INTEGER*4 nt(200),q,nbr |
|
| 421 |
INTEGER*4 fi |
|
| 422 |
fi=INT(rf*nbr/bss) |
|
| 423 |
nt(fi)=nt(fi)+1 |
|
| 424 | 431 |
flx=(r/m)**q*rf**4*b*db*h |
| 425 |
fx(fi)=fx(fi)+flx |
|
| 426 | 432 |
RETURN |
| 427 | 433 |
END |
| 428 | 434 |
|
| 429 | 435 |
c Calcul du flux puis du spectre pour un corps noir |
| 430 | 436 |
|
| 431 |
SUBROUTINE spectre_bb(nr,fx,rf,q,b,db,h,r,m,nbr,bss,flx)
|
|
| 432 |
REAL*8 fx(200),nu_rec,nu_em,qu,v
|
|
| 437 |
SUBROUTINE spectre_bb(rf,b,db,h,r,m,nbr,bss,flx)
|
|
| 438 |
REAL*8 nu_rec,nu_em,qu,v |
|
| 433 | 439 |
REAL*8 rf,b,db,h,r,m,flx,temp,temp_em,flux_int |
| 434 | 440 |
REAL*8 m_point |
| 435 | 441 |
REAL*4 bss |
| 436 |
INTEGER*4 nr(200),q,nbr
|
|
| 442 |
INTEGER*4 nbr |
|
| 437 | 443 |
INTEGER*4 fi,posfreq |
| 438 |
REAL*8 planck,c,k |
|
| 439 |
PARAMETER (planck=6.62e-34) ! definition des constantes |
|
| 440 |
PARAMETER (c=3.e8) |
|
| 441 |
PARAMETER (k=1.38e-23) |
|
| 444 |
REAL*8, PARAMETER :: planck=6.62e-34 ! definition des constantes |
|
| 445 |
REAL*8, PARAMETER :: c=3.e8 |
|
| 446 |
REAL*8, PARAMETER :: k=1.38e-23 |
|
| 442 | 447 |
|
| 443 | 448 |
c |
| 444 | 449 |
c Definition des parametres pour le calcul de la temperature d'emission |
| ... | ... | |
| 454 | 459 |
|
| 455 | 460 |
c qu -> Q du rapport |
| 456 | 461 |
|
| 457 |
qu=((1-3./r)**-.5)*(r**-.5)*((r**.5-6.**.5)+
|
|
| 458 |
& ((3.**.5)/2.)*log ((r**.5)-(3.**.5))*0.171517)
|
|
| 462 |
qu=((1-3./r)**-0.5)*(r**-0.5)*(r**0.5-6.**0.5+
|
|
| 463 |
& (3.**0.5/2.)*log((r**0.5+3.**0.5)/(r**0.5-3**0.5)*0.1715728752))
|
|
| 459 | 464 |
qu=abs(qu) |
| 460 |
temp_em=temp*m**.5 |
|
| 461 |
temp_em=temp_em*m_point**.25 |
|
| 462 |
temp_em=temp_em*r**(-.75) |
|
| 463 |
temp_em=temp_em*v**(-1./8.)
|
|
| 464 |
temp_em=temp_em*qu**.25 |
|
| 465 |
temp_em=temp*m**0.5
|
|
| 466 |
temp_em=temp_em*m_point**0.25
|
|
| 467 |
temp_em=temp_em*r**(-0.75)
|
|
| 468 |
temp_em=temp_em*v**(-0.125)
|
|
| 469 |
temp_em=temp_em*qu**0.25
|
|
| 465 | 470 |
|
| 466 | 471 |
c |
| 467 | 472 |
c initialisation des compteurs de flux |
| ... | ... | |
| 479 | 484 |
DO fi=1,nbr |
| 480 | 485 |
nu_em=bss*fi/nbr !frequence d' emission |
| 481 | 486 |
nu_rec=nu_em*rf !frequence de reception |
| 482 |
posfreq=INT(nu_rec*200./bss) !case ou se trouve nu rec
|
|
| 487 |
posfreq=INT(nu_rec*FLOAT(nbr)/bss) !case ou se trouve nu rec
|
|
| 483 | 488 |
|
| 484 | 489 |
c |
| 485 | 490 |
c test pour savoir si la frequence de reception est bien dans le |
| ... | ... | |
| 487 | 492 |
c |
| 488 | 493 |
|
| 489 | 494 |
if ((posfreq.GE.1).AND.(posfreq.LE.nbr)) THEN |
| 490 |
nr(posfreq)=nr(posfreq)+1 |
|
| 491 | 495 |
|
| 492 | 496 |
c Loi du corps noir |
| 493 | 497 |
|
| 494 |
flux_int=(2.*h*(nu_em**3/c**2))*
|
|
| 495 |
& (1./(exp(planck*nu_em/(k*temp_em))-1.))
|
|
| 498 |
flux_int=2.*nu_em**3/c**2*planck/
|
|
| 499 |
& (exp(planck*nu_em/(k*temp_em))-1.)
|
|
| 496 | 500 |
|
| 497 | 501 |
c Integration sur le pixel |
| 498 | 502 |
|
| 499 | 503 |
flux_int=flux_int*rf**3*b*db*h |
| 500 | 504 |
|
| 501 |
c Remplissage du spectre
|
|
| 505 |
c Integration bolometrique
|
|
| 502 | 506 |
|
| 503 |
fx(posfreq)=flux_int+fx(posfreq) |
|
| 504 |
|
|
| 505 |
c Intergration bolometrique |
|
| 506 |
|
|
| 507 | 507 |
flx=flx+flux_int |
| 508 | 508 |
ENDIF |
| 509 | 509 |
END DO |
| 510 |
|
|
| 510 | 511 |
RETURN |
| 511 | 512 |
END |
| 512 | 513 |
|
| ... | ... | |
| 521 | 522 |
c - Dessin du spectre en nombre de photons |
| 522 | 523 |
c |
| 523 | 524 |
|
| 524 |
SUBROUTINE affichage(zp,fp,nt,fx,dim,nbr,bss,bmx,m,ri,re,tho,pi)
|
|
| 525 |
INTEGER*4 nt(200),dim,nbr
|
|
| 525 |
SUBROUTINE affichage(zp,fp,dim,nbr,bss,bmx,m,ri,re,tho,pi) |
|
| 526 |
INTEGER*4 dim
|
|
| 526 | 527 |
REAL*4 zp(dim,dim),fp(dim,dim),bss |
| 527 |
REAL*8 fx(200),bmx,m,ri,re,tho,pi
|
|
| 528 |
REAL*8 bmx,m,ri,re,tho,pi |
|
| 528 | 529 |
INTEGER*4 np,i,j |
| 529 | 530 |
REAL*8 fm,nm |
| 530 |
REAL*4 fmx,zmx,x(200),y(200),tr(6),c(20),bmp
|
|
| 531 |
REAL*4 fmx,zmx,x(1024),y(1024),tr(6),c(20),bmp
|
|
| 531 | 532 |
LOGICAL tg |
| 532 | 533 |
LOGICAL ps |
| 533 | 534 |
|
| 534 | 535 |
tg=.TRUE. ! TRUE : affichage en tons de gris |
| 535 | 536 |
c ! FALSE : affichage en contours |
| 536 | 537 |
|
| 537 |
ps=.FALSE. ! TRUE : affichage postscript
|
|
| 538 |
ps=.TRUE. ! TRUE : affichage postscript
|
|
| 538 | 539 |
c ! FALSE : affichage fenetre Xwindow |
| 539 | 540 |
|
| 540 | 541 |
|
| ... | ... | |
| 542 | 543 |
c TRANSFORMATION DE L'IMAGE DES FLUX : FLUX -> FLUX RELATIFS |
| 543 | 544 |
c |
| 544 | 545 |
|
| 545 |
np=0 |
|
| 546 |
fm=0. |
|
| 547 |
DO i=1,dim |
|
| 548 |
DO j=1,dim |
|
| 549 |
IF (fp(i,j).NE.0.) np=np+1 |
|
| 550 |
fm=fm+fp(i,j) |
|
| 551 |
END DO |
|
| 552 |
END DO |
|
| 553 |
fm=fm/np |
|
| 554 |
|
|
| 555 | 546 |
c |
| 556 | 547 |
c DETERMINATION DU DECALAGE SPECTRAL MAXIMUM ET DU FLUX MAXIMUM |
| 557 | 548 |
c |
| ... | ... | |
| 560 | 551 |
zmx=0. |
| 561 | 552 |
DO i=1,dim |
| 562 | 553 |
DO j=1,dim |
| 563 |
fp(i,j)=fp(i,j)/fm |
|
| 564 | 554 |
IF (fmx.LT.fp(i,j)) fmx=fp(i,j) |
| 565 | 555 |
IF (zmx.LT.zp(i,j)) zmx=zp(i,j) |
| 566 | 556 |
END DO |
| 567 | 557 |
END DO |
| 568 | 558 |
|
| 559 |
write(*,*) 'Flux max :',fmx |
|
| 560 |
write(*,*) 'Z max :',zmx |
|
| 561 |
|
|
| 562 |
|
|
| 569 | 563 |
DATA tr/0.,1.,0.,0.,0.,1./ |
| 570 | 564 |
|
| 571 | 565 |
c |
| ... | ... | |
| 573 | 567 |
c |
| 574 | 568 |
|
| 575 | 569 |
if (ps .EQV. .TRUE.) THEN |
| 576 |
CALL PGBEGIN (0,'image1.ps/ps',1,1)
|
|
| 570 |
CALL PGBEGIN (0,'z.ps/ps',1,1)
|
|
| 577 | 571 |
ELSE |
| 578 | 572 |
CALL PGBEGIN (0,'/xwindow',1,1) |
| 579 | 573 |
END IF |
| ... | ... | |
| 591 | 585 |
DO i=1,20 |
| 592 | 586 |
c(i)=0.2*(i-1) |
| 593 | 587 |
END DO |
| 594 |
CALL PGCONS(zp,dim,dim,1,dim,1,dim,c,12,tr)
|
|
| 588 |
CALL PGCONS(zp,dim,dim,1,dim,1,dim,c,20,tr)
|
|
| 595 | 589 |
END IF |
| 596 | 590 |
CALL PGEND |
| 597 | 591 |
|
| ... | ... | |
| 600 | 594 |
c |
| 601 | 595 |
|
| 602 | 596 |
if (ps .EQV. .TRUE.) THEN |
| 603 |
CALL PGBEGIN (0,'image2.ps/ps',1,1)
|
|
| 597 |
CALL PGBEGIN (0,'flux.ps/ps',1,1)
|
|
| 604 | 598 |
ELSE |
| 605 | 599 |
CALL PGBEGIN (0,'/xwindow',1,1) |
| 606 | 600 |
END IF |
| ... | ... | |
| 622 | 616 |
END IF |
| 623 | 617 |
CALL PGEND |
| 624 | 618 |
|
| 625 |
c |
|
| 626 |
c AFFICHAGE DES DONNEES PHYSIQUES |
|
| 627 |
c |
|
| 628 |
|
|
| 629 |
bmp=bmx |
|
| 630 |
|
|
| 631 |
if (ps .EQV. .TRUE.) THEN |
|
| 632 |
CALL PGBEGIN (0,'image3.ps/ps',1,1) |
|
| 633 |
ELSE |
|
| 634 |
CALL PGBEGIN (0,'/xwindow',1,1) |
|
| 635 |
END IF |
|
| 636 |
CALL PGENV (-bmp,bmp,-bmp,bmp,1,0) |
|
| 637 |
CALL PGLABEL('Rayon de Schwarzschild &
|
|
| 638 |
&Parametre d''impact critique','', |
|
| 639 |
&'DISQUE D''ACCRETION AUTOUR D''UN TROU NOIR') |
|
| 640 |
DO i=1,200 |
|
| 641 |
x(i)=2.*m*cos(2.*pi*i/200.) |
|
| 642 |
y(i)=2.*m*sin(2.*pi*i/200.) |
|
| 643 |
END DO |
|
| 644 |
CALL PGLINE(200,x,y) |
|
| 645 |
DO i=1,200 |
|
| 646 |
x(i)=m*SQRT(27.)*cos(2.*pi*i/200.) |
|
| 647 |
y(i)=m*SQRT(27.)*sin(2.*pi*i/200.) |
|
| 648 |
END DO |
|
| 649 |
CALL PGLINE(200,x,y) |
|
| 650 |
CALL PGEND |
|
| 651 |
|
|
| 652 |
c |
|
| 653 |
c AFFICHAGE DES CONTOURS DU DISQUE |
|
| 654 |
c |
|
| 655 |
|
|
| 656 |
if (ps .EQV. .TRUE.) THEN |
|
| 657 |
CALL PGBEGIN (0,'image4.ps/ps',1,1) |
|
| 658 |
ELSE |
|
| 659 |
CALL PGBEGIN (0,'/xwindow',1,1) |
|
| 660 |
END IF |
|
| 661 |
CALL PGENV(-bmp,bmp,-bmp,bmp,1,0) |
|
| 662 |
CALL PGLABEL('Limites interieure &
|
|
| 663 |
&exterieure du disque a l''infini','', |
|
| 664 |
&'DISQUE D''ACCRETION AUTOUR D''UN TROU NOIR') |
|
| 665 |
DO i=1,200 |
|
| 666 |
x(i)=ri*cos(2.*pi*i/200.) |
|
| 667 |
y(i)=ri*cos(tho)*sin (2.*pi*i/200.) |
|
| 668 |
END DO |
|
| 669 |
CALL PGLINE(200,x,y) |
|
| 670 |
DO i=1,200 |
|
| 671 |
x(i)=re*cos(2.*pi*i/200.) |
|
| 672 |
y(i)=re*cos(tho)*sin(2.*pi*i/200.) |
|
| 673 |
END DO |
|
| 674 |
CALL PGLINE(200,x,y) |
|
| 675 |
CALL PGEND |
|
| 676 |
|
|
| 677 |
c |
|
| 678 |
c DETERMINATION DES FLUX ET NOMBRE D'IMPACTS MOYENS SUR LES SPECTRES |
|
| 679 |
c |
|
| 680 |
|
|
| 681 |
fm=0. |
|
| 682 |
nm=0. |
|
| 683 |
stp=bss/nbr |
|
| 684 |
j=0 |
|
| 685 |
do i=1,nbr |
|
| 686 |
x(i)=i*stp |
|
| 687 |
fm=fm+fx(i) |
|
| 688 |
nm=nm+1.*nt(i) |
|
| 689 |
IF (nt(i).GT.0) j=j+1 |
|
| 690 |
END DO |
|
| 691 |
fm=fm/j |
|
| 692 |
nm=nm/j |
|
| 693 |
|
|
| 694 |
c |
|
| 695 |
c AFFICHAGE DU SPECTRE EN FLUX |
|
| 696 |
c |
|
| 697 |
|
|
| 698 |
DO i=1,nbr |
|
| 699 |
y(i)=fx(i)/fm |
|
| 700 |
END DO |
|
| 701 |
if (ps .EQV. .TRUE.) THEN |
|
| 702 |
CALL PGBEGIN (0,'image5.ps/ps',1,1) |
|
| 703 |
ELSE |
|
| 704 |
CALL PGBEGIN (0,'/xwindow',1,1) |
|
| 705 |
END IF |
|
| 706 |
CALL PGENV (0.,2.,0.,10.,0,1) |
|
| 707 |
CALL PGLABEL('Rapport des frequences recue/emise',
|
|
| 708 |
&'Flux relatif','SPECTRE DU DISQUE') |
|
| 709 |
CALL PGLINE(200,x,y) |
|
| 710 |
CALL PGEND |
|
| 711 |
|
|
| 712 |
c |
|
| 713 |
c AFFICHAGE DU SPECTRE EN NOMBRE D'IMPACTS |
|
| 714 |
c |
|
| 715 |
|
|
| 716 |
DO i=1,nbr |
|
| 717 |
y(i)=1.*nt(i)/nm |
|
| 718 |
END DO |
|
| 719 |
if (ps .EQV. .TRUE.) THEN |
|
| 720 |
CALL PGBEGIN (0,'image6.ps/ps',1,1) |
|
| 721 |
ELSE |
|
| 722 |
CALL PGBEGIN (0,'/xwindow',1,1) |
|
| 723 |
END IF |
|
| 724 |
CALL PGENV(0.,2.,0.,10.,0,1) |
|
| 725 |
CALL PGLABEL('Rapport des frequences recue/emise',
|
|
| 726 |
&' Nombre relatif d''impacts','SPECTRE DU DISQUE') |
|
| 727 |
CALL PGLINE(200,x,y) |
|
| 728 |
CALL PGEND |
|
| 729 |
|
|
| 730 |
RETURN |
|
| 731 | 619 |
END |
| 732 |
|
|
| 733 | 620 |
c compilation : |
| 734 | 621 |
c gfortran --std=gnu -o trou_noir_Fortran trou_noir.f -lpgplot |
| 735 | 622 |
c SORTIE GRAPHIQUE : -> Envoi sur l'ecran : /xwindow |
Formats disponibles : Unified diff