PROGRAM RIJKL IMPLICIT REAL*4 (A-Z) DIMENSION HLAM(1221),WAVE(1221),HNU(1221),HNUCONT(1221) DIMENSION AMAGI(13,1221),TRANSI(13,1221),EBVI(13),AMAG(1221) CHARACTER*80 TITLE INTEGER I,NR,NI,NJ,NK,NL,MODEL,MODEL1,MODEL2,NSKIP,NMODEL,ITEFF,NV INTEGER NU,IRED DIMENSION A(8) DIMENSION F(13000) DIMENSION VFILT(54),VWAVE(54) DIMENSION RFILT(23),IFILT(27),JFILT(32),KFILT(18),LFILT(15) DIMENSION RWAVE(23),IWAVE(27),JWAVE(32),KWAVE(18),LWAVE(15) C DIMENSION WAVER(880),WAVEI(1040),WAVEJ(1200),WAVEK(1600) C DIMENSION WAVEL(2600),WAVEV(2700) DIMENSION WAVER(4400),WAVEI(5200),WAVEJ(6000),WAVEK(8000) DIMENSION WAVEL(13000),WAVEV(2700) C DIMENSION SR(880),SI(1040),SJ(1200),SK(1600),SL(2600),SV(2700) DIMENSION SR(4400),SI(5200),SJ(6000),SK(8000),SL(13000),SV(2700) C DATA EBVI/0.,.1,.2,.3,.4,.5,.6,.7,.8,.9,1./ DATA EBVI/0.,.1,.2,.3,.4,.5,.6,.8,1.,2.,3.,4.,5./ C DATA NV,NR,NI,NJ,NK,NL/2700,880,1040,1200,1600,2600/ DATA NV,NR,NI,NJ,NK,NL/2700,4400,5200,6000,8000,13000/ DATAVFILT/0.,.030,.084,.163,.301,.458,.630,.780,.895,.967,.997,1., 1 .988,.958,.919,.877,.819,.765,.711,.657,.602,.545,.488,.434,.386, 2 .331,.289,.250,.214,.181,.151,.120,.093,.069,.051,.036,.027,.021, 3 .018,.016,.014,.012,.011,.010,.009,.008,.007,.006,.005,.004,.003, 4 .002,.001,.000/ DATA RFILT/.00,.06,.28,.50,.69,.79,.88,.94,.98,1.,.94,.85,.73, 1 .57,.42,.31,.17,.11,.06,.04,.02,.01,.00/ DATA IFILT/.00,.01,.17,.36,.56,.76,.96,.98,.99,1.,.98,.93,.84, 1 .71,.58,.47,.36,.28,.20,.15,.10,.08,.05,.03,.02,.01,.00/ DATA JFILT/.00,.02,.03,.06,.16,.35,.62,.93,.85,.78,.78,.80,.85, 1 .93,.75,.64,.63,.63,.66,.68,.70,.70,.66,.60,.46,.27,.14,.09,.06, 2 .02,.01,.00/ DATA KFILT/.00,.10,.48,.95,1.,.98,.96,.95,.97,.96,.94,.95,.95, 1 .84,.46,.08,.04,.00/ DATA LFILT/.0,.14,.68,.95,1.,1.,.98,.85,.69,.39,.21,.1,.02,.01,.0/ DATA VWAVE/475.,480.,485.,490.,495.,500.,505.,510.,515.,520.,525., 1 530.,535.,540.,545.,550.,555.,560.,565.,570.,575.,580.,585.,590., 2 595.,600.,605.,610.,615.,620.,625.,630.,635.,640.,645.,650.,655., 3 660.,665.,670.,675.,680.,685.,690.,695.,700.,705.,710.,715.,720., 4 725.,730.,735.,740./ DATA RWAVE/520.,540.,560.,580.,600.,620.,640.,660.,680.,700., 1 720.,740.,760.,780.,800.,820.,840.,860.,880.,900.,920.,940.,960./ DATA IWAVE/680.,700.,720.,740.,760.,780.,800.,820.,840.,860., 1 880.,900.,920.,940.,960.,980.,1000.,1020.,1040.,1060.,1080., 2 1100.,1120.,1140.,1160.,1180.,1200./ DATA JWAVE/960.,980.,1000.,1020.,1040.,1060.,1080.,1100.,1120., 1 1140.,1160.,1180.,1200.,1220.,1240.,1260.,1280.,1300.,1320., 2 1340.,1360.,1380.,1400.,1420.,1440.,1460.,1480.,1500.,1520., 3 1540.,1550.,1560./ DATA KWAVE/1800.,1850.,1900.,1950.,2000.,2050.,2100.,2150.,2200., 1 2250.,2300.,2350.,2400.,2450.,2500.,2550.,2575.,2600./ DATA LWAVE/2900.,3000.,3100.,3200.,3300.,3400.,3500.,3600.,3700., 2 3800.,3900.,4000.,4100.,4150.,4200./ 77 FORMAT(10E12.4) C PRINT 77,RFILT C PRINT 77,IFILT C PRINT 77,JFILT C PRINT 77,KFILT C PRINT 77,LFILT C PRINT 77,RWAVE C PRINT 77,IWAVE C PRINT 77,JWAVE C PRINT 77,KWAVE C PRINT 77,LWAVE DO 312 I=1,NV 312 WAVEV(I)=470.+FLOAT(I)*.1 DO 12 I=1,NR 12 WAVER(I)=520.+FLOAT(I)*.1 DO 13 I=1,NI 13 WAVEI(I)=680.+FLOAT(I)*.1 DO 14 I=1,NJ 14 WAVEJ(I)=960.+FLOAT(I)*.1 DO 114 I=1,NK 114 WAVEK(I)=1800.+FLOAT(I)*.1 DO 214 I=1,NL 214 WAVEL(I)=2900.+FLOAT(I)*.1 CALL PINTER(VWAVE,VFILT,54,WAVEV,SV,NV) CALL PINTER(RWAVE,RFILT,23,WAVER,SR,NR) CALL PINTER(IWAVE,IFILT,27,WAVEI,SI,NI) CALL PINTER(JWAVE,JFILT,32,WAVEJ,SJ,NJ) CALL PINTER(KWAVE,KFILT,18,WAVEK,SK,NK) CALL PINTER(LWAVE,LFILT,15,WAVEL,SL,NL) C PRINT 77,SR C PRINT 77,SI C PRINT 77,SJ C PRINT 77,SK C PRINT 77,SL VNORM=0. C IN CASE OF BAD INTERPOLATION DO 314 I=1,50 314 SV(I)=0. DO 315 I=1,NV 315 VNORM=VNORM+SV(I) VNORM=VNORM*.1 RNORM=0. DO 15 I=1,NR 15 RNORM=RNORM+SR(I) RNORM=RNORM*.1 INORM=0. DO 16 I=1,NI 16 INORM=INORM+SI(I) INORM=INORM*.1 JNORM=0. DO 17 I=1,NJ 17 JNORM=JNORM+SJ(I) JNORM=JNORM*.1 KNORM=0. DO 117 I=1,NK 117 KNORM=KNORM+SK(I) KNORM=KNORM*.1 LNORM=0. DO 217 L=1,NL 217 LNORM=LNORM+SL(I) LNORM=LNORM*.1 VNOMAG=-2.5*ALOG10(VNORM) RNOMAG=-2.5*ALOG10(RNORM) INOMAG=-2.5*ALOG10(INORM) JNOMAG=-2.5*ALOG10(JNORM) KNOMAG=-2.5*ALOG10(KNORM) LNOMAG=-2.5*ALOG10(LNORM) 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) RV=3.1 EBV=.1 C CALL REDDENING(WAVE,RV,EBV,AMAG) READ(2,344) READ(2,344) DO 366 NU=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 NU=1,1221 TRANSI(1,NU)=1. READ(2,359)(TRANSI(IRED,NU),IRED=2,13) 359 FORMAT(13X,12E10.3) 367 CONTINUE WRITE(6,6) WRITE(7,6) WRITE(8,6) 6 FORMAT(' Teff log g [M] Vturb l/H E(B-V)', 1' V R I J K L', 2' V-R V-I V-J V-K V-L') 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 NU=1,1221 FREQ=2.99792458E17/WAVE(NU) 715 HLAM(NU)=HNU(NU)*FREQ/WAVE(NU)*TRANSI(IRED,NU) C PRINT 77,(WAVE(I),HLAM(I),I=1,NNU) CALL LINTER(WAVE,HLAM,NNU,WAVEV,F,NV) C PRINT 77,F VF=0. DO 322 I=1,NV 322 VF=VF+SV(I)*F(I) VF=VF*.1 C PRINT 77,VF CALL LINTER(WAVE,HLAM,NNU,WAVER,F,NR) C PRINT 77,F RF=0. DO 22 I=1,NR 22 RF=RF+SR(I)*F(I) RF=RF*.1 C PRINT 77,RF CALL LINTER(WAVE,HLAM,NNU,WAVEI,F,NI) C PRINT 77,F IF=0. DO 32 I=1,NI 32 IF=IF+SI(I)*F(I) IF=IF*.1 C PRINT 77,IF CALL LINTER(WAVE,HLAM,NNU,WAVEJ,F,NJ) C PRINT 77,F JF=0. DO 42 I=1,NJ 42 JF=JF+SJ(I)*F(I) JF=JF*.1 CALL LINTER(WAVE,HLAM,NNU,WAVEK,F,NK) C PRINT 77,F KF=0. DO 142 I=1,NK 142 KF=KF+SK(I)*F(I) KF=KF*.1 CALL LINTER(WAVE,HLAM,NNU,WAVEL,F,NL) C PRINT 77,F LF=0. DO 242 I=1,NL 242 LF=LF+SL(I)*F(I) LF=LF*.1 VMAG=-2.5*ALOG10(VF) RMAG=-2.5*ALOG10(RF) IMAG=-2.5*ALOG10(IF) JMAG=-2.5*ALOG10(JF) KMAG=-2.5*ALOG10(KF) LMAG=-2.5*ALOG10(LF) C PRINT 77,RNORM,INORM,JNORM,KNORM,LNORM C PRINT 77,RNOMAG,INOMAG,JNOMAG,KNOMAG,LNOMAG C PRINT 77,RMAG,IMAG,JMAG,KMAG,LMAG VMAG=VMAG-VNOMAG RMAG=RMAG-RNOMAG IMAG=IMAG-INOMAG JMAG=JMAG-JNOMAG KMAG=KMAG-KNOMAG LMAG=LMAG-LNOMAG VMINR=VMAG-RMAG VMINI=VMAG-IMAG VMINJ=VMAG-JMAG VMINK=VMAG-KMAG VMINL=VMAG-LMAG C NORMALIZATION TO 9550,3.95,2,-0.5=VEGA ALL COLORS 0.000 VMINR=VMINR+0.717 VMINI=VMINI+1.488 VMINJ=VMINJ+2.651 VMINK=VMINK+4.850 VMINL=VMINL+6.962 XSCALE=ABUND c actually l/h xh=CONVEC if(ItEFF.GE.9000)xh=0. WRITE(6,60)NMODEL,ITEFF,GLOG,XSCALE,VTURB,XH,EBVI(IRED), 1VMAG,RMAG,IMAG,JMAG,KMAG,LMAG,VMINR,VMINI,VMINJ,VMINK,VMINL WRITE(7,60)NMODEL,ITEFF,GLOG,XSCALE,VTURB,XH,EBVI(IRED), 1VMAG,RMAG,IMAG,JMAG,KMAG,LMAG,VMINR,VMINI,VMINJ,VMINK,VMINL IF(IRED.EQ.1) 1WRITE(8,60)NMODEL,ITEFF,GLOG,XSCALE,VTURB,XH,EBVI(IRED), 2VMAG,RMAG,IMAG,JMAG,KMAG,LMAG,VMINR,VMINI,VMINJ,VMINK,VMINL 60 FORMAT(I6,I6,5F6.2,11F8.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