c--------------------------------------------------- c Version 14/02/2009 Copyright by J. Gorgas, A. J. Cenarro and N. Cardiel c--------------------------------------------------- program NIRffs implicit none integer iflag,iflag2,iflag3,iflag4,i,j real t,g,z,t0,cdef real findex_cats,eindex_cats real findex_pat,eindex_pat real findex_cat,eindex_cat real findex_stio,eindex_stio real findex_mgi,eindex_mgi 10 write(*,*)'Input Teff, log(g), [Fe/H]' read(*,*) t,g,z call predicted(t,g,z,findex_cats,eindex_cats, + findex_pat,eindex_pat, + findex_cat,eindex_cat, + findex_stio,eindex_stio, + findex_mgi,eindex_mgi, + iflag,iflag2,iflag3,iflag4) 11 format(A6,1x,f7.3,1x,f6.3,1x,i2) write(*,11)'CaT* =',findex_cats,eindex_cats,iflag write(*,11)'PaT =',findex_pat,eindex_pat,iflag2 write(*,11)'CaT =',findex_cat,eindex_cat write(*,11)'sTiO =',findex_stio,eindex_stio,iflag3 write(*,11)'MgI =',findex_mgi,eindex_mgi,iflag4 goto 10 stop end c--------------------------------------- c MAIN SUBROUTINE TO PREDICT THE INDICES c--------------------------------------- subroutine predicted(t,g,z,findex_cats,eindex_cats, + findex_pat,eindex_pat, + findex_cat,eindex_cat, + findex_stio,eindex_stio, + findex_mgi,eindex_mgi, + iflag,iflag2,iflag3,iflag4) implicit none integer iflag,iflag2,iflag3,iflag4 real t,g,z,t0,cdef real findex_cats,eindex_cats real findex_pat,eindex_pat real findex_cat,eindex_cat real findex_stio,eindex_stio real findex_mgi,eindex_mgi t0=5040./t !Converts to theta=5040/Teff call thetglimits(t0,g,iflag) iflag2=iflag iflag3=iflag iflag4=iflag call finfitCatpat(t0,g,z,findex_cats,eindex_cats,iflag) call finfitpat(t0,g,z,findex_pat,eindex_pat,iflag2) cdef=0.93 findex_cat=findex_cats+cdef*findex_pat eindex_cat=sqrt(eindex_cats**2+(cdef*eindex_pat)**2) call finfitsTiO(t0,g,z,findex_stio,eindex_stio,iflag3) call finfitMgI(t0,g,z,findex_mgi,eindex_mgi,iflag4) return end c---------------------------------------------------------------- c ###### FUNCTIONS INTERPOLATION AND COEFFICIENTS: ####### c---------------------------------------------------------------- subroutine finfitCatpat(t,g,z,findex,eindex,iflag) implicit none integer iflag real t,g,z,findex,eindex,pi real findex1,findex2,findex3 real eindex1,eindex2,eindex3 real thet,x double precision fhd(25),fhg(25),fw(25),fc(25),fcd(25),fcg(25), c fi(25),flm(25) double precision chd(25,25),chg(25,25),cw(25,25),cc(25,25) double precision ccd(25,25),ccg(25,25),ci(25,25),clm(25,25) double precision srhd,srhg,srw,src,srcd,srcg,sri,srlm double precision ctehd,ctehg,ctew,ctec,ctecd,ctecg,ctei,ctelm double precision theta,geta,zeta double precision xf(20) logical nog,noz logical lhd(25),lhg(25),lw(25),lc(25),lcd(25),lcg(25),li(25), c llm(25) logical lehd,lehg,lew,lec,lecd,lecg,lei,lelm common/blkl/lhd,lhg,lw,lc,lcd,lcg,li,llm common/blkle/lehd,lehg,lew,lec,lecd,lecg,lei,lelm common/blkf/fhd,fhg,fw,fc,fcd,fcg,fi,flm common/blkc/chd,chg,cw,cc,ccd,ccg,ci,clm common/blksr/srhd,srhg,srw,src,srcd,srcg,sri,srlm common/blkcte/ctehd,ctehg,ctew,ctec,ctecd,ctecg,ctei,ctelm common/blkx/xf C Regions: C 1 = hot dwarfs (hd) C 2 = hot giants (hg) C 3 = warm stars (w) C 4 = cool stars (c) C 5 = cold dwarfs (cd) C 6 = cold giants (cg) C 7 = intermediate giants (i) C 8 = metal poor warm giants (lm) C Coefficients and variance-covariance matrices are stored C in this subroutine call readcoefcatpat pi=3.14159 nog=.false. noz=.false. if(g.gt.6.0.or.g.lt.-1.0) nog=.true.!valid range: -1.0 < logg < 6.0 if(z.gt.1.5.or.z.lt.-4.5) noz=.true.!valid range: -4.5 < [Fe/H] < 1.5 findex=0. eindex=0. if(t.lt.0.05.or.t.gt.2.25) then !valid range: 2240 K < Teff < 100800 K iflag=-1 return end if if(nog) then iflag=-3 return end if c Program works in theta (=5040/Teff) theta=dble(t) thet=t geta=dble(g) zeta=dble(z) xf(1)=1.D0 xf(2)=theta xf(3)=geta xf(4)=zeta xf(5)=theta*zeta xf(6)=theta*geta xf(7)=theta*theta xf(8)=geta*geta xf(9)=zeta*zeta xf(10)=geta*zeta xf(11)=theta*theta*geta xf(12)=theta*theta*theta xf(13)=geta*geta*geta xf(14)=zeta*zeta*zeta xf(15)=geta*geta*zeta xf(16)=theta*theta*zeta xf(17)=theta*zeta*zeta xf(18)=theta*geta*geta xf(19)=geta*zeta*zeta xf(20)=theta*geta*zeta c Hot stars if(thet.le.0.70) then if(g.ge.2.80) then call compindex(1,findex1,eindex1) end if if(g.le.3.0) then call compindex(2,findex2,eindex2) end if if(g.le.2.80) then findex3=findex2 eindex3=eindex2 else if(g.ge.3.0) then findex3=findex1 eindex3=eindex1 else x=(g-2.80)/0.20 findex3=(1.-x)*findex2+x*findex1 eindex3=(1.-x)*eindex2+x*eindex1 end if end if c If really hot or no z values, it keeps this index if(thet.le.0.50.or.noz) then findex=findex3 eindex=eindex3 return end if end if c Warm stars if(thet.le.1.00) then if(noz) then iflag=-2 return end if call compindex(3,findex1,eindex1) call compindex(8,findex2,eindex2) ! Only for metal poor giants. if(g.lt.2.6.and.z.lt.-0.25)then if(z.lt.-0.25.and.thet.le.0.65) then !theta<0.65 x=cos(pi/2.*(0.65-thet)/0.15) findex=(1.-x)*findex3+x*findex2 eindex=(1.-x)*eindex3+x*eindex2 return else findex1=findex2 eindex1=eindex2 endif else !metal giants and dwarfs if(thet.le.0.70) then x=cos(pi/2.*(0.70-thet)/0.20) findex=(1.-x)*findex3+x*findex1 eindex=(1.-x)*eindex3+x*eindex1 return end if endif end if c Cool stars if(thet.lt.1.50) then if(noz) then if((g.ge.3..and.thet.lt.1.06).or. c (g.lt.3..and.thet.lt.1.3)) then iflag=-2 return else goto 10 end if end if call compindex(4,findex2,eindex2) call compindex(7,findex3,eindex3) !intermediate zone, only giants, not dwarfs if(g.lt.2.6)then !only giants if(z.lt.-1.25)then ! theta 0.65 - 0.95 if(thet.le.0.95) then x=cos(pi/2.*(thet-0.65)/0.30) findex=(1.-x)*findex2+x*findex1 eindex=(1.-x)*eindex2+x*eindex1 return endif endif if(z.ge.-1.25.and.z.lt.-0.75)then ! theta 0.65 - 0.90 if(thet.le.0.90) then x=cos(pi/2.*(thet-0.65)/0.25) findex=(1.-x)*findex2+x*findex1 eindex=(1.-x)*eindex2+x*eindex1 return endif endif if(z.ge.-1.25.and.z.lt.-0.25)then ! theta 0.65 - 0.85 if(thet.le.0.85) then x=cos(pi/2.*(thet-0.65)/0.20) findex=(1.-x)*findex2+x*findex1 eindex=(1.-x)*eindex2+x*eindex1 return endif endif if(z.ge.-0.25)then ! theta 0.70 - 0.90 if(thet.le.0.90) then x=cos(pi/2.*(thet-0.70)/0.20) findex=(1.-x)*findex2+x*findex1 eindex=(1.-x)*eindex2+x*eindex1 return endif endif else !dwarfs if(thet.le.0.90) then x=cos(pi/2.*(thet-0.70)/0.20) findex=(1.-x)*findex2+x*findex1 eindex=(1.-x)*eindex2+x*eindex1 return endif end if if(g.ge.3.0) then if(thet.lt.1.0)then findex=findex2 eindex=eindex2 return endif else if(thet.lt.1.20) then if(thet.ge.1.05) then x=cos(pi/2.*(thet-1.05)/0.15) findex=(1.-x)*findex3+x*findex2 eindex=(1.-x)*eindex3+x*eindex2 return else findex=findex2 eindex=eindex2 return endif endif endif endif 10 if(g.ge.3.0) then call compindex(5,findex1,eindex1) if(thet.ge.1.25.or.noz) then findex=findex1 eindex=eindex1 return else x=cos(pi/2.*(thet-1.0)/0.25) findex=(1.-x)*findex1+x*findex2 eindex=(1.-x)*eindex1+x*eindex2 return end if else call compindex(6,findex1,eindex1) if(thet.ge.1.50.or.noz) then findex=findex1 eindex=eindex1 return else x=cos(pi/2.*(thet-1.20)/0.30) findex=(1.-x)*findex1+x*findex3 eindex=(1.-x)*eindex1+x*eindex3 return end if end if c Error: No value was computed iflag=-5 write(*,'(A)') 'ERROR: NO index value was computed' return stop end c----------------------------------------------------------------------- subroutine readcoefcatpat implicit none integer i,j double precision fhd(25),fhg(25),fw(25),fc(25),fcd(25),fcg(25), c fi(25),flm(25) double precision chd(25,25),chg(25,25),cw(25,25),cc(25,25) double precision ccd(25,25),ccg(25,25),ci(25,25),clm(25,25) double precision srhd,srhg,srw,src,srcd,srcg,sri,srlm double precision ctehd,ctehg,ctew,ctec,ctecd,ctecg,ctei,ctelm logical lhd(25),lhg(25),lw(25),lc(25),lcd(25),lcg(25),li(25), c llm(25) logical lehd,lehg,lew,lec,lecd,lecg,lei,lelm common/blkl/lhd,lhg,lw,lc,lcd,lcg,li,llm common/blkle/lehd,lehg,lew,lec,lecd,lecg,lei,lelm common/blkf/fhd,fhg,fw,fc,fcd,fcg,fi,flm common/blkc/chd,chg,cw,cc,ccd,ccg,ci,clm common/blksr/srhd,srhg,srw,src,srcd,srcg,sri,srlm common/blkcte/ctehd,ctehg,ctew,ctec,ctecd,ctecg,ctei,ctelm c-Initialization-------------------------------------------------------- do i=1,25 fhd(i)=0.D0 fhg(i)=0.D0 fw(i)=0.D0 fc(i)=0.D0 fcd(i)=0.D0 fcg(i)=0.D0 fi(i)=0.D0 flm(i)=0.D0 lhd(i)=.false. lhg(i)=.false. lw(i)=.false. lc(i)=.false. lcd(i)=.false. lcg(i)=.false. li(i)=.false. llm(i)=.false. do j=1,25 chd(i,j)=0.D0 chg(i,j)=0.D0 cw(i,j)=0.D0 cc(i,j)=0.D0 ccd(i,j)=0.D0 ccg(i,j)=0.D0 ci(i,j)=0.D0 clm(i,j)=0.D0 end do end do lehd=.false. lehg=.false. lew=.false. lec=.false. lecd=.false. lecg=.false. lei=.false. lelm=.false. ctehd=0.D0 ctehg=0.D0 ctew=0.D0 ctec=0.D0 ctecd=0.D0 ctecg=0.D0 ctei=0.D0 ctelm=0.D0 c #################################################################### c For hot dwarfs c N=44 sigma_res=0.64117 sigma_typ=0.19320 r**2=0.852 Coef 1 : 0.1010234840772093E+01 0.3328633433839919E+00 Coef 7 : -0.4079786758081508E+02 0.5242578829816516E+01 Coef 12 : 0.6712183060874379E+02 0.7292626079044976E+01 fhd(1)= 0.1010234840772093E+01 fhd(7)= -0.4079786758081508E+02 fhd(12)= 0.6712183060874379E+02 lhd(1)=.true. lhd(7)=.true. lhd(12)=.true. srhd=0.6411670277E+00 chd( 1, 1)= 0.2695191207614669E+00 chd( 1, 2)= -0.3472429151576591E+01 chd( 1, 3)= 0.4398603795783181E+01 chd( 2, 2)= 0.6685710666456619E+02 chd( 2, 3)= -0.9210177382583753E+02 chd( 3, 3)= 0.1293676030302836E+03 c #################################################################### c For hot giants c N=26 sigma_res=0.61231 sigma_typ=0.14823 r**2=0.925 Coef 1 : -0.4492070013738538E+00 0.2930124101618676E+00 Coef 12 : 0.2046337453401181E+02 0.1642371038782907E+01 fhg(1)= -0.4492070013738538E+00 fhg(12)= 0.2046337453401181E+02 lhg(1)=.true. lhg(12)=.true. srhg=0.6123062197E+00 chg( 1, 1)= 0.2289995808942432E+00 chg( 1, 2)= -0.1073025401417251E+01 chg( 2, 2)= 0.7194576162110260E+01 c #################################################################### c For warm stars c N=193 sigma_res=0.64901 sigma_typ=0.19186 r**2=0.936 Coef 1 : -0.2712443296702683E+02 0.5618020964894731E+01 Coef 3 : 0.1827325591342781E+02 0.5694843876505995E+01 Coef 5 : 0.3607983477791699E+02 0.6158257142615004E+01 Coef 6 : -0.2944080627123500E+02 0.7250298365863318E+01 Coef 7 : 0.1277746531094536E+03 0.1720088801471742E+02 Coef 8 : -0.2931841909454243E+01 0.9825535571598784E+00 Coef 9 : 0.3611452207610669E+01 0.1258214871917101E+01 Coef 10 : -0.5038345594941118E+01 0.1050915869665071E+01 Coef 12 : -0.7318048016203497E+02 0.1086107084405936E+02 Coef 15 : 0.4445755626664886E+00 0.1701235786382027E+00 Coef 16 : -0.2050782869070491E+02 0.4693153012041808E+01 Coef 18 : 0.4405810536616976E+01 0.1239147296851348E+01 Coef 19 : -0.8167748381113530E+00 0.3178820717500236E+00 fw(1)= -0.2712443296702683E+02 fw(3)= 0.1827325591342781E+02 fw(5)= 0.3607983477791699E+02 fw(6)= -0.2944080627123500E+02 fw(7)= 0.1277746531094536E+03 fw(8)= -0.2931841909454243E+01 fw(9)= 0.3611452207610669E+01 fw(10)=-0.5038345594941118E+01 fw(12)=-0.7318048016203497E+02 fw(15)= 0.4445755626664886E+00 fw(16)=-0.2050782869070491E+02 fw(18)= 0.4405810536616976E+01 fw(19)=-0.8167748381113530E+00 lw(1)=.true. lw(3)=.true. lw(5)=.true. lw(6)=.true. lw(7)=.true. lw(8)=.true. lw(9)=.true. lw(10)=.true. lw(12)=.true. lw(15)=.true. lw(16)=.true. lw(18)=.true. lw(19)=.true. srw=0.6490083081E+00 cw( 1, 1)= 0.7493180572153959E+02 cw( 1, 2)= -0.7287507911189091E+02 cw( 1, 3)= -0.1984589195722098E+02 cw( 1, 4)= 0.9121968185807818E+02 cw( 1, 5)= -0.2160595724326513E+03 cw( 1, 6)= 0.1226696365087670E+02 cw( 1, 7)= -0.1660015577629536E+01 cw( 1, 8)= 0.1891251509959769E+01 cw( 1, 9)= 0.1221490452723156E+03 cw( 1,10)= -0.9943263591572606E-01 cw( 1,11)= 0.1567638580172093E+02 cw( 1,12)= -0.1531442505240781E+02 cw( 1,13)= 0.4322638527511040E+00 cw( 2, 2)= 0.7699510795787947E+02 cw( 2, 3)= 0.1684546212631264E+02 cw( 2, 4)= -0.9650706289802018E+02 cw( 2, 5)= 0.1998828461196264E+03 cw( 2, 6)= -0.1316764851971396E+02 cw( 2, 7)= 0.9412684841106710E+00 cw( 2, 8)= -0.1403854896373619E+01 cw( 2, 9)= -0.1059654471717934E+03 cw( 2,10)= 0.6910988317110785E-01 cw( 2,11)= -0.1384864724298732E+02 cw( 2,12)= 0.1646220576720622E+02 cw( 2,13)= -0.2251612482713273E+00 cw( 3, 3)= 0.9003577886546677E+02 cw( 3, 4)= -0.2439501848701901E+02 cw( 3, 5)= 0.7199671862668183E+02 cw( 3, 6)= -0.2703391024164132E+01 cw( 3, 7)= 0.1339286752160108E+02 cw( 3, 8)= -0.1257399946089560E+02 cw( 3, 9)= -0.4649605991087689E+02 cw( 3,10)= 0.1291889718575365E+01 cw( 3,11)= -0.6642024885544814E+02 cw( 3,12)= 0.4010379464615109E+01 cw( 3,13)= -0.3431775583898482E+01 cw( 4, 4)= 0.1247990402880702E+03 cw( 4, 5)= -0.2614088544841073E+03 cw( 4, 6)= 0.1639702354755679E+02 cw( 4, 7)= -0.1537951898278491E+00 cw( 4, 8)= 0.3289336296381872E+01 cw( 4, 9)= 0.1385407648373453E+03 cw( 4,10)= -0.4096744426911602E+00 cw( 4,11)= 0.2004927198755444E+02 cw( 4,12)= -0.2112379453531347E+02 cw( 4,13)= 0.2383872746858495E-01 cw( 5, 5)= 0.7024270444800600E+03 cw( 5, 6)= -0.3376177605985115E+02 cw( 5, 7)= 0.3383059349997920E+01 cw( 5, 8)= -0.1061818752471341E+02 cw( 5, 9)= -0.4269987402612845E+03 cw( 5,10)= 0.1220651264863564E+01 cw( 5,11)= -0.5611470498615714E+02 cw( 5,12)= 0.4397583312489982E+02 cw( 5,13)= -0.9658971669110616E+00 cw( 6, 6)= 0.2291985954551302E+01 cw( 6, 7)= -0.2184310526902095E+00 cw( 6, 8)= 0.1875477384629954E+00 cw( 6, 9)= 0.1824278351439266E+02 cw( 6,10)= -0.2116926876614674E-03 cw( 6,11)= 0.2169199742837241E+01 cw( 6,12)= -0.2849442334008708E+01 cw( 6,13)= 0.5118126291750101E-01 cw( 7, 7)= 0.3758452930960190E+01 cw( 7, 8)= -0.1349498262868165E+01 cw( 7, 9)= -0.3882998377698184E+01 cw( 7,10)= 0.7249574867212937E-02 cw( 7,11)= -0.8394086331322780E+01 cw( 7,12)= 0.1352359891012749E+00 cw( 7,13)= -0.9408527584351993E+00 cw( 8, 8)= 0.2622016304427186E+01 cw( 8, 9)= 0.6635412812112852E+01 cw( 8,10)= -0.3780683277159227E+00 cw( 8,11)= 0.8904280546187730E+01 cw( 8,12)= -0.4964202159894149E+00 cw( 8,13)= 0.3525170178945272E+00 cw( 9, 9)= 0.2800559347499195E+03 cw( 9,10)= -0.6682475117434016E+00 cw( 9,11)= 0.3518627356247458E+02 cw( 9,12)= -0.2377323930466710E+02 cw( 9,13)= 0.1085128547215229E+01 cw(10,10)= 0.6871135403140803E-01 cw(10,11)= -0.9844161870710365E+00 cw(10,12)= 0.5381099927939942E-01 cw(10,13)= -0.3528489284187723E-02 cw(11,11)= 0.5229123693616295E+02 cw(11,12)= -0.3209946113892272E+01 cw(11,13)= 0.2190581169027858E+01 cw(12,12)= 0.3645401391485986E+01 cw(12,13)= -0.2896623579261971E-01 cw(13,13)= 0.2399007230858955E+00 c #################################################################### c For cool stars c N=551 sigma_res=0.53953 sigma_typ=0.19062 r**2=0.948 Coef 1 : -0.7087350516888279E+02 0.1456751070393353E+02 Coef 2 : 0.3022258042530659E+03 0.4401446452747689E+02 Coef 3 : -0.2058493937239117E+02 0.2112468865975549E+01 Coef 4 : 0.5760244588427595E+02 0.1119946292558866E+02 Coef 5 : -0.8081379882056881E+02 0.2067339004209639E+02 Coef 6 : 0.1277313725542240E+02 0.1881607989553389E+01 Coef 7 : -0.3124706353011856E+03 0.4421579356818125E+02 Coef 8 : 0.3514332599689722E+01 0.4534293525888189E+00 Coef 9 : 0.2314309647301204E+01 0.8884964695303000E+00 Coef 10 : -0.5789383407667002E+01 0.9708723394443542E+00 Coef 12 : 0.9974744972708994E+02 0.1450852324449692E+02 Coef 13 : -0.1520157613785365E+00 0.3226902585814677E-01 Coef 15 : 0.1314551535472353E+00 0.7382020411302488E-01 Coef 16 : 0.2958219688333445E+02 0.9289226750612295E+01 Coef 17 : -0.2103162000202632E+01 0.9157040312900007E+00 Coef 18 : -0.1674306650092225E+01 0.3290789631448154E+00 Coef 20 : 0.4070640493841211E+01 0.8855185761972609E+00 fc(1)= -0.7087350516888279E+02 fc(2)= 0.3022258042530659E+03 fc(3)= -0.2058493937239117E+02 fc(4)= 0.5760244588427595E+02 fc(5)= -0.8081379882056881E+02 fc(6)= 0.1277313725542240E+02 fc(7)= -0.3124706353011856E+03 fc(8)= 0.3514332599689722E+01 fc(9)= 0.2314309647301204E+01 fc(10)=-0.5789383407667002E+01 fc(12)= 0.9974744972708994E+02 fc(13)=-0.1520157613785365E+00 fc(15)= 0.1314551535472353E+00 fc(16)= 0.2958219688333445E+02 fc(17)=-0.2103162000202632E+01 fc(18)=-0.1674306650092225E+01 fc(20)= 0.4070640493841211E+01 lc(1)=.true. lc(2)=.true. lc(3)=.true. lc(4)=.true. lc(5)=.true. lc(6)=.true. lc(7)=.true. lc(8)=.true. lc(9)=.true. lc(10)=.true. lc(12)=.true. lc(13)=.true. lc(15)=.true. lc(16)=.true. lc(17)=.true. lc(18)=.true. lc(20)=.true. src=0.5395257782E+00 cc( 1, 1)= 0.7290314971722066E+03 cc( 1, 2)= -0.2172104856318294E+04 cc( 1, 3)= -0.3991269238222725E+01 cc( 1, 4)= -0.3832230725091786E+01 cc( 1, 5)= 0.6034823384371128E+01 cc( 1, 6)= -0.1032427306006564E+01 cc( 1, 7)= 0.2130066794854820E+04 cc( 1, 8)= 0.9299463185206085E+00 cc( 1, 9)= -0.2661622133854840E+01 cc( 1,10)= -0.5438637831244631E+01 cc( 1,11)= -0.6847882703823188E+03 cc( 1,12)= -0.1076148352736095E+00 cc( 1,13)= 0.4853278960493291E+00 cc( 1,14)= -0.9373500459267928E+00 cc( 1,15)= 0.2101304740459673E+01 cc( 1,16)= 0.6056108623939594E+00 cc( 1,17)= 0.2999948020083868E+01 cc( 2, 2)= 0.6655281744875102E+04 cc( 2, 3)= -0.3160303044936469E+02 cc( 2, 4)= 0.6808424545376316E+02 cc( 2, 5)= -0.9875528336950508E+02 cc( 2, 6)= 0.4144171594275024E+02 cc( 2, 7)= -0.6645175961884298E+04 cc( 2, 8)= 0.4803377928345587E+01 cc( 2, 9)= 0.5873665952514834E+01 cc( 2,10)= 0.6243631314242021E+01 cc( 2,11)= 0.2158070158228403E+04 cc( 2,12)= 0.6493201868523413E-01 cc( 2,13)= -0.1089167416458036E+01 cc( 2,14)= 0.3045965264595750E+02 cc( 2,15)= -0.3868235331572442E+01 cc( 2,16)= -0.7239877123989358E+01 cc( 2,17)= -0.1327370769575413E+01 cc( 3, 3)= 0.1533049698883655E+02 cc( 3, 4)= -0.8282383443126394E+01 cc( 3, 5)= 0.7186077537715893E+01 cc( 3, 6)= -0.1321074017256200E+02 cc( 3, 7)= 0.5509760538943265E+02 cc( 3, 8)= -0.3076185252053324E+01 cc( 3, 9)= 0.3887313169493996E+00 cc( 3,10)= 0.2445716807814792E+01 cc( 3,11)= -0.2073128867484598E+02 cc( 3,12)= 0.1024575885802276E+00 cc( 3,13)= -0.1207333081240571E+00 cc( 3,14)= -0.3364500918157235E+00 cc( 3,15)= -0.5507069139529219E+00 cc( 3,16)= 0.2211909490653990E+01 cc( 3,17)= -0.1617297112945044E+01 cc( 4, 4)= 0.4308935498956192E+03 cc( 4, 5)= -0.7890936257790466E+03 cc( 4, 6)= 0.5299865238599524E+01 cc( 4, 7)= -0.1117728661871987E+03 cc( 4, 8)= 0.1766774154600654E+01 cc( 4, 9)= 0.1475695117493788E+02 cc( 4,10)= -0.2385233885262151E+02 cc( 4,11)= 0.4836340288312837E+02 cc( 4,12)= -0.1861737067497626E+00 cc( 4,13)= -0.8149479436991713E+00 cc( 4,14)= 0.3479695222577717E+03 cc( 4,15)= -0.1610342028075634E+02 cc( 4,16)= -0.3228123822500148E+00 cc( 4,17)= 0.2891574349601288E+02 cc( 5, 5)= 0.1468246577825917E+04 cc( 5, 6)= -0.2925126743194039E+01 cc( 5, 7)= 0.1696427683082147E+03 cc( 5, 8)= -0.1829875356847343E+01 cc( 5, 9)= -0.2596289105891584E+02 cc( 5,10)= 0.3860713115511245E+02 cc( 5,11)= -0.7723206085675164E+02 cc( 5,12)= 0.3098459892839541E+00 cc( 5,13)= 0.1879560368971104E+01 cc( 5,14)= -0.6558101695604281E+03 cc( 5,15)= 0.2881841866195740E+02 cc( 5,16)= -0.4617814168566072E+00 cc( 5,17)= -0.5046204880636127E+02 cc( 6, 6)= 0.1216280929206568E+02 cc( 6, 7)= -0.6246831509446773E+02 cc( 6, 8)= 0.2458081358787715E+01 cc( 6, 9)= -0.3373130602629392E+00 cc( 6,10)= -0.1944060377927810E+01 cc( 6,11)= 0.2267540496435518E+02 cc( 6,12)= -0.4685965323663489E-01 cc( 6,13)= 0.7855979697867212E-01 cc( 6,14)= -0.1322924240488459E+01 cc( 6,15)= 0.4665164628818430E+00 cc( 6,16)= -0.2051357025710202E+01 cc( 6,17)= 0.1383466499391804E+01 cc( 7, 7)= 0.6716305590702032E+04 cc( 7, 8)= -0.8710515102271312E+01 cc( 7, 9)= -0.4336349515525471E+01 cc( 7,10)= -0.2445951738698011E+00 cc( 7,11)= -0.2197679612580000E+04 cc( 7,12)= 0.8275433670233230E-01 cc( 7,13)= 0.9407167836222756E+00 cc( 7,14)= -0.5862285546963736E+02 cc( 7,15)= 0.2247986162758540E+01 cc( 7,16)= 0.9968018825821179E+01 cc( 7,17)= -0.3772775101951983E+01 cc( 8, 8)= 0.7063091972675920E+00 cc( 8, 9)= -0.6067250613026813E-01 cc( 8,10)= -0.4001403527442108E+00 cc( 8,11)= 0.3291101744050278E+01 cc( 8,12)= -0.3431108419515742E-01 cc( 8,13)= 0.2159897548794922E-01 cc( 8,14)= 0.3449373501081838E+00 cc( 8,15)= 0.9807077089353204E-01 cc( 8,16)= -0.4329968245655792E+00 cc( 8,17)= 0.2427984704306224E+00 cc( 9, 9)= 0.2711983314572205E+01 cc( 9,10)= -0.1662427393851166E+00 cc( 9,11)= 0.1051753762560688E+01 cc( 9,12)= 0.3728585697246172E-04 cc( 9,13)= -0.8855491225140164E-01 cc( 9,14)= 0.1031797975354038E+02 cc( 9,15)= -0.2773225387290768E+01 cc( 9,16)= 0.5431145719107300E-01 cc( 9,17)= 0.7339088467678652E+00 cc(10,10)= 0.3238171576303523E+01 cc(10,11)= -0.9447417885760687E+00 cc(10,12)= 0.1482338381901688E-01 cc(10,13)= -0.1031390696524925E+00 cc(10,14)= -0.1548270780800556E+02 cc(10,15)= 0.1741371447171051E+00 cc(10,16)= 0.2370575076206407E+00 cc(10,17)= -0.2635309905277247E+01 cc(11,11)= 0.7231393924206724E+03 cc(11,12)= -0.6280115856724940E-01 cc(11,13)= -0.2974296378327303E+00 cc(11,14)= 0.2897743046062516E+02 cc(11,15)= -0.3814117664916540E+00 cc(11,16)= -0.3435377779502425E+01 cc(11,17)= 0.2226192366172138E+01 cc(12,12)= 0.3577233674945322E-02 cc(12,13)= -0.7315694518960863E-03 cc(12,14)= -0.1326801233578677E+00 cc(12,15)= -0.1654556420146421E-02 cc(12,16)= 0.7192511116071472E-02 cc(12,17)= -0.9201287887715884E-02 cc(13,13)= 0.1872087242144528E-01 cc(13,14)= -0.9147325413481322E+00 cc(13,15)= 0.9881930230880608E-01 cc(13,16)= -0.1034698921469510E-01 cc(13,17)= -0.5574061694479755E-02 cc(14,14)= 0.2964385829874507E+03 cc(14,15)= -0.1164239537380561E+02 cc(14,16)= 0.6094449275264173E+00 cc(14,17)= 0.2129962118161965E+02 cc(15,15)= 0.2880619210000385E+01 cc(15,16)= -0.7836857072505710E-01 cc(15,17)= -0.8134827770706332E+00 cc(16,16)= 0.3720281827597321E+00 cc(16,17)= -0.1537386114468435E+00 cc(17,17)= 0.2693834760214337E+01 c ################################################################ c For cold dwarfs c N=23 sigma_res=0.28989 sigma_typ=0.20047 r**2=0.985 Coef 1 : -0.1046722017025981E+03 0.2376398710269291E+02 Coef 2 : 0.2451506517215240E+03 0.5105058125125843E+02 Coef 7 : -0.1731898012961590E+03 0.3603653336964771E+02 Coef 12 : 0.3871691678519028E+02 0.8349521982443495E+01 fcd(1)= -0.1046722017025981E+03 fcd(2)= 0.2451506517215240E+03 fcd(7)= -0.1731898012961590E+03 fcd(12)= 0.3871691678519028E+02 lcd(1)=.true. lcd(2)=.true. lcd(7)=.true. lcd(12)=.true. srcd=0.2898909992E+00 ccd( 1, 1)= 0.6719998153312355E+04 ccd( 1, 2)= -0.1441994567400875E+05 ccd( 1, 3)= 0.1014643546988935E+05 ccd( 1, 4)= -0.2339353083081731E+04 ccd( 2, 2)= 0.3101215316149643E+05 ccd( 2, 3)= -0.2186841785637790E+05 ccd( 2, 4)= 0.5052029967243325E+04 ccd( 3, 3)= 0.1545313327258727E+05 ccd( 3, 4)= -0.3577042152414013E+04 ccd( 4, 4)= 0.8295713838435843E+03 c ################################################################ c For cold giants c N=27 sigma_res=0.88810 sigma_typ=0.12661 r**2=0.831 Coef 1 : -0.2965821442013717E+02 0.1428390444337743E+02 Coef 2 : 0.4810243560543612E+02 0.1975588735859654E+02 Coef 7 : -0.1821468380242129E+02 0.6803748507505433E+01 lecg=.true. ctecg=2.0D0 fcg(1)=-0.2965821442013717E+02 fcg(2)= 0.4810243560543612E+02 fcg(7)=-0.1821468380242129E+02 lcg(1)=.true. lcg(2)=.true. lcg(7)=.true. srcg=0.2481292052E+00 ccg( 1, 1)= 0.3313890113648655E+04 ccg( 1, 2)= -0.4580491053703806E+04 ccg( 1, 3)= 0.1574286679515214E+04 ccg( 2, 2)= 0.6339241743050667E+04 ccg( 2, 3)= -0.2181645620594679E+04 ccg( 3, 3)= 0.7518665004043432E+03 c ################################################################ c For intermediate giants (1 to perform a smooth interpolation with hot stars Coef 1 : -0.1212936084752947E+00 0.2277141998307367E+01 Coef 2 : 0.8780042585941301E+01 0.2055739609606027E+01 Coef 3 : -0.3118236523224460E+00 0.4344705528762989E+00 Coef 5 : 0.2395626257426897E+01 0.3366112233614504E+00 srlm=0.6185569535E+00 flm(1)=-0.1212936084752947E+00 flm(2)= 0.8780042585941301E+01 flm(3)=-0.3118236523224460E+00 flm(5)= 0.2395626257426897E+01 llm(1)=.true. llm(2)=.true. llm(3)=.true. llm(5)=.true. clm(1,1)= 0.1355254442944315E+02 clm(1,2)=-0.1032668811129193E+02 clm(1,3)=-0.1064235548251992E+01 clm(1,4)= 0.5368971961004119E+00 clm(2,2)= 0.1104528231809331E+02 clm(2,3)=-0.2946050091645182E+00 clm(2,4)= 0.2208559213773388E+00 clm(3,3)= 0.4933570134262479E+00 clm(3,4)=-0.2172603789332134E+00 clm(4,4)= 0.2961404947741711E+00 return end c---------------------------------------------------------------- c ####### FUNCTIONS INTERPOLATION AND COEFFICIENTS: ####### c---------------------------------------------------------------- subroutine finfitpat(t,g,z,findex,eindex,iflag) implicit none integer iflag real t,g,z,findex,eindex,pi real findex1,findex2,findex3 real eindex1,eindex2,eindex3 real thet,x double precision fhd(25),fhg(25),fw(25),fc(25),fcd(25),fcg(25), c fi(25),flm(25) double precision chd(25,25),chg(25,25),cw(25,25),cc(25,25) double precision ccd(25,25),ccg(25,25),ci(25,25),clm(25,25) double precision srhd,srhg,srw,src,srcd,srcg,sri,srlm double precision ctehd,ctehg,ctew,ctec,ctecd,ctecg,ctei,ctelm double precision theta,geta,zeta double precision xf(20) logical nog,noz logical lhd(25),lhg(25),lw(25),lc(25),lcd(25),lcg(25),li(25), c llm(25) logical lehd,lehg,lew,lec,lecd,lecg,lei,lelm common/blkl/lhd,lhg,lw,lc,lcd,lcg,li,llm common/blkle/lehd,lehg,lew,lec,lecd,lecg,lei,lelm common/blkf/fhd,fhg,fw,fc,fcd,fcg,fi,flm common/blkc/chd,chg,cw,cc,ccd,ccg,ci,clm common/blksr/srhd,srhg,srw,src,srcd,srcg,sri,srlm common/blkcte/ctehd,ctehg,ctew,ctec,ctecd,ctecg,ctei,ctelm common/blkx/xf C Regions: C 1 = hot dwarfs (hd) C 2 = hot giants (hg) C 3 = warm stars (w) C 4 = cool stars (c) C 5 = cold dwarfs (cd) C 6 = cold giants (cg) C 7 = intermediate (i) c Coefficients and variance-covariance matrices are stored c in this subroutine call readcoefpat c-------------------------------------------------------------------- pi=3.14159 nog=.false. noz=.false. if(g.gt.6.0.or.g.lt.-1.0) nog=.true.!valid range: -1.0 < logg < 6.0 if(z.gt.1.5.or.z.lt.-4.5) noz=.true.!valid range: -4.5 < [Fe/H] < 1.5 findex=0. eindex=0. c if(t.le.0.) then if(t.lt.0.05.or.t.gt.2.25) then !valid range: 2240 K < Teff < 100800 K iflag=-1 return end if if(nog) then iflag=-3 return end if c Program works in theta (=5040/Teff) theta=dble(t) thet=t geta=dble(g) zeta=dble(z) xf(1)=1.D0 xf(2)=theta xf(3)=geta xf(4)=zeta xf(5)=theta*zeta xf(6)=theta*geta xf(7)=theta*theta xf(8)=geta*geta xf(9)=zeta*zeta xf(10)=geta*zeta xf(11)=theta*theta*geta xf(12)=theta*theta*theta xf(13)=geta*geta*geta xf(14)=zeta*zeta*zeta xf(15)=geta*geta*zeta xf(16)=theta*theta*zeta xf(17)=theta*zeta*zeta xf(18)=theta*geta*geta xf(19)=geta*zeta*zeta xf(20)=theta*geta*zeta c Hot stars if(thet.le.0.70) then if(g.ge.2.80) then call compindex(1,findex1,eindex1) end if if(g.le.3.0) then call compindex(2,findex2,eindex2) end if if(g.le.2.80) then findex3=findex2 eindex3=eindex2 else if(g.ge.3.0) then findex3=findex1 eindex3=eindex1 else x=(g-2.80)/0.20 findex3=(1.-x)*findex2+x*findex1 eindex3=(1.-x)*eindex2+x*eindex1 end if end if c If really hot or no z values, it keeps this index if(thet.le.0.45.or.noz) then findex=findex3 eindex=eindex3 return end if end if c Warm stars if(thet.le.0.90) then if(noz) then iflag=-2 return end if call compindex(3,findex1,eindex1) if(thet.le.0.70) then x=cos(pi/2.*(0.70-thet)/0.25) findex=(1.-x)*findex3+x*findex1 eindex=(1.-x)*eindex3+x*eindex1 return end if end if c Cool stars if(thet.le.1.35) then if(noz) then if((g.ge.3..and.thet.lt.1.06).or. c (g.lt.3..and.thet.lt.1.3)) then iflag=-2 return else goto 10 end if end if call compindex(4,findex2,eindex2) if(thet.le.0.90) then x=cos(pi/2.*(thet-0.70)/0.20) findex=(1.-x)*findex2+x*findex1 eindex=(1.-x)*eindex2+x*eindex1 return end if if(thet.ge.1.05) then findex3=findex2 eindex3=eindex2 else findex=findex2 eindex=eindex2 return end if end if c intermediate stars: if(thet.lt.1.3) then call compindex(7,findex2,eindex2) if(thet.le.1.1) then x=cos(pi/2.*(thet-1.05)/0.05) findex=(1.-x)*findex2+x*findex3 eindex=(1.-x)*eindex2+x*eindex3 return end if if(thet.le.1.2) then findex=findex2 eindex=eindex2 return else findex3=findex2 eindex3=eindex2 end if end if 10 if(g.ge.3.) then call compindex(5,findex1,eindex1) if(thet.ge.1.3.or.noz) then findex=findex1 eindex=eindex1 return else x=cos(pi/2.*(thet-1.2)/0.1) findex=(1.-x)*findex1+x*findex3 eindex=(1.-x)*eindex1+x*eindex3 return end if else call compindex(6,findex1,eindex1) if(thet.ge.1.3.or.noz) then findex=findex1 eindex=eindex1 return else x=cos(pi/2.*(thet-1.2)/0.1) findex=(1.-x)*findex1+x*findex3 eindex=(1.-x)*eindex1+x*eindex3 return end if end if c Error: No value was computed iflag=-5 write(*,'(A)') 'ERROR: NO index value was computed' return stop end subroutine readcoefpat implicit none integer i,j double precision fhd(25),fhg(25),fw(25),fc(25),fcd(25),fcg(25), c fi(25),flm(25) double precision chd(25,25),chg(25,25),cw(25,25),cc(25,25) double precision ccd(25,25),ccg(25,25),ci(25,25),clm(25,25) double precision srhd,srhg,srw,src,srcd,srcg,sri,srlm double precision ctehd,ctehg,ctew,ctec,ctecd,ctecg,ctei,ctelm logical lhd(25),lhg(25),lw(25),lc(25),lcd(25),lcg(25),li(25), c llm(25) logical lehd,lehg,lew,lec,lecd,lecg,lei,lelm common/blkl/lhd,lhg,lw,lc,lcd,lcg,li,llm common/blkle/lehd,lehg,lew,lec,lecd,lecg,lei,lelm common/blkf/fhd,fhg,fw,fc,fcd,fcg,fi,flm common/blkc/chd,chg,cw,cc,ccd,ccg,ci,clm common/blksr/srhd,srhg,srw,src,srcd,srcg,sri,srlm common/blkcte/ctehd,ctehg,ctew,ctec,ctecd,ctecg,ctei,ctelm c-Initialization---------------------------------------------------------- do i=1,25 fhd(i)=0.D0 fhg(i)=0.D0 fw(i)=0.D0 fc(i)=0.D0 fcd(i)=0.D0 fcg(i)=0.D0 fi(i)=0.D0 lhd(i)=.false. lhg(i)=.false. lw(i)=.false. lc(i)=.false. lcd(i)=.false. lcg(i)=.false. li(i)=.false. do j=1,25 chd(i,j)=0.D0 chg(i,j)=0.D0 cw(i,j)=0.D0 cc(i,j)=0.D0 ccd(i,j)=0.D0 ccg(i,j)=0.D0 ci(i,j)=0.D0 end do end do lehd=.false. lehg=.false. lew=.false. lec=.false. lecd=.false. lecg=.false. lei=.false. ctehd=0.D0 ctehg=0.D0 ctew=0.D0 ctec=0.D0 ctecd=0.D0 ctecg=0.D0 ctei=0.D0 c #################################################################### c For hot dwarfs c N=46 sigma_res=0.91055 sigma_typ=0.16547 r**2=0.907 Coef 1 : -0.6414842041998517E+01 0.7915653920861390E+00 Coef 2 : 0.5471170690564588E+02 0.3391977387347575E+01 Coef 11 : -0.4283154729334703E+01 0.1091360469602459E+01 Coef 12 : -0.5543770369501858E+02 0.5660695864045900E+01 srhd=0.9105525189E+00 fhd(1)= -0.6414842041998517E+01 fhd(2)= 0.5471170690564588E+02 fhd(11)=-0.4283154729334703E+01 fhd(12)=-0.5543770369501858E+02 lhd(1)=.true. lhd(2)=.true. lhd(11)=.true. lhd(12)=.true. chd(1, 1)= 0.7557246640808089E+00 chd(1, 2)= -0.2960558549963638E+01 chd(1, 3)= 0.2973113221130755E+00 chd(1, 4)= 0.2613220064363448E+01 chd(2, 2)= 0.1387700984856905E+02 chd(2, 3)= -0.2296138146016453E+01 chd(2, 4)= -0.9211030832773542E+01 chd(3, 3)= 0.1436568826092399E+01 chd(3, 4)= -0.4120317405826246E+01 chd(4, 4)= 0.3864823307247444E+02 c #################################################################### c For hot giants c N=29 sigma_res=1.31028 sigma_typ=0.12337 r**2=0.638 Coef 1 : 0.1600578784001784E+01 0.1512014713844868E+01 Coef 7 : 0.4481441967825036E+02 0.2141114317773037E+02 Coef 12 : -0.4688020793569266E+02 0.2920405282121500E+02 srhg=0.1310275642E+01 fhg(1)= 0.1600578784001784E+01 fhg(7)= 0.4481441967825036E+02 fhg(12)=-0.4688020793569266E+02 lhg(1)=.true. lhg(7)=.true. lhg(12)=.true. chg(1, 1)= 0.1331639593680920E+01 chg(1, 2)= -0.1658956419068594E+02 chg(1, 3)= 0.2104426335542746E+02 chg(2, 2)= 0.2670265077686691E+03 chg(2, 3)= -0.3610334950577474E+03 chg(3, 3)= 0.4967763534664019E+03 c #################################################################### c For warm stars ***** Type (1) ***** c N=193 sigma_res=0.55323 sigma_typ=0.16987 r**2=0.962 Coef 1 : -0.1490223712122600E+03 0.2168265245152611E+02 Coef 2 : 0.6511855098857886E+03 0.8841202255706503E+02 Coef 3 : 0.1873879029352709E+02 0.3834616413010322E+01 Coef 5 : -0.4651097177403340E+01 0.1765983253306492E+01 Coef 6 : -0.5639648093112812E+02 0.1091799036371259E+02 Coef 7 : -0.8409103925848722E+03 0.1239715601668017E+03 Coef 11 : 0.3925573822172255E+02 0.7616416142122161E+01 Coef 12 : 0.3379593962162174E+03 0.6000671265103185E+02 Coef 16 : 0.5879643313356195E+01 0.2139014787958550E+01 srw=0.5532316326E+00 fw(1)= -0.1490223712122600E+03 fw(2)= 0.6511855098857886E+03 fw(3)= 0.1873879029352709E+02 fw(5)= -0.4651097177403340E+01 fw(6)= -0.5639648093112812E+02 fw(7)= -0.8409103925848722E+03 fw(11)= 0.3925573822172255E+02 fw(12)= 0.3379593962162174E+03 fw(16)= 0.5879643313356195E+01 lw(1)=.true. lw(2)=.true. lw(3)=.true. lw(5)=.true. lw(6)=.true. lw(7)=.true. lw(11)=.true. lw(12)=.true. lw(16)=.true. cw(1, 1)= 0.1536069298095563E+04 cw(1, 2)= -0.6113941338131892E+04 cw(1, 3)= -0.9838261497798115E+02 cw(1, 4)= 0.4315108233296499E+01 cw(1, 5)= 0.2775752401684439E+03 cw(1, 6)= 0.7911205942323512E+04 cw(1, 7)= -0.1914596276075634E+03 cw(1, 8)= -0.3339055523758496E+04 cw(1, 9)= -0.5220826143284483E+01 cw(2, 2)= 0.2553927963201097E+05 cw(2, 3)= 0.1756104434707228E+03 cw(2, 4)= -0.4075077816530224E+02 cw(2, 5)= -0.4959889322844957E+03 cw(2, 6)= -0.3485098808087657E+05 cw(2, 7)= 0.3430475111595326E+03 cw(2, 8)= 0.1558689143415327E+05 cw(2, 9)= 0.4915444909333141E+02 cw(3, 3)= 0.4804296975245864E+02 cw(3, 4)= 0.4671557332845460E+01 cw(3, 5)= -0.1363090983195444E+03 cw(3, 6)= 0.1024441096845876E+03 cw(3, 7)= 0.9432484123741678E+02 cw(3, 8)= -0.2056177197184068E+03 cw(3, 9)= -0.5549482959094648E+01 cw(4, 4)= 0.1018964733756857E+02 cw(4, 5)= -0.1252506295225635E+02 cw(4, 6)= 0.8740347728984709E+02 cw(4, 7)= 0.8274948831219591E+01 cw(4, 8)= -0.5363112203927325E+02 cw(4, 9)= -0.1229567671835213E+02 cw(5, 5)= 0.3894676633222779E+03 cw(5, 6)= -0.3018624340130482E+03 cw(5, 7)= -0.2710389410536912E+03 cw(5, 8)= 0.5969555314583603E+03 cw(5, 9)= 0.1487074706098748E+02 cw(6, 6)= 0.5021461360440202E+05 cw(6, 7)= 0.2135570781143478E+03 cw(6, 8)= -0.2371047150490940E+05 cw(6, 9)= -0.1054489928829617E+03 cw(7, 7)= 0.1895340842327231E+03 cw(7, 8)= -0.4201831391928452E+03 cw(7, 9)= -0.9820046876808831E+01 cw(8, 8)= 0.1176483017537042E+05 cw(8, 9)= 0.6478126764065532E+02 cw(9, 9)= 0.1494904901082926E+02 c #################################################################### c For cool stars c N=551 sigma_res=0.29565 sigma_typ=0.17091 r**2=0.888 Coef 1 : 0.1771057843811058E+03 0.1195332457234410E+02 Coef 2 : -0.4454748100851141E+03 0.3370782940513188E+02 Coef 3 : -0.1599897246926430E+02 0.1377647465160583E+01 Coef 6 : 0.2920219627575549E+02 0.2821488576566488E+01 Coef 7 : 0.3729055830763336E+03 0.3121541987725868E+02 Coef 9 : -0.3610242222085497E+00 0.1032968208245468E+00 Coef 11 : -0.1333366141867366E+02 0.1430307087690397E+01 Coef 12 : -0.1032931599724490E+03 0.9500331108348696E+01 Coef 14 : -0.1079659157514062E+00 0.4527165813017063E-01 src=0.2956477348E+00 fc( 1)= 0.1771057843811058E+03 fc( 2)= -0.4454748100851141E+03 fc( 3)= -0.1599897246926430E+02 fc( 6)= 0.2920219627575549E+02 fc( 7)= 0.3729055830763336E+03 fc( 9)= -0.3610242222085497E+00 fc(11)= -0.1333366141867366E+02 fc(12)= -0.1032931599724490E+03 fc(14)= -0.1079659157514062E+00 lc(1)=.true. lc(2)=.true. lc(3)=.true. lc(6)=.true. lc(7)=.true. lc(9)=.true. lc(11)=.true. lc(12)=.true. lc(14)=.true. cc(1, 1)= 0.1634663301604898E+04 cc(1, 2)= -0.4589732160033514E+04 cc(1, 3)= -0.1479740563543551E+03 cc(1, 4)= 0.3072551161921372E+03 cc(1, 5)= 0.4197640777779317E+04 cc(1, 6)= -0.1247111415769479E+01 cc(1, 7)= -0.1563496400350022E+03 cc(1, 8)= -0.1251643685716961E+04 cc(1, 9)= -0.4875891669393784E+00 cc(2, 2)= 0.1299907540348569E+05 cc(2, 3)= 0.3932208160508007E+03 cc(2, 4)= -0.8234027051034848E+03 cc(2, 5)= -0.1198856836465734E+05 cc(2, 6)= 0.3453038599776237E+01 cc(2, 7)= 0.4221717881692833E+03 cc(2, 8)= 0.3604238171042190E+04 cc(2, 9)= 0.1315754297423843E+01 cc(3, 3)= 0.2171336251996711E+02 cc(3, 4)= -0.4431423711620204E+02 cc(3, 5)= -0.3381508048304661E+03 cc(3, 6)= 0.2522183912346759E+00 cc(3, 7)= 0.2224107135380521E+02 cc(3, 8)= 0.9384187481022262E+02 cc(3, 9)= 0.1011531394874571E+00 cc(4, 4)= 0.9107674080205160E+02 cc(4, 5)= 0.7139904016076794E+03 cc(4, 6)= -0.5431739023388669E+00 cc(4, 7)= -0.4601612682004582E+02 cc(4, 8)= -0.1998010077250525E+03 cc(4, 9)= -0.2148041083530422E+00 cc(5, 5)= 0.1114780209970000E+05 cc(5, 6)= -0.3100381412286014E+01 cc(5, 7)= -0.3688377998722546E+03 cc(5, 8)= -0.3378919598804511E+04 cc(5, 9)= -0.1145648758759504E+01 cc(6, 6)= 0.1220744564406719E+00 cc(6, 7)= 0.2868608204945824E+00 cc(6, 8)= 0.8877884372850690E+00 cc(6, 9)= 0.5201724887153460E-01 cc(7, 7)= 0.2340504442713192E+02 cc(7, 8)= 0.1039870465021625E+03 cc(7, 9)= 0.1113685710828198E+00 cc(8, 8)= 0.1032591086435052E+04 cc(8, 9)= 0.3171871255005078E+00 cc(9, 9)= 0.2344788584461537E-01 c #################################################################### c For cold dwarfs c N=29 sigma_res=0.37429 sigma_typ=0.17734 r**2=0.626 Coef 1 : 0.1200491649229753E+01 0.2075604807638792E+00 Coef 12 : -0.3093617468826813E+00 0.6790070081313161E-01 srcd=0.3742928812E+00 fcd(1)= 0.1200491649229753E+01 fcd(12)=-0.3093617468826813E+00 lcd(1)=.true. lcd(12)=.true. ccd(1, 1)= 0.3075149269772798E+00 ccd(1, 2)= -0.8849937686531108E-01 ccd(2, 2)= 0.3290981031178655E-01 c #################################################################### c For cold giants c N=44 sigma_res=0.35057 sigma_typ=0.11180 r**2=0.787 Coef 1 : 0.3442965807069610E+03 0.1837755822433069E+03 Coef 2 : -0.7402356340413226E+03 0.3745100729770819E+03 Coef 7 : 0.5270228706861221E+03 0.2530399365580612E+03 Coef 12 : -0.1238108039872834E+03 0.5669263182847755E+02 srcg=0.3505687328E+00 fcg(1)= 0.3442965807069610E+03 fcg(2)= -0.7402356340413226E+03 fcg(7)= 0.5270228706861221E+03 fcg(12)=-0.1238108039872834E+03 lcg(1)=.true. lcg(2)=.true. lcg(7)=.true. lcg(12)=.true. ccg(1, 1)= 0.2748079276703048E+06 ccg(1, 2)= -0.5598849094337926E+06 ccg(1, 3)= 0.3780019645695414E+06 ccg(1, 4)= -0.8457987522765558E+05 ccg(2, 2)= 0.1141249627230004E+07 ccg(2, 3)= -0.7708925668275768E+06 ccg(2, 4)= 0.1725786040683132E+06 ccg(3, 3)= 0.5209928730908013E+06 ccg(3, 4)= -0.1166951925485475E+06 ccg(4, 4)= 0.2615211874974796E+05 c #################################################################### c For intermediate stars (1-1) sri=0.2506505188E+00 fi(1)=0.7600288487198743E+00 fi(4)=0.1743380405206003E+00 li(1)=.true. li(4)=.true. ci(1, 1)=0.1867809416616686E-01 ci(1, 2)=0.1533157262353484E-01 ci(2, 2)=0.4809370444541371E-01 return end c---------------------------------------------------------------- c ####### FUNCTIONS INTERPOLATION AND COEFFICIENTS: ###### c---------------------------------------------------------------- subroutine finfitsTiO(t,g,z,findex,eindex,iflag) implicit none integer iflag real t,g,z,findex,eindex,pi real findex1,findex2,findex3 real eindex1,eindex2,eindex3 real thet,x double precision fhd(25),fhg(25),fw(25),fc(25),fcd(25),fcg(25), c fi(25),flm(25) double precision chd(25,25),chg(25,25),cw(25,25),cc(25,25) double precision ccd(25,25),ccg(25,25),ci(25,25),clm(25,25) double precision srhd,srhg,srw,src,srcd,srcg,sri,srlm double precision ctehd,ctehg,ctew,ctec,ctecd,ctecg,ctei,ctelm double precision theta,geta,zeta double precision xf(20) logical nog,noz logical lhd(25),lhg(25),lw(25),lc(25),lcd(25),lcg(25),li(25), c llm(25) logical lehd,lehg,lew,lec,lecd,lecg,lei,lelm common/blkl/lhd,lhg,lw,lc,lcd,lcg,li,llm common/blkle/lehd,lehg,lew,lec,lecd,lecg,lei,lelm common/blkf/fhd,fhg,fw,fc,fcd,fcg,fi,flm common/blkc/chd,chg,cw,cc,ccd,ccg,ci,clm common/blksr/srhd,srhg,srw,src,srcd,srcg,sri,srlm common/blkcte/ctehd,ctehg,ctew,ctec,ctecd,ctecg,ctei,ctelm common/blkx/xf C Regions: C 1 = hot dwarfs (hd) C 2 = hot giants (hg) C 3 = intermediate region (i) of warm stars C 4 = cold dwarfs (cd) C 5 = cold giants (c) C 6 = very cold giants (cg) c Coefficients and variance-covariance matrices are stored c in this subroutine call readcoefsTiO c----------------------------------------------------------------------- pi=3.14159 nog=.false. noz=.false. if(g.gt.6.0.or.g.lt.-1.0) nog=.true.!valid range: -1.0 < logg < 6.0 if(z.gt.1.5.or.z.lt.-4.5) noz=.true.!valid range: -4.5 < [Fe/H] < 1.5 findex=0. eindex=0. c if(t.le.0.) then if(t.lt.0.05.or.t.gt.2.25) then !valid range: 2240 K < Teff < 100800 K iflag=-1 return end if if(nog) then iflag=-3 return end if c Program works in theta (=5040/Teff) theta=dble(t) thet=t geta=dble(g) zeta=dble(z) xf(1)=1.D0 xf(2)=theta xf(3)=geta xf(4)=zeta xf(5)=theta*zeta xf(6)=theta*geta xf(7)=theta*theta xf(8)=geta*geta xf(9)=zeta*zeta xf(10)=geta*zeta xf(11)=theta*theta*geta xf(12)=theta*theta*theta xf(13)=geta*geta*geta xf(14)=zeta*zeta*zeta xf(15)=geta*geta*zeta xf(16)=theta*theta*zeta xf(17)=theta*zeta*zeta xf(18)=theta*geta*geta xf(19)=geta*zeta*zeta xf(20)=theta*geta*zeta c Hot stars if(thet.le.0.85) then if(g.ge.2.80) then call compindex(1,findex1,eindex1) end if if(g.le.3.0) then call compindex(2,findex2,eindex2) end if if(g.le.2.80) then findex3=findex2 eindex3=eindex2 else if(g.ge.3.0) then findex3=findex1 eindex3=eindex1 else x=(g-2.80)/0.20 !Interpolation in logg (2.8-3.0) hdw-hgi findex3=(1.-x)*findex2+x*findex1 eindex3=(1.-x)*eindex2+x*eindex1 end if end if if(thet.le.0.45.or.noz) then findex=findex3 eindex=eindex3 return end if end if c Intermediate warm and cold stars if(thet.le.1.35) then if(noz) then iflag=-2 return end if call compindex(7,findex1,eindex1) if(thet.le.0.60)then findex=findex3 eindex=eindex3 return elseif(thet.le.0.80) then ! Interpolation in theta (0.80-0.60), hdw-i, hgi-i x=cos(pi/2.*(0.80-thet)/0.20) findex=(1.-x)*findex3+x*findex1 eindex=(1.-x)*eindex3+x*eindex1 return end if end if 10 if(g.ge.3.) then call compindex(5,findex2,eindex2) if(thet.le.1.07) then findex=findex1 eindex=eindex1 return endif if(thet.ge.1.27.or.noz) then findex=findex2 eindex=eindex2 return else x=cos(pi/2.*(thet-1.07)/0.2) ! Interpolation in theta (1.27-1.07), i-cdw findex=(1.-x)*findex2+x*findex1 eindex=(1.-x)*eindex2+x*eindex1 return end if else call compindex(4,findex2,eindex2) call compindex(6,findex3,eindex3) if(thet.le.1.28)then findex=findex1 eindex=eindex1 return else if(thet.le.1.40)then if(thet.ge.1.35)then findex=findex2 eindex=eindex2 return else x=cos(pi/2.*(thet-1.28)/0.07) ! Interpolation in theta (1.35-1.28), i-cgi findex=(1.-x)*findex2+x*findex1 eindex=(1.-x)*eindex2+x*eindex1 return endif else if(thet.ge.1.47) then findex=findex3 eindex=eindex3 if(thet.ge.1.70)then findex=2.6327 eindex=0. endif return else x=cos(pi/2.*(thet-1.40)/0.07) !Interpolation in theta (1.47-1.40),cgi-vcgi findex=(1.-x)*findex3+x*findex2 eindex=(1.-x)*eindex3+x*eindex2 return endif end if endif endif c Error: No value was computed iflag=-5 write(*,'(A)') 'ERROR: NO index value was computed' return stop end c------------------------------------------------------------------------------------------- subroutine readcoefsTiO implicit none integer i,j double precision fhd(25),fhg(25),fw(25),fc(25),fcd(25),fcg(25), c fi(25),flm(25) double precision chd(25,25),chg(25,25),cw(25,25),cc(25,25) double precision ccd(25,25),ccg(25,25),ci(25,25),clm(25,25) double precision srhd,srhg,srw,src,srcd,srcg,sri,srlm double precision ctehd,ctehg,ctew,ctec,ctecd,ctecg,ctei,ctelm logical lhd(25),lhg(25),lw(25),lc(25),lcd(25),lcg(25),li(25), c llm(25) logical lehd,lehg,lew,lec,lecd,lecg,lei,lelm common/blkl/lhd,lhg,lw,lc,lcd,lcg,li,llm common/blkle/lehd,lehg,lew,lec,lecd,lecg,lei,lelm common/blkf/fhd,fhg,fw,fc,fcd,fcg,fi,flm common/blkc/chd,chg,cw,cc,ccd,ccg,ci,clm common/blksr/srhd,srhg,srw,src,srcd,srcg,sri,srlm common/blkcte/ctehd,ctehg,ctew,ctec,ctecd,ctecg,ctei,ctelm c-Initialization---------------------------------------------------------- do i=1,25 fhd(i)=0.D0 fhg(i)=0.D0 fw(i)=0.D0 fc(i)=0.D0 fcd(i)=0.D0 fcg(i)=0.D0 fi(i)=0.D0 lhd(i)=.false. lhg(i)=.false. lw(i)=.false. lc(i)=.false. lcd(i)=.false. lcg(i)=.false. li(i)=.false. do j=1,25 chd(i,j)=0.D0 chg(i,j)=0.D0 cw(i,j)=0.D0 cc(i,j)=0.D0 ccd(i,j)=0.D0 ccg(i,j)=0.D0 ci(i,j)=0.D0 end do end do lehd=.false. lehg=.false. lew=.false. lec=.false. lecd=.false. lecg=.false. lei=.false. ctehd=0.D0 ctehg=0.D0 ctew=0.D0 ctec=0.D0 ctecd=0.D0 ctecg=0.D0 ctei=0.D0 C######################################################################## c For hot dwarfs WEIGHTED c N=35 sigma_res=0.01331 sigma_typ=0.00404 r**2=0.778 C EXPONENTIAL FIT Constant: 0.78 Coef 1 : -0.2261233080668275E+01 0.5934562331055201E-01 Coef 7 : 0.8061797366742040E+01 0.9155868953042732E+00 Coef 12 : -0.1106751606048752E+02 0.1310667967660797E+01 lehd=.true. ctehd=0.78 srhd=0.01331 fhd(1)= -0.2261233080668275E+01 fhd(7)= 0.8061797366742040E+01 fhd(12)=-0.1106751606048752E+02 lhd(1)=.true. lhd(7)=.true. lhd(12)=.true. chd(1, 1)= 0.4833522211254657E+00 chd(1, 2)= -0.6214702562058652E+01 chd(1, 3)= 0.8062019936497267E+01 chd(2, 2)= 0.1150496928220778E+03 chd(2, 3)= -0.1629387461759924E+03 chd(3, 3)= 0.2357608553282230E+03 C######################################################################## c For hot giants WEIGHTED c N=40 sigma_res=0.2994189736E-01 sigma_typ=0.00336 r**2=0.61 Coef 1 : 0.9550751486998874E+00 0.6603954246153728E-02 srhg=0.2994189736E-01 fhg(1)= 0.9550751486998874E+00 lhg(1)=.true. chg(1, 1)= 0.4864626227774354E-01 C######################################################################## c For intermediate warm stars WEIGHTED c N=569 sigma_res=0.1538049923E-01 sigma_typ=0.00386 r**2=0.754 Coef 1 : 0.1854752154516079E+01 0.2232798701662782E+00 Coef 2 : -0.2617652104385464E+01 0.7003789023707058E+00 Coef 3 : -0.7342855910128371E-01 0.1508437149588484E-01 Coef 4 : 0.3045724703471940E-01 0.5105520588759884E-02 Coef 7 : 0.2690895177483312E+01 0.7266804630860749E+00 Coef 8 : 0.1767549185343616E-01 0.6612570175225384E-02 Coef 10 : -0.8611503421385915E-02 0.1667622777979342E-02 Coef 12 : -0.8812754426127665E+00 0.2470761282616948E+00 Coef 13 : -0.1650805226102687E-02 0.8573226599441148E-03 sri=0.1538049923E-01 fi(1)= 0.1854752154516079E+01 fi(2)= -0.2617652104385464E+01 fi(3)= -0.7342855910128371E-01 fi(4)= 0.3045724703471940E-01 fi(7)= 0.2690895177483312E+01 fi(8)= 0.1767549185343616E-01 fi(10)=-0.8611503421385915E-02 fi(12)=-0.8812754426127665E+00 fi(13)=-0.1650805226102687E-02 li(1)=.true. li(2)=.true. li(3)=.true. li(4)=.true. li(7)=.true. li(8)=.true. li(10)=.true. li(12)=.true. li(13)=.true. ci(1, 1)= 0.2107454842543804E+03 ci(1, 2)=-0.6588945700436742E+03 ci(1, 3)=-0.3298183230841380E+01 ci(1, 4)= 0.6263280533023270E+00 ci(1, 5)= 0.6790493049526253E+03 ci(1, 6)= 0.1054066896597554E+01 ci(1, 7)=-0.2301155291295764E+00 ci(1, 8)=-0.2283720614350136E+03 ci(1, 9)=-0.9034019994684314E-01 ci(2, 2)= 0.2073601251172390E+04 ci(2, 3)= 0.9033667313186347E+01 ci(2, 4)=-0.1655771657237430E+01 ci(2, 5)=-0.2146190071238452E+04 ci(2, 6)=-0.2808596072355688E+01 ci(2, 7)= 0.6027529973992993E+00 ci(2, 8)= 0.7245335523013720E+03 ci(2, 9)= 0.2219142078452992E+00 ci(3, 3)= 0.9618637881226449E+00 ci(3, 4)=-0.9552260493021560E-01 ci(3, 5)=-0.9623400842706879E+01 ci(3, 6)=-0.4046099946518070E+00 ci(3, 7)= 0.2947402135085784E-01 ci(3, 8)= 0.3264826726229500E+01 ci(3, 9)= 0.4950713608274269E-01 ci(4, 4)= 0.1101892429926264E+00 ci(4, 5)= 0.1779091870780121E+01 ci(4, 6)= 0.2579600318986813E-01 ci(4, 7)=-0.3196982747820084E-01 ci(4, 8)=-0.6259556886914209E+00 ci(4, 9)=-0.2465226183675684E-02 ci(5, 5)= 0.2232266820977214E+04 ci(5, 6)= 0.2907929897031515E+01 ci(5, 7)=-0.6089107396187290E+00 ci(5, 8)=-0.7571695251574179E+03 ci(5, 9)=-0.2212401857602275E+00 ci(6, 6)= 0.1848416019035949E+00 ci(6, 7)=-0.8668595062954606E-02 ci(6, 8)=-0.9382284629956974E+00 ci(6, 9)=-0.2365173928056231E-01 ci(7, 7)= 0.1175586994060908E-01 ci(7, 8)= 0.2022173178895492E+00 ci(7, 9)= 0.9225570922270887E-03 ci(8, 8)= 0.2580600102108933E+03 ci(8, 9)= 0.6615423854313809E-01 ci(9, 9)= 0.3107046415595799E-02 C####################################################################### C For cold dwarfs WEIGHTED c N=21 sigma_res=0.1707349865E-01 sigma_typ=0.00410 r**2=0.982 Coef 1 : 0.2454211706120712E+01 0.2958641819585296E+00 Coef 2 : -0.2547328043299685E+01 0.4176511731406848E+00 Coef 7 : 0.1070011927384788E+01 0.1447020601722790E+00 srcd=0.1707349865E-01 fcd(1)= 0.2454211706120712E+01 fcd(2)=-0.2547328043299685E+01 fcd(7)= 0.1070011927384788E+01 lcd(1)=.true. lcd(2)=.true. lcd(7)=.true. ccd(1, 1)= 0.3002892144416614E+03 ccd(1, 2)= -0.4229166715330222E+03 ccd(1, 3)= 0.1453787197936784E+03 ccd(2, 2)= 0.5983872921392599E+03 ccd(2, 3)= -0.2067251366622285E+03 ccd(3, 3)= 0.7182975404674985E+02 C######################################################################## c For cold giants WEIGHTED c N=25 sigma_res=0.2357431340E-01 sigma_typ=0.00327 r**2=0.946 Coef 1 : 0.5996788996485434E+01 0.1924627780398984E+01 Coef 7 : -0.9245555811031059E+01 0.3118596465408741E+01 Coef 12 : 0.4836582212691041E+01 0.1524354601184322E+01 src=0.2357431340E-01 fc(1)= 0.5996788996485434E+01 fc(7)= -0.9245555811031059E+01 fc(12)= 0.4836582212691041E+01 lc(1)=.true. lc(7)=.true. lc(12)=.true. cc(1, 1)= 0.6665233903101890E+04 cc(1, 2)= -0.1079374279359434E+05 cc(1, 3)= 0.5271717343928391E+04 cc(2, 2)= 0.1750008906571762E+05 cc(2, 3)= -0.8552506505761716E+04 cc(3, 3)= 0.4181132266938564E+04 C######################################################################## c For very cold giants WEIGHTED c N=14 sigma_res=0.6465804641E-01 sigma_typ=0.00578 r**2=0.990 Coef 1 : -0.3979267524044312E+02 0.5448400753716350E+01 Coef 2 : 0.3743776077340574E+02 0.5236015429403985E+01 Coef 12 : -0.4318914544663060E+01 0.7093003230222535E+00 srcg=0.6465804641E-01 fcg(1)= -0.3979267524044312E+02 fcg(2)= 0.3743776077340574E+02 fcg(12)=-0.4318914544663060E+01 lcg(1)=.true. lcg(2)=.true. lcg(12)=.true. ccg(1, 1)= 0.7100565392186860E+04 ccg(1, 2)= -0.6821735995994344E+04 ccg(1, 3)= 0.9216843432359631E+03 ccg(2, 2)= 0.6557777510319650E+04 ccg(2, 3)= -0.8871391975287052E+03 ccg(3, 3)= 0.1203414272630102E+03 return end c---------------------------------------------------------------- c ####### FUNCTIONS INTERPOLATION AND COEFFICIENTS: ####### c---------------------------------------------------------------- subroutine finfitMgI(t,g,z,findex,eindex,iflag) implicit none integer iflag real t,g,z,findex,eindex,pi real findex1,findex2,findex3 real eindex1,eindex2,eindex3 real thet,x double precision fhd(25),fhg(25),fw(25),fc(25),fcd(25),fcg(25), c fi(25),flm(25) double precision chd(25,25),chg(25,25),cw(25,25),cc(25,25) double precision ccd(25,25),ccg(25,25),ci(25,25),clm(25,25) double precision srhd,srhg,srw,src,srcd,srcg,sri,srlm double precision ctehd,ctehg,ctew,ctec,ctecd,ctecg,ctei,ctelm double precision theta,geta,zeta double precision xf(20) logical nog,noz logical lhd(25),lhg(25),lw(25),lc(25),lcd(25),lcg(25),li(25), c llm(25) logical lehd,lehg,lew,lec,lecd,lecg,lei,lelm common/blkl/lhd,lhg,lw,lc,lcd,lcg,li,llm common/blkle/lehd,lehg,lew,lec,lecd,lecg,lei,lelm common/blkf/fhd,fhg,fw,fc,fcd,fcg,fi,flm common/blkc/chd,chg,cw,cc,ccd,ccg,ci,clm common/blksr/srhd,srhg,srw,src,srcd,srcg,sri,srlm common/blkcte/ctehd,ctehg,ctew,ctec,ctecd,ctecg,ctei,ctelm C Regions: C 1 = hot dwarfs (hd) C 2 = hot giants (hg) C 3 = cool stars (c) C 4 = cold dwarfs (cd) C 5 = cold giants (cg) C 6 = intermediate region (i) of warm stars c Coefficients and variance-covariance matrices are stored c in this subroutine call readcoefMgI c----------------------------------------------------------------------- pi=3.14159 nog=.false. noz=.false. if(g.gt.6.0.or.g.lt.-1.0) nog=.true.!valid range: -1.0 < logg < 6.0 if(z.gt.1.5.or.z.lt.-4.5) noz=.true.!valid range: -4.5 < [Fe/H] < 1.5 findex=0. eindex=0. c if(t.le.0.) then if(t.lt.0.05.or.t.gt.2.25) then !valid range: 2240 K < Teff < 100800 K iflag=-1 return end if if(nog) then iflag=-3 return end if c Program works in theta (=5040/Teff) theta=dble(t) thet=t geta=dble(g) zeta=dble(z) xf(1)=1.D0 xf(2)=theta xf(3)=geta xf(4)=zeta xf(5)=theta*zeta xf(6)=theta*geta xf(7)=theta*theta xf(8)=geta*geta xf(9)=zeta*zeta xf(10)=geta*zeta xf(11)=theta*theta*geta xf(12)=theta*theta*theta xf(13)=geta*geta*geta xf(14)=zeta*zeta*zeta xf(15)=geta*geta*zeta xf(16)=theta*theta*zeta xf(17)=theta*zeta*zeta xf(18)=theta*geta*geta xf(19)=geta*zeta*zeta xf(20)=theta*geta*zeta c Hot stars if(thet.le.0.70) then if(g.ge.2.80.and.thet.le.0.70) then call compindex(1,findex1,eindex1) end if if(g.le.3.0.and.thet.le.0.7) then call compindex(2,findex2,eindex2) end if if(g.le.2.80.and.thet.le.0.7) then findex3=findex2 eindex3=eindex2 elseif(g.gt.3.0.and.thet.le.0.70) then findex3=findex1 eindex3=eindex1 elseif(g.gt.2.8.and.g.le.3.0.and.thet.le.0.6)then x=(g-2.80)/0.20 findex3=(1.-x)*findex2+x*findex1 eindex3=(1.-x)*eindex2+x*eindex1 end if c If really hot or no z values, it keeps this index if((g.ge.3.0.and.thet.le.0.45).or.(g.lt.3.0.and.thet.le.0.45) > .or.noz) then findex=findex3 eindex=eindex3 return end if end if c Cool stars if(thet.le.1.60) then if(noz) then iflag=-2 return end if call compindex(4,findex1,eindex1) if(thet.le.0.75.and.thet.gt.0.45.and.g.ge.3.0)then x=cos(pi/2.*(0.75-thet)/0.3) findex=(1.-x)*findex3+x*findex1 eindex=(1.-x)*eindex3+x*eindex1 return elseif(thet.le.0.75.and.thet.gt.0.45.and.g.lt.3.0)then x=cos(pi/2.*(0.75-thet)/0.3) findex=(1.-x)*findex3+x*findex1 eindex=(1.-x)*eindex3+x*eindex1 return end if end if c Cold stars if(thet.lt.2.05)then if(thet.le.1.60)call compindex(7,findex3,eindex3) if(thet.ge.1.20.and.g.lt.3.)then call compindex(6,findex2,eindex2) if(thet.gt.1.60)then findex=findex2 eindex=eindex2 return else x=cos(pi/2.*(1.60-thet)/0.40) findex=(1.-x)*findex3+x*findex2 eindex=(1.-x)*eindex3+x*eindex2 return endif elseif(thet.ge.1.10.and.g.ge.3.)then call compindex(5,findex2,eindex2) if(thet.gt.1.50)then findex=findex2 eindex=eindex2 return else x=cos(pi/2.*(1.50-thet)/0.4) findex=(1.-x)*findex3+x*findex2 eindex=(1.-x)*eindex3+x*eindex2 return endif elseif(thet.ge.1.0)then if(g.gt.3.)then x=cos(pi/2.*(1.10-thet)/0.10) findex=(1.-x)*findex1+x*findex3 eindex=(1.-x)*eindex1+x*eindex3 return else x=cos(pi/2.*(1.20-thet)/0.20) findex=(1.-x)*findex1+x*findex3 eindex=(1.-x)*eindex1+x*eindex3 return endif else findex=findex1 eindex=eindex1 return endif endif iflag=-5 write(*,'(A)') 'ERROR: NO index value was computed' return stop end c----------------------------------------------------------------------------------- subroutine readcoefMgI implicit none integer i,j double precision fhd(25),fhg(25),fw(25),fc(25),fcd(25),fcg(25), c fi(25),flm(25) double precision chd(25,25),chg(25,25),cw(25,25),cc(25,25) double precision ccd(25,25),ccg(25,25),ci(25,25),clm(25,25) double precision srhd,srhg,srw,src,srcd,srcg,sri,srlm double precision ctehd,ctehg,ctew,ctec,ctecd,ctecg,ctei,ctelm logical lhd(25),lhg(25),lw(25),lc(25),lcd(25),lcg(25),li(25), c llm(25) logical lehd,lehg,lew,lec,lecd,lecg,lei,lelm common/blkl/lhd,lhg,lw,lc,lcd,lcg,li,llm common/blkle/lehd,lehg,lew,lec,lecd,lecg,lei,lelm common/blkf/fhd,fhg,fw,fc,fcd,fcg,fi,flm common/blkc/chd,chg,cw,cc,ccd,ccg,ci,clm common/blksr/srhd,srhg,srw,src,srcd,srcg,sri,srlm common/blkcte/ctehd,ctehg,ctew,ctec,ctecd,ctecg,ctei,ctelm c-Initialization---------------------------------------------------------- do i=1,25 fhd(i)=0.D0 fhg(i)=0.D0 fc(i)=0.D0 fi(i)=0.D0 fcd(i)=0.D0 fcg(i)=0.D0 lhd(i)=.false. lhg(i)=.false. lc(i)=.false. li(i)=.false. lcd(i)=.false. lcg(i)=.false. do j=1,25 chd(i,j)=0.D0 chg(i,j)=0.D0 cc(i,j)=0.D0 ci(i,j)=0.D0 ccd(i,j)=0.D0 ccg(i,j)=0.D0 end do end do lehd=.false. lehg=.false. lec=.false. lei=.false. lecd=.false. lecg=.false. ctehd=0.D0 ctehg=0.D0 ctec=0.D0 ctei=0.D0 ctecd=0.D0 ctecg=0.D0 c #################################################################### c For hot dwarfs c N=49 sigma_res=0.094 sigma_typ=0.046 r**2=0.74 C EXPONENTIAL FIT Constant: -1.50 Coef 1 : 0.4283691026649478E+00 0.9361645672697215E-01 Coef 7 : -0.4833159426443133E+01 0.1137159084018751E+01 Coef 12 : 0.7475618317255569E+01 0.1485050598594195E+01 lehd=.true. ctehd=-1.5D0 srhd=0.9350953826E-01 fhd(1)=0.4283691026649478E+00 fhd(7)=-0.4833159426443133E+01 fhd(12)=0.7475618317255569E+01 lhd(1)=.true. lhd(7)=.true. lhd(12)=.true. chd( 1, 1)= 0.1001756208054846E+01 chd( 1, 2)= -0.1102672772245672E+02 chd( 1, 3)= 0.1337259875294098E+02 chd( 2, 2)= 0.1477618491062455E+03 chd( 2, 3)= -0.1907285416946117E+03 chd( 3, 3)= 0.2518970841061548E+03 c #################################################################### c For hot giants c N=21 sigma_res=0.056 sigma_typ=0.033 r**2=0.47 Coef 1 : -0.1201917746652227E+00 0.3706708702279275E-01 Coef 12 : 0.6253823261104153E+00 0.2571939370512952E+00 srhg=0.5567235031E-01 fhg(1)=-0.1201917746652227E+00 fhg(12)=0.6253823261104153E+00 lhg(1)=.true. lhg(12)=.true. chg( 1, 1)= 0.4417233795926754E+00 chg( 1, 2)= -0.2631472255668900E+01 chg( 2, 2)= 0.2129317719407705E+02 c #################################################################### c For intermediate warm stars c N=586 sigma_res=0.094 sigma_typ=0.044 r**2=0.89 Coef 1 : 0.1845554436074967E+01 0.4230046702279171E+00 Coef 2 : -0.7960169355385649E+01 0.1649539709370115E+01 Coef 3 : -0.1998660066764755E+00 0.3489405155349934E-01 Coef 5 : 0.3079053263251620E+00 0.3096350620445296E-01 Coef 7 : 0.1167968392995355E+02 0.2023801463181931E+01 Coef 9 : 0.1861894114599228E+00 0.6001181272385286E-01 Coef 11 : -0.6817320165691089E-01 0.3318732810675449E-01 Coef 12 : -0.4570981793624912E+01 0.7597292136727547E+00 Coef 17 : -0.1624176015999102E+00 0.6046245985145578E-01 Coef 18 : 0.5072432272157244E-01 0.5677477144819303E-02 src=0.9410767921E-01 fc(1)= 0.1845554436074967E+01 fc(2)= -0.7960169355385649E+01 fc(3)= -0.1998660066764755E+00 fc(5)= 0.3079053263251620E+00 fc(7)= 0.1167968392995355E+02 fc(9)= 0.1861894114599228E+00 fc(11)=-0.6817320165691089E-01 fc(12)=-0.4570981793624912E+01 fc(17)=-0.1624176015999102E+00 fc(18)= 0.5072432272157244E-01 lc(1)=.true. lc(2)=.true. lc(3)=.true. lc(5)=.true. lc(7)=.true. lc(9)=.true. lc(11)=.true. lc(12)=.true. lc(17)=.true. lc(18)=.true. cc( 1, 1)= 0.2020413202110936E+02 cc( 1, 2)= -0.7458261524987259E+02 cc( 1, 3)= 0.4231479350000749E-01 cc( 1, 4)= 0.8440331779995956E-01 cc( 1, 5)= 0.8613751800580114E+02 cc( 1, 6)= 0.3941306503294438E+00 cc( 1, 7)= -0.5650646973667980E+00 cc( 1, 8)= -0.3107014920603885E+02 cc( 1, 9)= -0.4016444495721797E+00 cc( 1,10)= 0.9821433410656737E-01 cc( 2, 2)= 0.3072383490040916E+03 cc( 2, 3)= -0.1872867798093312E+01 cc( 2, 4)= -0.4123531493213390E+00 cc( 2, 5)= -0.3724108063470849E+03 cc( 2, 6)= -0.2005001651823398E+01 cc( 2, 7)= 0.3525213025453493E+01 cc( 2, 8)= 0.1373461461584094E+03 cc( 2, 9)= 0.2020532480200087E+01 cc( 2,10)= -0.2985776092312173E+00 cc( 3, 3)= 0.1374841616842507E+00 cc( 3, 4)= 0.6785867186776715E-03 cc( 3, 5)= 0.2865265956906230E+01 cc( 3, 6)= -0.4210064894573011E-02 cc( 3, 7)= -0.7269466577958775E-01 cc( 3, 8)= -0.1114655987519009E+01 cc( 3, 9)= 0.5049378388627425E-02 cc( 3,10)= -0.1209627251953279E-01 cc( 4, 4)= 0.1082555420305153E+00 cc( 4, 5)= 0.5459673518614844E+00 cc( 4, 6)= 0.1025432364889745E-01 cc( 4, 7)= -0.7965719238705232E-02 cc( 4, 8)= -0.1996921223205734E+00 cc( 4, 9)= 0.4097971357613309E-01 cc( 4,10)= 0.1776924361834383E-02 cc( 5, 5)= 0.4624722560008947E+03 cc( 5, 6)= 0.2762042901343269E+01 cc( 5, 7)= -0.4952032353258934E+01 cc( 5, 8)= -0.1728315913454728E+03 cc( 5, 9)= -0.2798722362625522E+01 cc( 5,10)= 0.3522043578097100E+00 cc( 6, 6)= 0.4066524224544624E+00 cc( 6, 7)= -0.5722985234051747E-01 cc( 6, 8)= -0.1059879973013045E+01 cc( 6, 9)= -0.3940367306839343E+00 cc( 6,10)= 0.9417051216469793E-02 cc( 7, 7)= 0.1243639338695414E+00 cc( 7, 8)= 0.1911563045043996E+01 cc( 7, 9)= 0.6015611311220458E-01 cc( 7,10)= -0.7590951194486823E-02 cc( 8, 8)= 0.6517297202848211E+02 cc( 8, 9)= 0.1083406026981396E+01 cc( 8,10)= -0.1278626857606091E+00 cc( 9, 9)= 0.4127827092546594E+00 cc( 9,10)= -0.9657917635096921E-02 cc(10,10)= 0.3639658714066504E-02 c #################################################################### c For intermediate cool stars (1.05 matrix n1 x n2 c b -> matrix n3 x n4 c n2 must be equal to n3 c Input : n1,n2,n3,n4 (integers, dimensions of matrices) c Output: c -> matrix n1 x n4 c In the main program matrices must be defined as double precision with c dimensions 25x25 subroutine multmatrix(a,b,c,n1,n2,n3,n4) implicit none integer n1,n2,n3,n4 integer i,j,k double precision a(25,25),b(25,25),c(25,25) if(n2.ne.n3) then write(6,*) 'Error in matrix dimensions' stop end if do i=1,n1 do j=1,n4 c(i,j)=0.D0 do k=1,n2 c(i,j)=c(i,j)+a(i,k)*b(k,j) end do end do end do return end subroutine thetglimits(t0,g,iflag) implicit none integer iflag,IGRID,JGRID,NGRID integer i,j,nx,ny real t0,g real tglib(2,4,2),v(2,4,2)!tglib(i,j,1)=theta;tglib(i,j,2)=logg; real pv(4) data tglib/0.85, 1.85,0.10,1.45,0.10,1.05,1.30,2.00,!theta limits + -0.20,-0.20,2.80,1.40,4.20,4.00,5.20,5.25/!logg limits nx=2 ny=4 do i=1,nx do j=1,ny v(i,j,1)=tglib(i,j,1)-t0 v(i,j,2)=tglib(i,j,2)-g enddo enddo C Computing vectorial products to test if the point (t0,g) is inside C the theta-logg coverage of the library NGRID=0 DO I=1,NX-1 DO J=1,NY-1 PV(1)=V(I,J,1)*V(I,J+1,2)-V(I,J,2)*V(I,J+1,1) ! Prod.vect. PV(2)=V(I,J+1,1)*V(I+1,J+1,2)-V(I,J+1,2)*V(I+1,J+1,1) PV(3)=V(I+1,J+1,1)*V(I+1,J,2)-V(I+1,J+1,2)*V(I+1,J,1) PV(4)=V(I+1,J,1)*V(I,J,2)-V(I+1,J,2)*V(I,J,1) IF((PV(1).GT.0.AND.PV(2).GT.0.AND.PV(3).GT.0.AND. + PV(4).GT.0).OR.(PV(1).LT.0.AND.PV(2).LT.0.AND. + PV(3).LT.0.AND.PV(4).LT.0)) + THEN !(t0,g) is inside the atm.param space IGRID=I JGRID=J iflag=0 ELSE !(t0,g) is outside--> extrapolating NGRID=NGRID+1 ENDIF enddo enddo IF(NGRID.EQ.3)THEN iflag=1 endif return end