pROGRAM THIRTEEN DIMENSION HLAM(1221),WAVE(1221),HNU(1221),HNUCONT(1221) DIMENSION AMAGI(13,1221),TRANSI(13,1221),EBVI(13),AMAG(1221) DIMENSION WAVEA(1221) CHARACTER*80 TITLE DIMENSION A(20) REAL NOR33,NOR35,NOR37,NOR40,NOR45,NOR52,NOR58,NOR63 REAL NOR58P,NOR72,NOR80,NOR86,NOR99,NOR110 REAL MAG33,MAG35,MAG37,MAG40,MAG45,MAG52,MAG58,MAG58P,MAG63, 1MAG72,MAG80,MAG86,MAG99,MAG110 DIMENSION S33(700),WAV33(700) DIMENSION S35(900),WAV35(900) DIMENSION S37(981),WAV37(981) DIMENSION S40(1463),WAV40(1463) DIMENSION S45(1800),WAV45(1800) DIMENSION S52(1200),WAV52(1200) DIMENSION S58(1051),WAV58(1051) DIMENSION S63(1500),WAV63(1500) DIMENSION S58P(620),WAV58P(620) DIMENSION S72(1600),WAV72(1600) DIMENSION S80(1300),WAV80(1300) DIMENSION S86(1134),WAV86(1134) DIMENSION S99(1850),WAV99(1850) DIMENSION S110(1650),WAV110(1650) C DIMENSION S110(3300),WAV110(3300) DIMENSION F(1850) DIMENSION F33(24),F35(24),F37(24),F40(26),F45(32),F52(31),F58(31) DIMENSION F63(31) DIMENSION W33(24),W35(24),W37(24),W40(26),W45(32),W52(31),W58(31) DIMENSION W63(31) DIMENSION F58P(32),F72(33),F80(27),F86(35),F99(38),F110(34) DIMENSION W58P(32),W72(33),W80(27),W86(35),W99(38),W110(34) 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 W33/3100.,3157.,3254.,3293.,3311.,3317.,3319.,3328.,3337., 1 3345.,3354.,3358.,3380.,3388.,3396.,3399.,3410.,3422.,3442., 2 3448.,3491.,3602.,3719.,3800./ DATA W35/3000.,3060.,3204.,3404.,3461.,3490.,3504.,3515.,3522., 1 3533.,3538.,3547.,3565.,3576.,3584.,3586.,3599.,3610.,3612., 2 3626.,3642.,3704.,3830.,3900./ DATA W37/3100.,3204.,3500.,3603.,3672.,3690.,3704.,3708.,3711., 1 3717.,3726.,3734.,3748.,3750.,3767.,3776.,3782.,3794.,3803., 2 3818.,3842.,3884.,3904.,4082./ DATA W40/3100.,3187.,3404.,3602.,3749.,3805.,3904.,3935.,3956., 1 3964.,3974.,3988.,4003.,4024.,4070.,4113.,4131.,4146.,4159., 2 4170.,4185.,4203.,4236.,4254.,4304.,4564./ DATA W45/3900.,4004.,4254.,4354.,4382.,4400.,4413.,4424.,4437., 1 4443.,4451.,4460.,4472.,4487.,4520.,4571.,4597.,4615.,4630., 2 4643.,4654.,4669.,4679.,4694.,4708.,4730.,4772.,4876.,4999., 3 5309.,5604.,5700./ DATA W52/4600.,4704.,4904.,5004.,5028.,5048.,5062.,5077.,5082., 1 5086.,5095.,5107.,5117.,5130.,5160.,5177.,5226.,5248.,5269., 2 5284.,5292.,5302.,5316.,5322.,5336.,5350.,5375.,5404.,5523., 3 5704.,5800./ DATA W58/5249.,5604.,5648.,5693.,5717.,5735.,5749.,5755.,5762., 1 5770.,5783.,5798.,5810.,5827.,5850.,5854.,5884.,5907.,5925., 2 5940.,5956.,5971.,5981.,5986.,6001.,6021.,6048.,6099.,6104., 3 6229.,6300./ DATA W63/6000.,6024.,6077.,6111.,6142.,6157.,6170.,6180.,6194., 1 6201.,6208.,6211.,6223.,6230.,6245.,6252.,6267.,6288.,6310., 2 6349.,6355.,6443.,6601.,6691.,6840.,6987.,7134.,7200.,7300., 3 7400.,7500./ DATA F33/0.,0.7,6.9,21.5,33.3,43.4,45.7,58.7,71.5,84.5,96.6,99.7, 1 91.4,79.3,68.7,66.9,54.2,41.1,27.7,22.8,8.8,1.2,.1,0./ DATA F35/0.,.1,2.2,8.8,19.0,28.8,38.9,48.6,59.2,69.5,79.7,89.7, 1 100.,90.5,80.5,70.4,61.0,51.2,40.7,30.8,21.0,6.0,.1,0./ DATA F37/0.,.2,2.4,6.7,22.2,33.3,44.4,47.8,55.6,66.7,77.8,88.9, 1 97.8,100.,88.9,77.8,66.7,55.6,44.4,33.3,22.2,11.1,8.9,0./ DATA F40/0.,.2,1.1,2.7,5.3,7.7,20.5,33.9,45.2,49.7,56.5,67.8,79.1, 1 90.4,100.,90.4,79.1,67.8,56.5,45.2,33.9,22.6,11.3,6.9,2.0,0./ DATA F45/0.,.1,1.0,7.1,15.9,23.8,31.7,39.7,47.6,55.6,63.5,71.4, 1 79.4,87.3,95.2,100.,95.2,87.3,79.4,71.4,63.5,55.6,47.6,39.7,31.7, 2 23.8,16.0,7.9,4.1,1.6,.5,0./ DATA F52/0.,.4,3.2,15.0,20.4,30.0,39.5,48.8,55.5,58.0,65.1,76.1, 1 84.9,92.8,99.8,99.2,96.3,91.7,81.1,70.9,62.5,54.3,46.0,37.4,30.4, 2 22.0,13.8,7.3,1.0,.2,0./ DATA F58/0.,7.7,14.6,26.4,37.4,49.4,57.1,61.7,65.5,75.3,83.1,88.8, 1 97.2,100.,96.3,95.2,80.0,66.5,54.5,45.7,36.4,29.0,23.4,21.8,16.6, 2 10.9,6.4,2.3,1.9,.2,0./ DATA F63/0.,.1,4.4,17.5,31.5,43.3,52.5,61.2,69.6,79.6,87.5,89.2, 1 90.6,96.3,98.7,99.7,96.7,96.2,90.0,81.5,77.0,47.6,21.2,8.2,5.1, 2 2.3,.8,.4,.2,.1,0./ DATA W58P/5520.,5540.,5560.,5580.,5600.,5620.,5640.,5660.,5680., 1 5700.,5720.,5740.,5760.,5780.,5800.,5820.,5840.,5860.,5880., 2 5900.,5920.,5940.,5960.,5980.,6000.,6020.,6040.,6060.,6080., 3 6100.,6120.,6140./ DATA W72/6450.,6500.,6550.,6600.,6650.,6700.,6750.,6800.,6850., 1 6900.,6950.,7000.,7050.,7100.,7150.,7200.,7250.,7300.,7350., 2 7400.,7450.,7500.,7550.,7600.,7650.,7700.,7750.,7800.,7850., 3 7900.,7950.,8000.,8050./ DATA W80/7350.,7400.,7450.,7500.,7550.,7600.,7650.,7700.,7750., 1 7800.,7850.,7900.,7950.,8000.,8050.,8100.,8150.,8200.,8250., 2 8300.,8350.,8400.,8450.,8500.,8550.,8600.,8650./ DATA W86/8033.,8067.,8100.,8133.,8167.,8200.,8233.,8267.,8300., 1 8333.,8367.,8400.,8433.,8467.,8500.,8533.,8567.,8600.,8633., 2 8667.,8700.,8733.,8767.,8800.,8833.,8867.,8900.,8933.,8967., 3 9000.,9033.,9067.,9100.,9133.,9167./ DATA W99/8900.,8950.,9000.,9050.,9100.,9150.,9200.,9250.,9300., 1 9350.,9400.,9450.,9500.,9550.,9600.,9650.,9700.,9750.,9800., 2 9850.,9900.,9950.,10000.,10050.,10100.,10150.,10200.,10250., 3 10300.,10350.,10400.,10450.,10500.,10550.,10600.,10650.,10700., 4 10750./ DATA W110/9500.,9600.,9700.,9800.,9900.,10000.,10100.,10200., 1 10300.,10400.,10500.,10600.,10700.,10800.,10900.,11000.,11100., 2 11200.,11300.,11400.,11500.,11600.,11700.,11800.,11900.,12000., 3 12100.,12200.,12300.,12400.,12500.,12600.,12700.,12800./ DATA F58P/0.,.1,.2,.3,.4,.5,.7,1.4,2.6,5.5,15.0,40.1,78.4,94.2, 1 92.6,94.0,99.5,100.,96.0,91.2,90.9,86.2,59.4,26.8,11.7,5.0,2.5, 2 1.3,.7,.2,.1,0./ DATA F72/0.,.1,.2,.4,.9,1.3,1.8,2.3,8.6,18.1,80.4,87.1,86.7,86.1, 1 89.9,96.3,100.,99.4,96.2,88.9,81.6,65.7,45.4,21.8,11.1,5.0,2.1, 2 1.3,.9,.4,.2,.1,0./ DATA F80/0.,.1,.2,.4,.8,1.5,2.6,9.0,32.2,67.5,87.6,88.7,92.9,100., 1 98.5,85.3,77.1,74.0,32.3,15.8,3.0,1.4,.8,.4,.2,.1,0./ DATA F86/.0,.1,.2,.4,.8,1.4,2.3,8.0,26.6,64.5,99.7,81.7,76.7,77.2, 1 82.4,94.3,98.8,100.,98.9,93.1,90.7,87.3,79.9,70.8,55.5,32.1,14.0, 2 6.3,3.7,1.8,.9,.4,.2,.1,0./ DATA F99/0.,.1,.2,.4,.8,1.6,2.3,2.7,4.3,7.0,10.6,23.8,39.9,72.6, 1 99.9,100.,86.5,79.4,76.9,74.3,73.2,70.7,66.1,61.5,53.1,47.4,37.1, 2 29.2,18.6,10.8,6.5,3.1,2.0,1.2,.5,.2,.1,0./ DATA F110/0.,.1,.2,.4,.8,1.6,3.2,5.0,10.6,16.0,23.1,36.3,52.3, 1 72.9,88.6,100.,96.3,78.9,66.3,48.0,36.3,28.6,21.1,17.4,13.7,10.0, 2 7.0,4.0,2.0,1.0,.5,.2,.1,0./ 77 FORMAT(10E12.4) DO 12 I=1,700 12 WAV33(I)=3100.+FLOAT(I) DO 13 I=1,900 13 WAV35(I)=3000.+FLOAT(I) DO 14 I=1,981 14 WAV37(I)=3100.+FLOAT(I) DO 15 I=1,1463 15 WAV40(I)=3100.+FLOAT(I) DO 16 I=1,1800 16 WAV45(I)=3900.+FLOAT(I) DO 17 I=1,1200 17 WAV52(I)=4600.+FLOAT(I) DO 18 I=1,1051 18 WAV58(I)=5249.+FLOAT(I) DO 19 I=1,1500 19 WAV63(I)=6000.+FLOAT(I) DO 20 I=1,620 20 WAV58P(I)=5520.+FLOAT(I) DO 21 I=1,1600 21 WAV72(I)=6450.+FLOAT(I) DO 22 I=1,1300 22 WAV80(I)=7350.+FLOAT(I) DO 23 I=1,1134 23 WAV86(I)=8033.+FLOAT(I) DO 24 I=1,1850 24 WAV99(I)=8900.+FLOAT(I) C DO 25 I=1,3300 DO 25 I=1,1650 C 25 WAV110(I)=9500.+FLOAT(I) 25 WAV110(I)=9500.+FLOAT(I)*2. CALL PINTER(W33,F33,24,WAV33,S33,700) CALL PINTER(W35,F35,24,WAV35,S35,900) CALL PINTER(W37,F37,24,WAV37,S37,981) CALL PINTER(W40,F40,26,WAV40,S40,1463) CALL PINTER(W45,F45,32,WAV45,S45,1800) CALL PINTER(W52,F52,31,WAV52,S52,1200) CALL PINTER(W58,F58,31,WAV58,S58,1051) CALL PINTER(W63,F63,31,WAV63,S63,1500) CALL PINTER(W58P,F58P,32,WAV58P,S58P,620) CALL PINTER(W72,F72,33,WAV72,S72,1600) CALL PINTER(W80,F80,27,WAV80,S80,1300) CALL PINTER(W86,F86,35,WAV86,S86,1134) CALL PINTER(W99,F99,38,WAV99,S99,1850) CALL PINTER(W110,F110,34,WAV110,S110,1650) NOR33=0. NOR35=0. NOR37=0. NOR40=0. NOR45=0. NOR52=0. NOR58=0. NOR63=0. NOR58P=0. NOR72=0. NOR80=0. NOR86=0. NOR99=0. NOR110=0. DO 32 I=1,700 S33(I)=MAX(S33(I),0.) 32 NOR33=NOR33+S33(I) DO 33 I=1,900 S35(I)=MAX(S35(I),0.) 33 NOR35=NOR35+S35(I) DO 34 I=1,981 S37(I)=MAX(S37(I),0.) 34 NOR37=NOR37+S37(I) DO 35 I=1,1463 S40(I)=MAX(S40(I),0.) 35 NOR40=NOR40+S40(I) DO 36 I=1,1800 S45(I)=MAX(S45(I),0.) 36 NOR45=NOR45+S45(I) DO 37 I=1,1200 S52(I)=MAX(S52(I),0.) 37 NOR52=NOR52+S52(I) DO 38 I=1,1051 S58(I)=MAX(S58(I),0.) 38 NOR58=NOR58+S58(I) DO 39 I=1,1500 S63(I)=MAX(S63(I),0.) 39 NOR63=NOR63+S63(I) DO 40 I=1,620 S58P(I)=MAX(S58P(I),0.) 40 NOR58P=NOR58P+S58P(I) DO 41 I=1,1600 S72(I)=MAX(S72(I),0.) 41 NOR72=NOR72+S72(I) DO 42 I=1,1300 S80(I)=MAX(S80(I),0.) 42 NOR80=NOR80+S80(I) DO 43 I=1,1134 S86(I)=MAX(S86(I),0.) 43 NOR86=NOR86+S86(I) DO 44 I=1,1850 S99(I)=MAX(S99(I),0.) 44 NOR99=NOR99+S99(I) DO 45 I=1,1650 S110(I)=MAX(S110(I),0.) 45 NOR110=NOR110+S110(I) 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) DO 111 NU=1,1221 111 WAVEA(NU)=WAVE(NU)*10. 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 logg [M] Vturb l/H E(B-V)', 1' 33 35 37 40 45 52 58 ', 2' 58'' 63 72 80 86 99 110'/ 3' Teff logg [M] Vturb l/H E(B-V)', 4' 33-52 35-52 37-52 40-52 45-52 52-58 52-58'' ', 5 '52-63 52-72 52-80 52-86 52-99 52-110') DO 1000 NMODEL=1,1000 C ergs/cm**2/s/hz/ster READ(1,712,END=9)TITLE 712 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(WAVEA,HLAM,NNU,WAV33,F,700) H=0. DO 52 I=1,700 52 H=H+S33(I)*F(I) MAG33=-2.5*ALOG10(H/NOR33) CALL LINTER(WAVEA,HLAM,NNU,WAV35,F,900) H=0. DO 53 I=1,900 53 H=H+S35(I)*F(I) MAG35=-2.5*ALOG10(H/NOR35) CALL LINTER(WAVEA,HLAM,NNU,WAV37,F,981) H=0. DO 54 I=1,981 54 H=H+S37(I)*F(I) MAG37=-2.5*ALOG10(H/NOR37) CALL LINTER(WAVEA,HLAM,NNU,WAV40,F,1463) H=0. DO 55 I=1,1463 55 H=H+S40(I)*F(I) MAG40=-2.5*ALOG10(H/NOR40) CALL LINTER(WAVEA,HLAM,NNU,WAV45,F,1800) H=0. DO 56 I=1,1800 56 H=H+S45(I)*F(I) MAG45=-2.5*ALOG10(H/NOR45) CALL LINTER(WAVEA,HLAM,NNU,WAV52,F,1200) H=0. DO 57 I=1,1200 57 H=H+S52(I)*F(I) MAG52=-2.5*ALOG10(H/NOR52) CALL LINTER(WAVEA,HLAM,NNU,WAV58,F,1051) H=0. DO 58 I=1,1051 58 H=H+S58(I)*F(I) MAG58=-2.5*ALOG10(H/NOR58) CALL LINTER(WAVEA,HLAM,NNU,WAV63,F,1500) H=0. DO 59 I=1,1500 59 H=H+S63(I)*F(I) MAG63=-2.5*ALOG10(H/NOR63) CALL LINTER(WAVEA,HLAM,NNU,WAV58P,F,620) H=0. DO 60 I=1,620 60 H=H+S58P(I)*F(I) MAG58P=-2.5*ALOG10(H/NOR58P) CALL LINTER(WAVEA,HLAM,NNU,WAV72,F,1600) H=0. DO 61 I=1,1600 61 H=H+S72(I)*F(I) MAG72=-2.5*ALOG10(H/NOR72) CALL LINTER(WAVEA,HLAM,NNU,WAV80,F,1300) H=0. DO 62 I=1,1300 62 H=H+S80(I)*F(I) MAG80=-2.5*ALOG10(H/NOR80) CALL LINTER(WAVEA,HLAM,NNU,WAV86,F,1134) H=0. DO 63 I=1,1134 63 H=H+S86(I)*F(I) MAG86=-2.5*ALOG10(H/NOR86) CALL LINTER(WAVEA,HLAM,NNU,WAV99,F,1850) H=0. DO 64 I=1,1850 64 H=H+S99(I)*F(I) MAG99=-2.5*ALOG10(H/NOR99) CALL LINTER(WAVEA,HLAM,NNU,WAV110,F,1650) H=0. DO 65 I=1,1650 65 H=H+S110(I)*F(I) MAG110=-2.5*ALOG10(H/NOR110) C CONVERT FROM FLUX PER A TO FLUX PER NM C MAGS ARE MEAN FLUXES THROUGH EACH FILTER MAG33=MAG33-2.5 MAG35=MAG35-2.5 MAG37=MAG37-2.5 MAG40=MAG40-2.5 MAG45=MAG45-2.5 MAG52=MAG52-2.5 MAG58=MAG58-2.5 MAG58P=MAG58P-2.5 MAG63=MAG63-2.5 MAG72=MAG72-2.5 MAG80=MAG80-2.5 MAG86=MAG86-2.5 MAG99=MAG99-2.5 MAG110=MAG110-2.5 C3352=MAG33-MAG52 C3552=MAG35-MAG52 C3752=MAG37-MAG52 C4052=MAG40-MAG52 C4552=MAG45-MAG52 C5258=MAG52-MAG58 C5258P=MAG52-MAG58P C5263=MAG52-MAG63 C5272=MAG52-MAG72 C5280=MAG52-MAG80 C5286=MAG52-MAG86 C5299=MAG52-MAG99 C52110=MAG52-MAG110 C NORMALIZE TO VEGA C .052 .035 .043 .013 .001 -.008 .001 -.011 .008 .010 -.004 .011 .000 C c 9550 3.95 -0.50 2.00 0.00 C3352=C3352-.201 C3552=C3552-.258 C3752=C3752+0.090 C4052=C4052+0.584 C4552=C4552+0.377 C5258=C5258+0.356 C5258P=C5258P+0.390 C5263=C5263+0.664 C5272=C5272+1.103 C5280=C5280+1.451 C5286=C5286+1.683 C5299=C5299+2.019 C52110=C52110+2.441 XSCALE=ABUND c actually l/h xh=CONVEC if(ItEFF.GE.9000)xh=0. WRITE(6,70)ITEFF,GLOG,XSCALE,VTURB,XH,EBVI(IRED), 1MAG33,MAG35,MAG37,MAG40,MAG45,MAG52,MAG58,MAG58P,MAG63, 2MAG72,MAG80,MAG86,MAG99,MAG110 WRITE(7,70)ITEFF,GLOG,XSCALE,VTURB,XH,EBVI(IRED), 1MAG33,MAG35,MAG37,MAG40,MAG45,MAG52,MAG58,MAG58P,MAG63, 2MAG72,MAG80,MAG86,MAG99,MAG110 IF(IRED.EQ.1) 1WRITE(8,70)ITEFF,GLOG,XSCALE,VTURB,XH,EBVI(IRED), 2MAG33,MAG35,MAG37,MAG40,MAG45,MAG52,MAG58,MAG58P,MAG63, 3MAG72,MAG80,MAG86,MAG99,MAG110 70 FORMAT(I5,F5.2,4F6.2,14F7.3) WRITE(6,70)ITEFF,GLOG,XSCALE,VTURB,XH,EBVI(IRED), 1C3352,C3552,C3752,C4052,C4552,C5258,C5258P,C5263,C5272, 2C5280,C5286,C5299,C52110 WRITE(7,70)ITEFF,GLOG,XSCALE,VTURB,XH,EBVI(IRED), 1C3352,C3552,C3752,C4052,C4552,C5258,C5258P,C5263,C5272, 2C5280,C5286,C5299,C52110 IF(IRED.EQ.1) 1WRITE(8,70)ITEFF,GLOG,XSCALE,VTURB,XH,EBVI(IRED), 2C3352,C3552,C3752,C4052,C4552,C5258,C5258P,C5263,C5272, 3C5280,C5286,C5299,C52110 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