PROGRAM VILNIUS DIMENSION HLAM(1221),WAVE(1221),HNU(1221),HNUCONT(1221) CHARACTER*80 TITLE DIMENSION AMAGI(13,1221),TRANSI(13,1221),EBVI(13),AMAG(1221) 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./ DIMENSION A(8) DIMENSION F(1300) DIMENSION UFILT(18),UWAVE(18),WAVEU(850),SU(850) DIMENSION PFILT(15),PWAVE(15),WAVEP(700),SP(700) DIMENSION XFILT(19),XWAVE(19),WAVEX(900),SX(900) DIMENSION YFILT(17),YWAVE(17),WAVEY(800),SY(800) DIMENSION ZFILT(24),ZWAVE(24),WAVEZ(1150),SZ(1150) DIMENSION VFILT(19),VWAVE(19),WAVEV(900),SV(900) DIMENSION TFILT(20),TWAVE(20),WAVET(950),ST(950) DIMENSION SFILT(19),SWAVE(19),WAVES(900),SS(900) 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./ DATA UWAVE/ 1 300. ,305. ,310. ,315. ,320. ,325. ,330. ,335. ,340. ,345. , 2 350. ,355. ,360. ,365. ,370. ,375. ,380. ,385. / DATA UFILT/ 1 0.000,0.017,0.073,0.173,0.318,0.492,0.670,0.832,0.938,0.994, 2 1.000,0.911,0.754,0.514,0.246,0.084,0.017,0.000/ DATA PWAVE/ 1 340. ,345. ,350. ,355. ,360. ,365. ,370. ,375. ,380. ,385. , 2 390. ,395. ,400. ,405. ,410. / DATA PFILT/ 1 0.000,0.025,0.089,0.240,0.464,0.717,0.920,1.000,0.932,0.675, 2 0.346,0.105,0.025,0.008,0.000/ DATA XWAVE/ 1 370. ,375. ,380. ,385. ,390. ,395. ,400. ,405. ,410. ,415. , 2 420. ,425. ,430. ,435. ,440. ,445. ,450. ,455. ,460. / DATA XFILT/ 1 0.000,0.026,0.084,0.195,0.385,0.615,0.850,1.000,0.929,0.496, 2 0.172,0.075,0.040,0.035,0.049,0.066,0.044,0.022,0.000/ DATA YWAVE/ 1 440. ,445. ,450. ,455. ,460. ,465. ,470. ,475. ,480. ,485. , 2 490. ,495. ,500. ,505. ,510. ,515. ,520. / DATA YFILT/ 1 0.000,0.111,0.544,0.916,1.000,0.909,0.718,0.523,0.359,0.226, 2 0.146,0.098,0.063,0.045,0.028,0.018,0.000/ DATA ZWAVE/ 1 460. ,465. ,470. ,475. ,480. ,485. ,490. ,495. ,500. ,505. , 2 510. ,515. ,520. ,525. ,530. ,535. ,540. ,545. ,550. ,555. , 3 560. ,565. ,570. ,575. / DATA ZFILT/ 1 0.000,0.006,0.008,0.011,0.014,0.014,0.022,0.053,0.200,0.538, 2 0.891,1.000,0.858,0.574,0.231,0.056,0.022,0.014,0.025,0.036, 3 0.031,0.022,0.011,0.000/ DATA VWAVE/ 1 505. ,510. ,515. ,520. ,525. ,530. ,535. ,540. ,545. ,550. , 2 555. ,560. ,565. ,570. ,575. ,580. ,585. ,590. ,595. / DATA VFILT/ 1 0.000,0.005,0.038,0.144,0.312,0.471,0.702,1.000,0.986,0.812, 2 0.606,0.409,0.240,0.072,0.019,0.014,0.010,0.005,0.000/ DATA TWAVE/ 1 580. ,585. ,590. ,595. ,600. ,605. ,610. ,615. ,620. ,625. , 2 630. ,635. ,640. ,645. ,650. ,655. ,660. ,665. ,670. ,675. / DATA TFILT/ 1 0.000,0.003,0.007,0.012,0.020,0.054,0.148,0.537,0.907,1.000, 2 0.880,0.457,0.175,0.060,0.034,0.023,0.013,0.010,0.005,0.000/ DATA SWAVE/ 1 615. ,620. ,625. ,630. ,635. ,640. ,645. ,650. ,655. ,660. , 2 665. ,670. ,675. ,680. ,685. ,690. ,695. ,700. ,705. / DATA SFILT/ 1 0.000,0.005,0.010,0.021,0.046,0.124,0.413,0.813,1.000,0.874, 2 0.520,0.166,0.058,0.022,0.011,0.005,0.002,0.001,0.000/ DATA MU,MP,MX,MY,MZ,MV,MT,MS/18,15,19,17,24,19,20,19/ DATA NU,NP,NX,NY,NZ,NV,NT,NS/850,700,900,800,1150,900,950,900/ 77 FORMAT(10E12.4) DO 301 I=1,NU 301 WAVEU(I)=UWAVE(1)+FLOAT(I)*.1 DO 302 I=1,NP 302 WAVEP(I)=PWAVE(1)+FLOAT(I)*.1 DO 303 I=1,NX 303 WAVEX(I)=XWAVE(1)+FLOAT(I)*.1 DO 304 I=1,NY 304 WAVEY(I)=YWAVE(1)+FLOAT(I)*.1 DO 305 I=1,NZ 305 WAVEZ(I)=ZWAVE(1)+FLOAT(I)*.1 DO 306 I=1,NV 306 WAVEV(I)=VWAVE(1)+FLOAT(I)*.1 DO 307 I=1,NT 307 WAVET(I)=TWAVE(1)+FLOAT(I)*.1 DO 308 I=1,NS 308 WAVES(I)=SWAVE(1)+FLOAT(I)*.1 CALL PINTER(UWAVE,UFILT,MU,WAVEU,SU,NU) CALL PINTER(PWAVE,PFILT,MP,WAVEP,SP,NP) CALL PINTER(XWAVE,XFILT,MX,WAVEX,SX,NX) CALL PINTER(YWAVE,YFILT,MY,WAVEY,SY,NY) CALL PINTER(ZWAVE,ZFILT,MZ,WAVEZ,SZ,NZ) CALL PINTER(VWAVE,VFILT,MV,WAVEV,SV,NV) CALL PINTER(TWAVE,TFILT,MT,WAVET,ST,NT) CALL PINTER(SWAVE,SFILT,MS,WAVES,SS,NS) UNORM=0. DO 311 I=1,NU C IN CASE OF NEGATIVE VALUES FROM BAD INTERPOLATION 311 UNORM=UNORM+MAX(SU(I),0.) C CONVERT TO NM INSTEAD OF ANGSTROMS UNORM=UNORM*.1 PNORM=0. DO 312 I=1,NP 312 PNORM=PNORM+MAX(SP(I),0.) PNORM=PNORM*.1 XNORM=0. DO 313 I=1,NX 313 XNORM=XNORM+MAX(SX(I),0.) XNORM=XNORM*.1 YNORM=0. DO 314 I=1,NY 314 YNORM=YNORM+MAX(SY(I),0.) YNORM=YNORM*.1 ZNORM=0. DO 315 I=1,NZ 315 ZNORM=ZNORM+MAX(SZ(I),0.) ZNORM=ZNORM*.1 VNORM=0. DO 316 I=1,NV 316 VNORM=VNORM+MAX(SV(I),0.) VNORM=VNORM*.1 TNORM=0. DO 317 I=1,NT 317 TNORM=TNORM+MAX(ST(I),0.) TNORM=TNORM*.1 SNORM=0. DO 318 I=1,NS 318 SNORM=SNORM+MAX(SS(I),0.) SNORM=SNORM*.1 UNOMAG=-2.5*ALOG10(UNORM) PNOMAG=-2.5*ALOG10(PNORM) XNOMAG=-2.5*ALOG10(XNORM) YNOMAG=-2.5*ALOG10(YNORM) ZNOMAG=-2.5*ALOG10(ZNORM) VNOMAG=-2.5*ALOG10(VNORM) TNOMAG=-2.5*ALOG10(TNORM) SNOMAG=-2.5*ALOG10(SNORM) 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 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 P X Y Z V T S ', 2' U-P P-X X-Y Y-Z Z-V V-S T-S') 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) 715 HLAM(I)=HNU(I)*FREQ/WAVE(I)*TRANSI(IRED,I) C PRINT 77,(WAVE(I),HLAM(I),I=1,NNU) C CALL LINTER(WAVE,HLAM,NNU,WAVEU,F,NU) UFLUX=0. DO 321 I=1,NU 321 UFLUX=UFLUX+SU(I)*F(I) UFLUX=UFLUX*.1 CALL LINTER(WAVE,HLAM,NNU,WAVEP,F,NP) PFLUX=0. DO 322 I=1,NP 322 PFLUX=PFLUX+SP(I)*F(I) PFLUX=PFLUX*.1 CALL LINTER(WAVE,HLAM,NNU,WAVEX,F,NX) XFLUX=0. DO 323 I=1,NX 323 XFLUX=XFLUX+SX(I)*F(I) XFLUX=XFLUX*.1 CALL LINTER(WAVE,HLAM,NNU,WAVEY,F,NY) YFLUX=0. DO 324 I=1,NY 324 YFLUX=YFLUX+SY(I)*F(I) YFLUX=YFLUX*.1 CALL LINTER(WAVE,HLAM,NNU,WAVEZ,F,NZ) ZFLUX=0. DO 325 I=1,NZ 325 ZFLUX=ZFLUX+SZ(I)*F(I) ZFLUX=ZFLUX*.1 CALL LINTER(WAVE,HLAM,NNU,WAVEV,F,NV) VFLUX=0. DO 326 I=1,NV 326 VFLUX=VFLUX+SV(I)*F(I) VFLUX=VFLUX*.1 CALL LINTER(WAVE,HLAM,NNU,WAVET,F,NT) TFLUX=0. DO 327 I=1,NT 327 TFLUX=TFLUX+ST(I)*F(I) TFLUX=TFLUX*.1 CALL LINTER(WAVE,HLAM,NNU,WAVES,F,NS) SFLUX=0. DO 328 I=1,NU 328 SFLUX=SFLUX+SS(I)*F(I) SFLUX=SFLUX*.1 UMAG=-2.5*ALOG10(UFLUX) PMAG=-2.5*ALOG10(PFLUX) XMAG=-2.5*ALOG10(XFLUX) YMAG=-2.5*ALOG10(YFLUX) ZMAG=-2.5*ALOG10(ZFLUX) VMAG=-2.5*ALOG10(VFLUX) TMAG=-2.5*ALOG10(TFLUX) SMAG=-2.5*ALOG10(SFLUX) UMAG=UMAG-UNOMAG PMAG=PMAG-PNOMAG XMAG=XMAG-XNOMAG YMAG=YMAG-YNOMAG ZMAG=ZMAG-ZNOMAG VMAG=VMAG-VNOMAG TMAG=TMAG-TNOMAG SMAG=SMAG-SNOMAG UMINP=UMAG-PMAG PMINX=PMAG-XMAG XMINY=XMAG-YMAG YMINZ=YMAG-ZMAG ZMINV=ZMAG-VMAG VMINS=VMAG-SMAG TMINS=TMAG-SMAG CC NORMALIZATION TO 30000,4.00,[+0.0],2KM/S ALL COLORS 0.000 Cc U-P P-X X-Y Y-Z Z-V V-S T-S Cc 384 30000 4.00 0.00 2.00 0.00-0.293-0.211-0.525-0.399-0.213-0.778-0.210 C UMINP=UMINP+0.293 C PMINX=PMINX+0.211 C XMINY=XMINY+0.525 C YMINZ=YMINZ+0.399 C ZMINV=ZMINV+0.213 C VMINS=VMINS+0.778 C TMINS=TMINS+0.210 C C NORMALIZATION TO 9550,3.95,[-0.5],2KM/S FOR VEGA C 0.63 0.83 0.29 0.10 0.05 0.14 0.04 guess c U-P P-X X-Y Y-Z Z-V V-S T-S C 1 9550 3.95-0.50 2.00 0.00 0.00 0.326 0.528-0.253-0.314-0.168-0.686-0.227 UMINP=UMINP+.304 PMINX=PMINX+.302 XMINY=XMINY+.543 YMINZ=YMINZ+.414 ZMINV=ZMINV+.218 VMINS=VMINS+.826 TMINS=TMINS+.267 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),UMAG, 1PMAG,XMAG,YMAG,ZMAG,VMAG,TMAG,SMAG,UMINP,PMINX,XMINY,YMINZ, 2ZMINV,VMINS,TMINS WRITE(7,60)NMODEL,ITEFF,GLOG,XSCALE,VTURB,XH,EBVI(IRED),UMAG, 1PMAG,XMAG,YMAG,ZMAG,VMAG,TMAG,SMAG,UMINP,PMINX,XMINY,YMINZ, 2ZMINV,VMINS,TMINS IF(IRED.EQ.1) 1WRITE(8,60)NMODEL,ITEFF,GLOG,XSCALE,VTURB,XH,EBVI(IRED),UMAG, 2PMAG,XMAG,YMAG,ZMAG,VMAG,TMAG,SMAG,UMINP,PMINX,XMINY,YMINZ, 3ZMINV,VMINS,TMINS 60 FORMAT(I3,I6,5F5.2,8F7.3,7F6.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