PROGRAM GENEVA DIMENSION HLAM(1221),WAVE(1221),HNU(1221),HNUCONT(1221) DIMENSION AMAGI(13,1221),TRANSI(13,1221),EBVI(13),AMAG(1221) CHARACTER*80 TITLE DIMENSION A(8) DIMENSION F(3000) DIMENSION UFILT(13),B1FILT(17),BFILT(20),B2FILT(15),GFILT(17) DIMENSION VFILT(22),V1FILT(18) DIMENSION UWAVE(13),B1WAVE(17),BWAVE(20),B2WAVE(15),GWAVE(17) DIMENSION VWAVE(22),V1WAVE(18) DIMENSION WAVEU(3000),WAVEB1(3000),WAVEB(3000),WAVEB2(3000) DIMENSION WAVEG(3000),WAVEV(3000),WAVEV1(3000) DIMENSION SU(3000),SB1(3000),SB(3000),SB2(3000) DIMENSION SG(3000),SV(3000),SV1(3000) DATA EBVI/0.,.1,.2,.3,.4,.5,.6,.8,1.,2.,3.,4.,5./ DATA NU,NB1,NB,NB2,NV1,NV,NG/1000,1500,2800,2300,1600,1900,1500/ DATA UFILT/.0000,.0000,.0445,.0889,.2216,.3495,.4550,.4956,.4547, 1 .2782,.0599,.0000,.0000/ DATA UWAVE/2900.,3000.,3050.,3100.,3200.,3300.,3400.,3500.,3600., 1 3700.,3800.,3840.,3900./ DATA B1FILT/.0000,.0000,.0022,.0200,.0593,.2351,.4159,.4691,.3896, 1 .2160,.1124,.0499,.0197,.0074,.0035,.0000,.0000/ DATA B1WAVE/3400.,3500.,3600.,3650.,3700.,3800.,3900.,4000.,4100., 1 4200.,4300.,4400.,4500.,4600.,4700.,4800.,4900./ DATA BFILT/.0000,.0000,.0200,.0649,.2411,.4444,.5591,.5966,.5894, 1.5434,.4755,.4087,.3386,.2321,.1224,.0561,.0224,.0061,.0000,.0000/ DATA BWAVE/3500.,3600.,3650.,3700.,3800.,3900.,4000.,4100.,4200., 14300.,4400.,4500.,4600.,4700.,4800.,4900.,5000.,5100.,5200.,5300./ DATA B2FILT/.0000,.0000,.0120,.0300,.0645,.1988,.2810,.2704,.2130, 1 .1238,.0485,.0151,.0032,.0000,.0000/ DATA B2WAVE/3900.,4000.,4100.,4150.,4200.,4300.,4400.,4500.,4600., 1 4700.,4800.,4900.,5000.,5100.,5200./ DATA V1FILT/.0000,.0000,.0350,.1084,.3146,.3477,.3085,.2475,.1800, 1 .1165,.0641,.0297,.0117,.0036,.0010,.0003,.0000,.0000/ DATA V1WAVE/4900.,5000.,5050.,5100.,5200.,5300.,5400.,5500.,5600., 1 5700.,5800.,5900.,6000.,6100.,6200.,6300.,6400.,6500./ DATA VFILT/.0000,.0000,.0464,.1661,.2858,.4329,.4638,.4482,.4073, 1 .3556,.2985,.2394,.1825,.1306,.0872,.0528,.0283,.0129,.0047, 2 .0007,.0000,.0000/ DATA VWAVE/4900.,4930.,5000.,5050.,5100.,5200.,5300.,5400.,5500., 1 5600.,5700.,5800.,5900.,6000.,6100.,6200.,6300.,6400.,6500., 2 6600.,6700.,6800./ DATA GFILT/.0000,.0000,.0250,.0673,.2525,.2830,.2397,.1838,.1323, 1 .0879,.0535,.0287,.0131,.0047,.0007,.0000,.0000/ DATA GWAVE/5300.,5400.,5450.,5500.,5600.,5700.,5800.,5900.,6000., 1 6100.,6200.,6300.,6400.,6500.,6600.,6700.,6800./ 77 FORMAT(10E12.4) DO 12 I=1,3000 WAVEU(I)=UWAVE(1)+I WAVEB1(I)=B1WAVE(1)+I WAVEB(I)=BWAVE(1)+I WAVEB2(I)=B2WAVE(1)+I WAVEV1(I)=V1WAVE(1)+I WAVEV(I)=VWAVE(1)+I 12 WAVEG(I)=GWAVE(1)+I CALL PINTER(UWAVE,UFILT,13,WAVEU,SU,NU) CALL PINTER(B1WAVE,B1FILT,17,WAVEB1,SB1,NB1) CALL PINTER(BWAVE,BFILT,20,WAVEB,SB,NB) CALL PINTER(B2WAVE,B2FILT,16,WAVEB2,SB2,NB2) CALL PINTER(V1WAVE,V1FILT,17,WAVEV1,SV1,NV1) CALL PINTER(VWAVE,VFILT,22,WAVEV,SV,NV) CALL PINTER(GWAVE,GFILT,18,WAVEG,SG,NG) UNORM=0. DO 315 I=1,NU 315 UNORM=UNORM+MAX(SU(I),0.) UNORM=UNORM*.1 B1NORM=0. DO 316 I=1,NB1 316 B1NORM=B1NORM+MAX(SB1(I),0.) B1NORM=B1NORM*.1 BNORM=0. DO 317 I=1,NB 317 BNORM=BNORM+MAX(SB(I),0.) BNORM=BNORM*.1 B2NORM=0. DO 318 I=1,NB2 318 B2NORM=B2NORM+MAX(SB2(I),0.) B2NORM=B2NORM*.1 V1NORM=0. DO 319 I=1,NV1 319 V1NORM=V1NORM+MAX(SV1(I),0.) V1NORM=V1NORM*.1 VNORM=0. DO 320 I=1,NV 320 VNORM=VNORM+MAX(SV(I),0.) VNORM=VNORM*.1 GNORM=0. DO 321 I=1,NG 321 GNORM=GNORM+MAX(SG(I),0.) GNORM=GNORM*.1 UNOMAG=-2.5*ALOG10(UNORM) B1NOMAG=-2.5*ALOG10(B1NORM) BNOMAG=-2.5*ALOG10(BNORM) B2NOMAG=-2.5*ALOG10(B2NORM) V1NOMAG=-2.5*ALOG10(V1NORM) VNOMAG=-2.5*ALOG10(VNORM) GNOMAG=-2.5*ALOG10(GNORM) C C CSDSC GRID [+0.0] VTURB 2.0 KM/S L/H 1.25 READ(1,5)ABUND,VTURB,CONVEC 5 FORMAT(12X,F4.1,8X,F4.1,11X,F5.2) DO 616 ISKIP=1,21 616 READ(1,1) C wavelength in nm READ(1,1)WAVE 1 FORMAT(8F10.2) C WAVELENGTH IN A DO 350 I=1,1221 350 WAVE(I)=WAVE(I)*10. RV=3.1 EBV=.1 C CALL REDDENING(WAVE,RV,EBV,AMAG) READ(2,344) READ(2,344) DO 366 I=1,1221 366 READ(2,344) READ(2,344) EBVI(1)=0. READ(2,344)(EBVI(IRED),IRED=2,13) 344 FORMAT(10X,12F10.1) DO 367 I=1,1221 TRANSI(1,I)=1. READ(2,359)(TRANSI(IRED,I),IRED=2,13) 359 FORMAT(13X,12E10.3) 367 CONTINUE WRITE(6,6) WRITE(7,6) WRITE(8,6) 6 FORMAT(' Teff logg [M] Vturb l/H E(B-V)', 1' U B1 B B2 V1 V G', 2' U-B V-B B1-B B2-B V1-B G-B BC') C DO 1000 NMODEL=1,2 DO 1000 NMODEL=1,1000 C ergs/cm**2/s/hz/ster READ(1,2,END=9)TITLE 2 FORMAT(A80) PRINT 713,MODEL,TITLE 713 FORMAT(I5,1X,A80) READ(TITLE,'(5X,I6,10X,F8.5)')ITEFF,GLOG C ergs/cm**2/s/hz/ster READ(1,4)Hnu READ(1,4)HnuCONT 4 FORMAT(8E10.4) NNU=1221 DO 900 IRED=1,13 DO 715 I=1,1221 FREQ=2.99792458E17/WAVE(I)*10. 715 HLAM(I)=HNU(I)*FREQ/WAVE(I)*TRANSI(IRED,I) CALL LINTER(WAVE,HLAM,NNU,WAVEU,F,NU) UF=0. DO 322 I=1,NU 322 UF=UF+SU(I)*F(I) UF=UF*.1 CALL LINTER(WAVE,HLAM,NNU,WAVEB1,F,NB1) B1F=0. DO 323 I=1,NB1 323 B1F=B1F+SB1(I)*F(I) B1F=B1F*.1 CALL LINTER(WAVE,HLAM,NNU,WAVEB,F,NB) BF=0. DO 324 I=1,NB 324 BF=BF+SB(I)*F(I) BF=BF*.1 CALL LINTER(WAVE,HLAM,NNU,WAVEB2,F,NB2) B2F=0. DO 325 I=1,NB2 325 B2F=B2F+SB2(I)*F(I) B2F=B2F*.1 CALL LINTER(WAVE,HLAM,NNU,WAVEV1,F,NV1) V1F=0. DO 326 I=1,NV1 326 V1F=V1F+SV1(I)*F(I) V1F=V1F*.1 CALL LINTER(WAVE,HLAM,NNU,WAVEV,F,NV) VF=0. DO 327 I=1,NV 327 VF=VF+SV(I)*F(I) VF=VF*.1 CALL LINTER(WAVE,HLAM,NNU,WAVEG,F,NG) GF=0. DO 328 I=1,NG 328 GF=GF+SG(I)*F(I) GF=GF*.1 UMAG=-2.5*ALOG10(UF) B1MAG=-2.5*ALOG10(B1F) BMAG=-2.5*ALOG10(BF) B2MAG=-2.5*ALOG10(B2F) V1MAG=-2.5*ALOG10(V1F) VMAG=-2.5*ALOG10(VF) GMAG=-2.5*ALOG10(GF) UMAG=UMAG-UNOMAG B1MAG=B1MAG-B1NOMAG BMAG=BMAG-BNOMAG B2MAG=B2MAG-B2NOMAG V1MAG=V1MAG-V1NOMAG VMAG=VMAG-VNOMAG GMAG=GMAG-GNOMAG UMINB=UMAG-BMAG VMINB=VMAG-BMAG B1MINB=B1MAG-BMAG B2MINB=B2MAG-BMAG V1MINB=V1MAG-BMAG GMINB=GMAG-BMAG C NORMALIZATION TO 9550,3.95,2,-0.5=VEGA C U-B V-B B1-B B2-B V1-B G-B C 0.751 0.666 -0.042 0.067 0.617 0.850 C C OBSERVED U-B V-B B1-B B2-B V1-B G-B C 1.505 .959 .900 1.510 1.662 2.168 UMINB=UMINB+0.754 VMINB=VMINB+0.293 B1MINB=B1MINB+0.942 B2MINB=B2MINB+1.443 V1MINB=V1MINB+1.045 GMINB=GMINB+1.318 XSCALE=ABUND TEFF=ITEFF BOL=-2.5*ALOG10(5.66956E-5/3.14159*TEFF**4) BC=VMAG-BOL C SMALLEST BC IS DEFINED TO BE 0 7250,0.5,[+0.0],2KM/S BC=BC-10.986 BC=-BC c actually l/h xh=CONVEC if(ItEFF.GE.9000)xh=0. WRITE(6,60)NMODEL,ITEFF,GLOG,XSCALE,VTURB,XH,EBVI(IRED), 1UMAG,B1MAG,BMAG,B2MAG,V1MAG,VMAG,GMAG,UMINB,VMINB,B1MINB, 2B2MINB,V1MINB,GMINB,BC WRITE(7,60)NMODEL,ITEFF,GLOG,XSCALE,VTURB,XH,EBVI(IRED), 1UMAG,B1MAG,BMAG,B2MAG,V1MAG,VMAG,GMAG,UMINB,VMINB,B1MINB, 2B2MINB,V1MINB,GMINB,BC IF(IRED.EQ.1) 1WRITE(8,60)NMODEL,ITEFF,GLOG,XSCALE,VTURB,XH,EBVI(IRED), 2UMAG,B1MAG,BMAG,B2MAG,V1MAG,VMAG,GMAG,UMINB,VMINB,B1MINB, 3B2MINB,V1MINB,GMINB,BC 60 FORMAT(I4,I5,5F5.2,7F7.3,F7.3,6F7.3) 900 CONTINUE 1000 CONTINUE 9 CALL EXIT END SUBROUTINE LINTER(XOLD,YOLD,NOLD,XNEW,YNEW,NNEW) DIMENSION XOLD(1),YOLD(1),XNEW(1),YNEW(1) C XOLD AND XNEW INCREASING IOLD=2 DO 2 INEW=1,NNEW 1 IF(XNEW(INEW).LT.XOLD(IOLD))GO TO 2 IF(IOLD.EQ.NOLD)GO TO 2 IOLD=IOLD+1 GO TO 1 2 YNEW(INEW)=YOLD(IOLD-1)+(YOLD(IOLD)-YOLD(IOLD-1))/ 1(XOLD(IOLD)-XOLD(IOLD-1))*(XNEW(INEW)-XOLD(IOLD-1)) RETURN END SUBROUTINE PINTER(XOLD,FOLD,NOLD,XNEW,FNEW,NNEW) DIMENSION XOLD(1),FOLD(1),XNEW(1),FNEW(1) L=2 LL=0 DO 50 K=1,NNEW 10 IF(XNEW(K).LT.XOLD(L))GO TO 20 L=L+1 IF(L.GT.NOLD)GO TO 30 GO TO 10 20 IF(L.EQ.LL)GO TO 50 IF(L.EQ.2)GO TO 30 L1=L-1 IF(L.GT.LL+1.OR.L.EQ.3)GO TO 21 CBAC=CFOR BBAC=BFOR ABAC=AFOR IF(L.EQ.NOLD)GO TO 22 GO TO 25 21 L2=L-2 D=(FOLD(L1)-FOLD(L2))/(XOLD(L1)-XOLD(L2)) CBAC=FOLD(L)/((XOLD(L)-XOLD(L1))*(XOLD(L)-XOLD(L2)))+ 1(FOLD(L2)/(XOLD(L)-XOLD(L2))-FOLD(L1)/(XOLD(L)-XOLD(L1)))/ 2(XOLD(L1)-XOLD(L2)) BBAC=D-(XOLD(L1)+XOLD(L2))*CBAC ABAC=FOLD(L2)-XOLD(L2)*D+XOLD(L1)*XOLD(L2)*CBAC IF(L.LT.NOLD)GO TO 25 22 C=CBAC B=BBAC A=ABAC LL=L GO TO 50 25 D=(FOLD(L)-FOLD(L1))/(XOLD(L)-XOLD(L1)) CFOR=FOLD(L+1)/((XOLD(L+1)-XOLD(L))*(XOLD(L+1)-XOLD(L1)))+ 1(FOLD(L1)/(XOLD(L+1)-XOLD(L1))-FOLD(L)/(XOLD(L+1)-XOLD(L)))/ 2(XOLD(L)-XOLD(L1)) BFOR=D-(XOLD(L)+XOLD(L1))*CFOR AFOR=FOLD(L1)-XOLD(L1)*D+XOLD(L)*XOLD(L1)*CFOR WT=0. IF(ABS(CFOR).NE.0.)WT=ABS(CFOR)/(ABS(CFOR)+ABS(CBAC)) A=AFOR+WT*(ABAC-AFOR) B=BFOR+WT*(BBAC-BFOR) C=CFOR+WT*(CBAC-CFOR) LL=L GO TO 50 30 IF(L.EQ.LL)GO TO 50 L=AMIN0(NOLD,L) C=0. B=(FOLD(L)-FOLD(L-1))/(XOLD(L)-XOLD(L-1)) A=FOLD(L)-XOLD(L)*B LL=L 50 FNEW(K)=A+(B+C*XNEW(K))*XNEW(K) MAP1=LL-1 RETURN END