Abrir - RDU

Apéndices 295
subroutine downhill
real*8 spec1(2e5,2),specobs(2e5,2),prex,spec5(2e5,1)
real*8 desde,hasta,delta,lam,rlam,oldlam,diff,x,x1,x2
,y1,y2,px,int4
real*8 frad
real found,ex
character alpha*1
character fname*40,path*12,file1*80
common /comunes/
spec2,lam13,vrot,points,ndesder13,nhastar13,
np1,wspec,file
real*8 spec2(2e5),lam13(2e5),vrot,vrad
integer points
integer ndesder13,nhastar13,np1,wspec
character file*80
save /comunes/
real teff0,logg0,feh0,xita0
real uobs,bobs,yobs integer n
real*8 p0(4),p1(4),p2(4)
real*8 p3(4),p4(4),p(5,4)
real*8 y(5)
real*8 zx(4)
integer iterl
real*8 ftol
real*8 funk
real*8 vrestim
external funk
prex=0.0005
wspec=0
write(*,*)
write(*,*) file
write(*,*) Reading observed spectra ”
write(52,*)
write(52,*) file
write(52,*) Reading observed spectra ”
!lee specobs
file1=”datain///file
open(1,file=file1,status=. o ld”)
read(1,*) vrot,vrad
write(*,*) ”First values should be vsini:”,vrot,”km/s and
vrad:”,vrad,”km/s”
write(52,*) ”First values should be vsini:”,vrot,”km/s and
vrad:”,vrad,”km/s”
if (vrot.gt.1000) then
write(*,*) ”vrot out of limits”
write(52,*) ”vrot out of limits”
stop
endif
if ((vrad.gt.1000.).and.(vrad.ne.9999.)) then
write(*,*) ”vrad out of limits”
write(52,*) ”vrad out of limits”
stop
endif
n=1
frad=( (-vrad/299800.)+1)**-1
do
read(1,*,end=100) specobs(n,1),specobs(n,2) !lam,flux
if (vrad.ne.9999.) then
specobs(n,1)=specobs(n,1)*frad
endif
n=n+1
enddo
100close(1)
points=n-1
desde=specobs(1,1)
hasta=specobs(points,1)
delta=0.02
!write(*,*) ”lambda ranges ”,desde, hasta
write(*,*) Reading Stromgren u, b, y”
write(52,*) Reading Stromgren u, b, y”
open(10,file=”stromobs.dat”)
read(10,*) uobs,bobs,yobs
close(10)
write(*,*) . O bserved spectra covers from ”,desde,”to ”,hasta
write(*,*) ”Number of points = ”,points
write(*,*) ”Stromgren u b y = ”,uobs,bobs,yobs
write(52,*) . O bserved spectra covers from ”,desde,”to ”,hasta
write(52,*) ”Number of points = ”,points
write(52,*) ”Stromgren u b y = ”,uobs,bobs,yobs
oldlam=specobs(1,1)
open(47,file=”spec1.dat”)
write(47,*) specobs(1,1),specobs(1,2)
do i=2,points
lam=specobs(i,1)
int4=specobs(i,2)
diff=abs(lam-oldlam)
if (diff.gt.1) then
do rlam=oldlam+0.02,lam-0.02,0.02
write(47,*) rlam,9999.
enddo
endif
write(47,*) lam,int4
oldlam=lam
enddo
close(47)
open(47,file=”spec1.dat”)
i=1
do
read(47,*,end=260) spec1(i,1),spec1(i,2)
i=i+1
enddo
260close(47)