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

	PROGRAM fichier_vent
	
c construit un fichier "vent" à partir des abondances qu'il convient de modifier
c	selon les desiderata	

c	Auteur: P.Morel, Département Cassiopée, O.C.A.,
c	CESAM2k

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

	USE mod_kind
	
	IMPLICIT NONE
		
	REAL (kind=dp), DIMENSION(28) :: ab, m	
	REAL (kind=dp) :: vt_H, vt_He, vt_Li, vt_Be, vt_B, vt_C,
	1 vt_N, vt_O, vt_F, vt_Ne, vt_Na, vt_Mg, vt_Al, vt_Si,
	2 vt_P, vt_S, vt_Cl, vt_Ar, vt_K, vt_Ca, vt_Sc, vt_Ti,
	3 vt_V,vt_Cr, vt_Mn, vt_Fe, vt_Co, vt_Ni, p_vent

	CHARACTER (len=5), DIMENSION(28) :: elem	
	CHARACTER (len=20) :: nom_abon
	CHARACTER (len=50) :: chain
		
	NAMELIST/nl_vent/ vt_H, vt_He, vt_Li, vt_Be, vt_B, vt_C,
	1 vt_N, vt_O, vt_F, vt_Ne, vt_Na, vt_Mg, vt_Al, vt_Si,
	2 vt_P, vt_S, vt_Cl, vt_Ar, vt_K, vt_Ca, vt_Sc, vt_Ti,
	3 vt_V,vt_Cr, vt_Mn, vt_Fe, vt_Co, vt_Ni, p_vent
	
c----------------------------------------------------------------------

2000	FORMAT(8es10.3)

	elem(1)='vt_H' ; m(1)=1.0079d0		!masses de OPAL
	elem(2)='vt_He' ; m(2)=4.0026d0
	elem(3)='vt_Li' ; m(3)=6.941d0    
	elem(4)='vt_Be' ; m(4)=9.0122d0
	elem(5)='vt_B' ; m(5)=10.811d0       
	elem(6)='vt_C' ; m(6)=12.011d0
	elem(7)='vt_N' ; m(7)=14.0067d0  
	elem(8)='vt_O' ; m(8)=15.9994d0  
	elem(9)='vt_F' ; m(9)=18.9984d0  
	elem(10)='vt_Ne' ; m(10)=20.179d0  
	elem(11)='vt_Na' ; m(11)=22.98977d0
	elem(12)='vt_Mg' ; m(12)=24.305d0  
	elem(13)='vt_Al' ; m(13)=26.98154d0 
	elem(14)='vt_Si' ; m(14)=28.0855d0  
	elem(15)='vt_P' ; m(15)=30.97376d0
	elem(16)='vt_S' ; m(16)=32.06d0   
	elem(17)='vt_Cl' ; m(17)=35.453d0  
	elem(18)='vt_Ar' ; m(18)=39.948d0
	elem(19)='vt_K' ; m(19)=39.0983d0          
	elem(20)='vt_Ca' ; m(20)=40.08d0   
	elem(21)='vt_Sc' ; m(21)=44.956d0  
	elem(22)='vt_Ti' ; m(22)=47.90d0
	elem(23)='vt_V' ; m(23)=50.9414d0
	elem(24)='vt_Cr' ; m(24)=51.996d0
	elem(25)='vt_Mn' ; m(25)=54.938d0
	elem(26)='vt_Fe' ; m(26)=55.847d0
	elem(27)='vt_Co' ; m(27)=58.9332d0
	elem(28)='vt_Ni' ; m(28)=58.7d0

c	nom_abon='meteorites_ag' 
	nom_abon='meteorites_gs'
c	nom_abon='solaire_gn'
c	nom_abon='solaire_gs'

	SELECT CASE(nom_abon)

c Mixture des météorites de Anders & Grevesse 89
	CASE('meteorites_ag')
	 ab(1)=2.79d10 ; ab(2)=2.72d9   ; ab(3)=57.1d0  ; ab(4)=0.73d0   ; ab(5)=21.2d0
	 ab(6)=1.01d7  ; ab(7)=3.13d6   ; ab(8)=2.38d7  ; ab(9)=843.d0   ; ab(10)=3.44d6
	 ab(11)=5.74d4 ; ab(12)=1.074d6 ; ab(13)=8.49d4 ; ab(14)=1.d6    ; ab(15)=1.04d4
	 ab(16)=5.15d5 ; ab(17)=5240.d0 ; ab(18)=1.01d5 ; ab(19)=3370.d0 ; ab(20)=6.11d4
	 ab(21)=34.2d0 ; ab(22)=2400.d0 ; ab(23)=293.d0 ; ab(24)=1.35d4  ; ab(25)=9550.d0
	 ab(26)=9.d5   ; ab(27)=2250.d0 ; ab(28)=4.93d4
	 ab=ab*m 
	
