c************************************************************************

	SUBROUTINE tycho(bt,dbt,vt,dvt,hp,dhp,b,db,v,dv,vh,dvh,bh,dbh)
	
c routine PUBLIC du module mod_photo
	
c transforme les magnitude tycho (bt,vt) et Hipparcos (hp) en V, B et Vh
c pour B-G stars et K-M geantes, suivant Bessell 2000 PASP 112, 961

c Auteur: P. Morel, Laboratoire Lagrange, O.C.A., CESAM2k

c entrees:
c	bt,dbt,vt,dvt,hp,dhp: magnitudes apparentes Tycho et Hipparcos
c	et precision

c sorties:
c	b, v: magnitudes apparentes B et V deduites de bt et vt
c	vh,bh: magnitudes apparentes B et V deduite de Hp
c	dv,vh,dvh,dbh: precision

c---------------------------------------------------------------------

	USE mod_kind
	USE mod_numerique, ONLY : bsp1dn
	
	IMPLICIT NONE
	
	INTEGER, PARAMETER :: m=4, n=46

	REAL (kind=dp), INTENT(in) :: bt, dbt, vt, dvt, hp, dhp
	REAL (kind=dp), INTENT(out) :: b, db, v, dv, vh, dvh, bh, dbh
	
	REAL (kind=dp), DIMENSION(3,n), SAVE :: table2	
	REAL (kind=dp), DIMENSION(n), SAVE :: bmvt
	REAL (kind=dp), DIMENSION(n+m), SAVE :: bmvtt
	REAL (kind=dp), DIMENSION(3) :: fx, dfxdx
	REAL (kind=dp) :: bmv, btmvt, dbmvt, dfx1, dfx2, dfx3, dbmv 	
		
	INTEGER, SAVE :: knot, l=m
	
	LOGICAL, SAVE :: init=.TRUE.
		
	bmvt=(/
	1-0.250d0,-0.200d0,-0.150d0,-0.100d0,-0.050d0,-0.000d0,
	2+0.050d0,+0.100d0,+0.150d0,+0.200d0,+0.250d0,+0.300d0,
	3+0.350d0,+0.400d0,+0.450d0,+0.500d0,+0.550d0,+0.600d0,
	4+0.650d0,+0.700d0,+0.750d0,+0.800d0,+0.850d0,+0.900d0,
	5+0.950d0,+1.000d0,+1.050d0,+1.100d0,+1.150d0,+1.200d0,
	6+1.250d0,+1.300d0,+1.350d0,+1.400d0,+1.450d0,+1.500d0,
	7+1.550d0,+1.600d0,+1.650d0,+1.700d0,+1.750d0,+1.800d0,
	8+1.850d0,+1.900d0,+1.950d0,+2.000d0 /)
	
	table2(1,:)=(/
	1+0.038d0,+0.030d0,+0.022d0,+0.015d0,+0.008d0,+0.001d0,
	2-0.005d0,-0.012d0,-0.018d0,-0.024d0,-0.029d0,-0.035d0,
	3-0.040d0,-0.045d0,-0.050d0,-0.054d0,-0.059d0,-0.064d0,
	4-0.068d0,-0.072d0,-0.077d0,-0.081d0,-0.085d0,-0.089d0,	
	5-0.093d0,-0.098d0,-0.102d0,-0.106d0,-0.110d0,-0.115d0,
	6-0.119d0,-0.124d0,-0.128d0,-0.133d0,-0.138d0,-0.143d0,	
	7-0.148d0,-0.154d0,-0.160d0,-0.165d0,-0.172d0,-0.178d0,	
	8-0.185d0,-0.191d0,-0.199d0,-0.206d0 /)
	
	table2(2,:)=(/
	1+0.031d0,+0.021d0,+0.011d0,+0.005d0,+0.002d0,-0.005d0,
	2-0.010d0,-0.017d0,-0.020d0,-0.021d0,-0.023d0,-0.025d0,
	3-0.025d0,-0.026d0,-0.030d0,-0.035d0,-0.045d0,-0.051d0,
	4-0.060d0,-0.068d0,-0.076d0,-0.085d0,-0.094d0,-0.104d0,	
	5-0.113d0,-0.122d0,-0.131d0,-0.142d0,-0.154d0,-0.166d0,	
	6-0.178d0,-0.189d0,-0.199d0,-0.210d0,-0.222d0,-0.234d0,	
	7-0.245d0,-0.256d0,-0.266d0,-0.277d0,-0.288d0,-0.299d0,
	8-0.309d0,-0.320d0,-0.331d0,-0.342d0 /)
	
	table2(3,:)=(/
	1+0.066d0,+0.051d0,+0.036d0,+0.021d0,+0.006d0,-0.011d0,
	2-0.025d0,-0.038d0,-0.048d0,-0.058d0,-0.069d0,-0.079d0,	
	3-0.087d0,-0.094d0,-0.101d0,-0.108d0,-0.114d0,-0.120d0,		
	4-0.127d0,-0.131d0,-0.134d0,-0.137d0,-0.142d0,-0.147d0,		
	5-0.151d0,-0.155d0,-0.158d0,-0.159d0,-0.160d0,-0.162d0,		
	6-0.164d0,-0.166d0,-0.166d0,-0.165d0,-0.164d0,-0.161d0,
	7-0.157d0,-0.153d0,-0.148d0,-0.143d0,-0.137d0,-0.131d0,
	8-0.125d0,-0.119d0,-0.112d0,-0.106d0 /)
	
c------------------------------------------------------------------------

	IF(init)THEN	!initialisations
	 init=.FALSE.
	 WRITE(*,1)	 
1	 FORMAT('magnitude tycho et Hipparcos pour B-G stars',/,
	1 'et K-M geantes, suivant Bessell 2000 PASP 112, 961')
	 CALL bsp1dn(3,table2,bmvt,bmvtt,n,m,knot,.FALSE.,
	1 bmvt(1),l,fx,dfxdx)
	ENDIF
	
	btmvt=bt-vt ; dbmvt=dbt+dvt 
	CALL bsp1dn(3,table2,bmvt,bmvtt,n,m,knot,.TRUE.,btmvt,l,fx,dfxdx)
	
c (B-V)=Bt-Vt+delta(B-V), B=(B-V)+(V-vt)+vt, V=B-(B-V), Vh=(V-Hp)+Hp
	dfx1=abs(dfxdx(1))*dbmvt+0.03d0
	dfx2=abs(dfxdx(2))*dbmvt+0.03d0
	dfx3=abs(dfxdx(3))*dbmvt+0.03d0
	bmv=btmvt+fx(2) ; dbmv=sqrt(dbmvt**2+dfx2**2)
	b=bmv+fx(1)+vt  ; db=sqrt(dbmv**2+dfx1**2)
	v=b-bmv ; dv=sqrt(db**2+dbmv**2) 
	vh=fx(3)+hp ; dvh=sqrt(dhp**2+dfx3**2)
	bh=vh+bmv ; dbh=sqrt(dhp**2+dbmv**2)
		
	RETURN
	
	END SUBROUTINE tycho