c***************************************************************** program mean_elem c calcul d'elements moyens pour les abondances initiales c initialisation de rapports isotopiques c Sources: c Anders & Grevesse, 1989, Geochimica et Cosmochimica Acta 53,197 c ftp:://www-phys.llnl.gov/pub/opal c Auteur: P. Morel, Departement J.D. Cassini, O.C.A. c CESAM95 c----------------------------------------------------------------------- use mod_kind implicit none integer, parameter :: nelem=28 real (kind=dp), dimension(nelem) :: a,m,c=(/ (i, i=1,nelem) /) real (kind=dp) :: ntot, mtot, ctot, atot, abon, mz, nz integer :: i, j, lim, pas=4 character (len=2), dimension(nelem) :: nom_elem character (len=2) :: mixture='ag' c------------------------------------------------------------------- b1: do select case(mixture) case('ag') print* print*,'----------------------------------------------------' print* print*,'Pour les meteorites Anders & Grevesse 89' print* a(1)=2.79d10 ; nom_elem(1)='H ' ; m(1)=1.008d0 a(2)=2.72d9 ; nom_elem(2)='He' ; m(2)=4.0026d0 a(3)=57.1d0 ; nom_elem(3)='Li' ; m(3)=6.941d0 a(4)=0.73d0 ; nom_elem(4)='Be' ; m(4)=9.0122d0 a(5)=21.2d0 ; nom_elem(5)='B ' ; m(5)=10.811d0 a(6)=1.01d7 ; nom_elem(6)='C ' ; m(6)=12.0111d0 a(7)=3.13d6 ; nom_elem(7)='N ' ; m(7)=14.0067d0 a(8)=2.38d7 ; nom_elem(8)='O ' ; m(8)=15.9994d0 a(9)=843.d0 ; nom_elem(9)='F ' ; m(9)=18.9984d0 a(10)=3.44d6 ; nom_elem(10)='Ne' ; m(10)=20.179d0 a(11)=5.74d4 ; nom_elem(11)='Na' ; m(11)=22.9898d0 a(12)=1.074d6 ; nom_elem(12)='Mg' ; m(12)=24.305d0 a(13)=8.49d4 ; nom_elem(13)='Al' ; m(13)=26.9815d0 a(14)=1.d6 ; nom_elem(14)='Si' ; m(14)=28.086d0 a(15)=1.04d4 ; nom_elem(15)='P ' ; m(15)=30.9738d0 a(16)=5.15d5 ; nom_elem(16)='S ' ; m(16)=32.06d0 a(17)=5240.d0 ; nom_elem(17)='Cl' ; m(17)=35.453d0 a(18)=1.01d5 ; nom_elem(18)='Ar' ; m(18)=39.948d0 a(19)=3370.d0 ; nom_elem(19)='K ' ; m(19)=39.102d0 a(20)=6.11d4 ; nom_elem(20)='Ca' ; m(20)=40.08d0 a(21)=34.2d0 ; nom_elem(21)='Sc' ; m(21)=44.956d0 a(22)=2400.d0 ; nom_elem(22)='Ti' ; m(22)=47.90d0 a(23)=293.d0 ; nom_elem(23)='V ' ; m(23)=50.9414d0 a(24)=1.35d4 ; nom_elem(24)='Cr' ; m(24)=51.996d0 a(25)=9550.d0 ; nom_elem(25)='Mn' ; m(25)=54.938d0 a(26)=9.d5 ; nom_elem(26)='Fe' ; m(26)=55.847d0 a(27)=2250.d0 ; nom_elem(27)='Co' ; m(27)=58.9332d0 a(28)=4.93d4 ; nom_elem(28)='Ni' ; m(28)=58.71d0 c a()= ; nom_elem()='' ; m()=d0 mixture='gn' case('gn') print*,'Pour la mixture Grevesse & Noels 93' print* a(1)=12.00d0 ; a(2)=10.99d0 ; a(3)=1.16d0 ; a(4)=1.15d0 ; a(5)=2.60d0 a(6)=8.55d0 ; a(7)=7.97d0 ; a(8)=8.87d0 ; a(9)=4.56d0 ; a(10)=8.08d0 a(11)=6.33d0 ; a(12)=7.58d0 ; a(13)=6.47d0 ; a(14)=7.55d0 ; a(15)=5.45d0 a(16)=7.21d0 ; a(17)=5.5d0 ; a(18)=6.52d0 ; a(19)=5.12d0 ; a(20)=6.36d0 a(21)=3.17d0 ; a(22)=5.02d0 ; a(23)=4.d0 ; a(24)=5.67d0 ; a(25)=5.39d0 a(26)=7.5d0 ; a(27)=4.92d0 ; a(28)=6.25d0 a=10.d0**a mixture='ch' !pour Chaboyer case('ch') print*,'Pour la mixture de Chaboyer 95' print*,'cf. ftp:://www-phys.llnl.gov/pub/opal/type1data/C95/ascii/C95hz' print* a(1)=12.d0 ; a(2)=10.99d0 ; a(3)=1.16d0 ; a(4)=1.15d0 ; a(5)=2.60d0 a(6)=8.55d0 ; a(7)=7.970d0 ; a(8)=9.27d0 ; a(9)=4.56d0 ; a(10)=8.08d0 a(11)=6.33d0 ; a(12)=7.98d0 ; a(13)=6.47d0 ; a(14)=7.95d0 ; a(15)=5.45d0 a(16)=7.61d0 ; a(17)=5.50d0 ; a(18)=6.52d0 ; a(19)=5.52d0 ; a(20)=6.76d0 a(21)=3.17d0 ; a(22)=5.42d0 ; a(23)=4.00d0 ; a(24)=5.67d0 ; a(25)=4.99d0 a(26)=7.50d0 ; a(27)=4.92d0 ; a(28)=6.25d0 a=10.d0**a mixture='ws' !pour Weiss case('ws') print*,'Pour la mixture de Weiss 95' print*,'cf. ftp:://www-phys.llnl.gov/pub/opal/type1data/C95/ascii/W95hz' print* a(1)=12.0d0 ; a(2)=10.99d0 ; a(3)=1.16d0 ; a(4)=1.15d0 ; a(5)=2.60d0 a(6)=8.55d0 ; a(7)=7.970d0 ; a(8)=9.37d0 ; a(9)=4.56d0 ; a(10)=8.37d0 a(11)=6.33d0 ; a(12)=7.98d0 ; a(13)=6.47d0 ; a(14)=7.85d0 ; a(15)=5.45d0 a(16)=7.54d0 ; a(17)=5.50d0 ; a(18)=6.52d0 ; a(19)=5.12d0 ; a(20)=6.86d0 a(21)=3.17d0 ; a(22)=5.65d0 ; a(23)=4.00d0 ; a(24)=5.67d0 ; a(25)=5.39d0 a(26)=7.50d0 ; a(27)=4.92d0 ; a(28)=6.27d0 a=10.d0**a mixture='al' !pour Allard case('al') print*,'Pour la mixture de Allard 95' print*,'cf. ftp:://www-phys.llnl.gov/pub/opal/type1data/C95/ascii/W95hz' print* a(1)=12.0d0 ; a(2)=10.99d0 ; a(3)=-0.14d0 ; a(4)=-0.15d0 ; a(5)=1.30d0 a(6)=7.25d0 ; a(7)=6.670d0 ; a(8)=7.87d0 ; a(9)=3.26d0 ; a(10)=7.08d0 a(11)=5.33d0 ; a(12)=6.58d0 ; a(13)=4.87d0 ; a(14)=6.55d0 ; a(15)=4.45d0 a(16)=6.21d0 ; a(17)=4.50d0 ; a(18)=5.52d0 ; a(19)=3.82d0 ; a(20)=5.36d0 a(21)=1.87d0 ; a(22)=4.02d0 ; a(23)=2.70d0 ; a(24)=4.37d0 ; a(25)=3.94d0 a(26)=6.20d0 ; a(27)=3.92d0 ; a(28)=4.95d0 a=10.d0**a mixture='st' !pour arret case('st') !arret exit b1 endselect c nombre total d'elements et masse dans Z ntot=0.d0 do i=3,nelem ntot=ntot+a(i) enddo c abondance en masse et en nombre dans Z mz=0.d0 ; nz=0.d0 do i=3,nelem mz=mz+a(i)*m(i) ; nz=nz+a(i) enddo c abondance totale en masse atot=mz+a(1)*m(1)+a(2)*m(2) c abondances relatives dans Z print*,'abondances relatives en nombre dans Z' do i=3,nelem,pas write(6,1)(nom_elem(j),a(j)/ntot,j=i,min(i+pas-1,nelem)) 1 format(4(1x,a2'/Z=',1pd10.3)) enddo print* print*,'abondances relatives en masse dans Z' do i=3,nelem,pas write(6,1)(nom_elem(j),a(j)*m(j)/mz,j=i,min(i+pas-1,nelem)) enddo c metaux non CNO plus lourds que m(lim) lim=8 !Oxygene c masses et charges moyennes des metaux apres lim mtot=0.d0 ; ctot=0.d0 ; ntot=0.d0 ; abon=0.d0 do i=lim+1,nelem mtot=mtot+a(i)*m(i) ; ctot=ctot+a(i)*c(i) ; ntot=ntot+a(i) enddo abon=mtot ; mtot=mtot/ntot ; ctot=ctot/ntot print* write(6,"('pour les elements de charge > ',a2)")nom_elem(lim) write(6,"('masse moyenne= ',1pd10.3,', charge moyenne=',1pd10.3)")mtot,ctot write(6,"('element moyen ',a2,i2,', abondance/masse=',1pd10.3)") 1 nom_elem(nint(ctot)),nint(mtot),abon/atot write(6,"('abondance/masse dans Z =',1pd10.3, 1 ', abondance/nombre dans Z =',1pd10.3)")abon/mz,ntot/nz c on separe en metaux non CNO plus legers/lourds que m(lim) lim=19 !potassium, K c masses et charges moyennes des metaux avant lim=19=K mtot=0.d0 ; ctot=0.d0 ; ntot=0.d0 ; abon=0.d0 do i=3,5 mtot=mtot+a(i)*m(i) ; ctot=ctot+a(i)*c(i) ; ntot=ntot+a(i) enddo do i=9,lim mtot=mtot+a(i)*m(i) ; ctot=ctot+a(i)*c(i) ; ntot=ntot+a(i) enddo abon=mtot ; mtot=mtot/ntot ; ctot=ctot/ntot print* write(6,"('pour les elements de charge <= ',a2)")nom_elem(lim) write(6,"('masse moyenne= ',1pd10.3,', charge moyenne=',1pd10.3)")mtot,ctot write(6,"('element moyen ',a2,i2,', abondance/masse=',1pd10.3)") 1 nom_elem(nint(ctot)),nint(mtot),abon/atot write(6,"('abondance/masse dans Z =',1pd10.3, 1 ', abondance/nombre dans Z =',1pd10.3)")abon/mz,ntot/nz c masses et charges moyennes des metaux apres lim=19=K mtot=0.d0 ; ctot=0.d0 ; ntot=0.d0 ; abon=0.d0 do i=lim+1,nelem mtot=mtot+a(i)*m(i) ; ctot=ctot+a(i)*c(i) ; ntot=ntot+a(i) enddo abon=mtot ; mtot=mtot/ntot ; ctot=ctot/ntot print* write(6,"('pour les elements de charge > ',a2)")nom_elem(lim) write(6,"('masse moyenne= ',1pd10.3,', charge moyenne=',1pd10.3)")mtot,ctot write(6,"('element moyen ',a2,i2,', abondance/masse=',1pd10.3)") 1 nom_elem(nint(ctot)),nint(mtot),abon/atot write(6,"('abondance/masse dans Z =',1pd10.3, 1 ', abondance/nombre dans Z =',1pd10.3)")abon/mz,ntot/nz print* print*,'----------------------------------------------------' print* enddo b1 end program mean_elem