c Mixture des météorites de Grevesse & Sauval 98
	CASE('meteorites_gs')
	 ab(1)=12.d0   ; ab(2)=10.93d0 ; ab(3)=3.31d0  ; ab(4)=1.42d0  ; ab(5)=2.79d0
	 ab(6)=8.52d0  ; ab(7)=7.920d0 ; ab(8)=8.83d0  ; ab(9)=4.48d0  ; ab(10)=8.08d0
	 ab(11)=6.32d0 ; ab(12)=7.58d0 ; ab(13)=6.49d0 ; ab(14)=7.56d0 ; ab(15)=5.56d0
	 ab(16)=7.20d0 ; ab(17)=5.28d0 ; ab(18)=6.40d0 ; ab(19)=5.13d0 ; ab(20)=6.35d0
	 ab(21)=3.10d0 ; ab(22)=4.94d0 ; ab(23)=4.02d0 ; ab(24)=5.69d0 ; ab(25)=5.53d0
	 ab(26)=7.50d0 ; ab(27)=4.91d0 ; ab(28)=6.25d0
	 ab=10.d0**ab*m
	 
c mixture solaire de Grevesse & Noels 93
	CASE('solaire_gn')
	 ab(1)=12.00d0 ; ab(2)=10.99d0 ; ab(3)=1.16d0  ; ab(4)=1.15d0  ; ab(5)=2.60d0
	 ab(6)=8.55d0  ; ab(7)=7.97d0  ; ab(8)=8.87d0  ; ab(9)=4.56d0  ; ab(10)=8.08d0
	 ab(11)=6.33d0 ; ab(12)=7.58d0 ; ab(13)=6.47d0 ; ab(14)=7.55d0 ; ab(15)=5.45d0
	 ab(16)=7.21d0 ; ab(17)=5.5d0  ; ab(18)=6.52d0 ; ab(19)=5.12d0 ; ab(20)=6.36d0
	 ab(21)=3.17d0 ; ab(22)=5.02d0 ; ab(23)=4.d0   ; ab(24)=5.67d0 ; ab(25)=5.39d0
	 ab(26)=7.5d0  ; ab(27)=4.92d0 ; ab(28)=6.25d0
	 ab=10.d0**ab*m
	 
c Mixture solaire de Grevesse & Sauval 98
	CASE('solaire_gs')
	 ab(1)=12.d0   ; ab(2)=10.93d0 ; ab(3)=1.10d0  ; ab(4)=1.40d0  ; ab(5)=2.55d0
	 ab(6)=8.52d0  ; ab(7)=7.920d0 ; ab(8)=8.83d0  ; ab(9)=4.56d0  ; ab(10)=8.08d0
	 ab(11)=6.33d0 ; ab(12)=7.58d0 ; ab(13)=6.47d0 ; ab(14)=7.55d0 ; ab(15)=5.45d0
	 ab(16)=7.33d0 ; ab(17)=5.50d0 ; ab(18)=6.40d0 ; ab(19)=5.12d0 ; ab(20)=6.36d0
	 ab(21)=3.17d0 ; ab(22)=5.02d0 ; ab(23)=4.00d0 ; ab(24)=5.67d0 ; ab(25)=5.39d0
	 ab(26)=7.50d0 ; ab(27)=4.92d0 ; ab(28)=6.25d0
	 ab=10.d0**ab*m	
	END SELECT
	ab=ab/SUM(ab)
	
c	WRITE(*,2000)ab ; PAUSE'ab'
	
	vt_H=ab(1) ; vt_He=ab(2) ; vt_Li=ab(3) ; vt_Be=ab(4) ; vt_B=ab(5)
	vt_C=ab(6) ; vt_N=ab(7)  ; vt_O=ab(8)  ; vt_F=ab(9)  ; vt_Ne=ab(10)
	vt_Na=ab(11) ; vt_Mg=ab(12) ; vt_Al=ab(13) ; vt_Si=ab(14)
	vt_P=ab(15) ; vt_S=ab(16) ; vt_Cl=ab(17) ; vt_Ar=ab(18)
	vt_K=ab(19) ; vt_Ca=ab(20) ; vt_Sc=ab(21) ; vt_Ti=ab(22)
	vt_V=ab(23) ; vt_Cr=ab(24) ; vt_Mn=ab(25) ; vt_Fe=ab(26)
	vt_Co=ab(27) ; vt_Ni=ab(28)

c fraction de la masse de l'étoile concernée par le vent	
	p_vent=1.d-3

c écriture de la namelist de la composition chimique du vent
	chain='vent' 
	OPEN(unit=3,form='formatted',status='unknown',delim='apostrophe',
	1 file=TRIM(chain))	
	WRITE(3,nl_vent) ; CLOSE(UNIT=3) ; WRITE(*,nl_vent) ; 

	STOP
	
	END PROGRAM fichier_vent