PROGRAM SPLIT17lsSYN c revised 7mar94 C TAPE19=SPECTRUM INPUT C TAPE1-17=SPECTRUM OUTPUT AT 17 ANGLES C TAPE66=OUTPUT C FOR FLUX SPECTRA NMU IS 1 C COMMON /LINDAT/WL,E,EP,LABEL(2),LABELP(2),OTHER1(2),OTHER2(2), 1 WLVAC,CENTER,CONCEN, NELION,GAMMAR,GAMMAS,GAMMAW,REF, 2 NBLO,NBUP,ISO1,X1,ISO2,X2,GFLOG,XJ,XJP,CODE,ELO,GF,GS,GR,GW, 3 DWL,DGFLOG,DGAMMAR,DGAMMAS,DGAMMAW,EXTRA1,EXTRA2,EXTRA3 REAL*8 LINDAT8(14) REAL*4 LINDAT(28) EQUIVALENCE (LINDAT8(1),WL),(LINDAT(1),NELION) REAL*8 WL,E,EP,WLVAC,CENTER,CONCEN REAL*8 LABEL,LABELP,OTHER1,OTHER2 REAL*4 GFLOG,XJ,XJP,CODE,GAMMAR,GAMMAS,GAMMAW REAL*4 REF,X1,X2,ELO,GF,GS,GR,GW REAL*4 DWL,DGFLOG,DGAMMAR,DGAMMAS,DGAMMAW,EXTRA1,EXTRA2,EXTRA3 DIMENSION XMU(20),QMU(40),WLEDGE(377),TITLE(74),WLEDGE200(200) EQUIVALENCE (WLEDGE(1),WLEDGE200(1)) REAL*8 TEFF,GLOG,TITLE,WBEGIN,RESOLU,XMU,WLEDGE,WLEDGE200 REAL*8 QMU,QMU1,QMU18 DIMENSION QOUT(4000) READ(19,ERR=11)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE NMU=1 WRITE(01)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE WRITE(02)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE WRITE(03)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE WRITE(04)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE WRITE(05)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE WRITE(06)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE WRITE(07)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE WRITE(08)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE WRITE(09)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE WRITE(10)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE WRITE(11)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE WRITE(12)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE WRITE(13)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE WRITE(14)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE WRITE(15)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE WRITE(16)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE WRITE(17)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE GO TO 12 11 READ(19)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU,NEDGE, 1WLEDGE200 WRITE(01)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE200 WRITE(02)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE200 WRITE(03)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE200 WRITE(04)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE200 WRITE(05)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE200 WRITE(06)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE200 WRITE(07)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE200 WRITE(08)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE200 WRITE(09)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE200 WRITE(10)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE200 WRITE(11)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE200 WRITE(12)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE200 WRITE(13)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE200 WRITE(14)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE200 WRITE(15)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE200 WRITE(16)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE200 WRITE(17)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU, 1 NEDGE,WLEDGE200 12 WRITE(66,1)TEFF,GLOG,TITLE 1 FORMAT(5H TEFF,F7.0,7H GRAV,F7.3/7H TITLE ,74A1) IF(IFSURF.EQ.3)NMU=1 NMU2=NMU+NMU C OPEN(UNIT=2,BLOCKSIZE=4800,RECORDSIZE=80,STATUS='NEW', C 1RECORDTYPE='FIXED') C WRITE(2,2)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU,NEDGE, C 1WLEDGE C 2 FORMAT(F10.1,F10.3/6HTITLE ,74A1/F12.5,F10.1,I10,I5,I5/ C 1 10F8.4/10F8.4/I10/(5F16.5)) DO 4 IWL=1,NWL READ(19)(QMU(I),I=1,34) QMU1=QMU(1) QMU18=QMU(18) RATIO=1.D0+1.D0/RESOLU WL=WBEGIN*RATIO**(IWL-1) fudge=1.d0/(2.99792458d17/wl**2) DO 44 ITAPE=1,17 44 WRITE(ITAPE)QMU(ITAPE)/QMU1*fudge,QMU(ITAPE+17)/QMU18*fudge 4 CONTINUE READ(19)NLINES DO 5 ITAPE=1,17 5 WRITE(ITAPE)NLINES DO 9 I=1,NLINES READ(19)LINDAT8,LINDAT DO 8 ITAPE=1,17 8 WRITE(ITAPE)LINDAT8,LINDAT 9 CONTINUE CALL EXIT END