1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
PROGRAM CONVERFSYNNMTOA
C PROGRAM ASCIISYN(TAPE1,TAPE2,OUTPUT,TAPE6=OUTPUT)
C TAPE1=SPECTRUM INPUT
C TAPE2=SPECTRUM OUTPUT IN ASCII CARD IMAGES
C TAPE6=OUTPUT
C FOR FLUX SPECTRA NMU IS 1
c COMMON/LINDAT/WL,GFLOG,XJ,E,XJP,EP,CODE,LABEL(2),LABELP(2),NELION,
c 1 GAMMAR,GAMMAS,GAMMAW,REF,NBLO,NBUP,ISO1,X1,ISO2,
c 2 X2,OTHER1(2),OTHER2(2),ELO,GF,WLVAC,GS,GR,GW,CENTER,CONCEN
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 WL,E,EP,WLVAC,CENTER,CONCEN
REAL*8 LABEL,LABELP,OTHER1,OTHER2,LINDAT
CCRAY DIMENSION LINDAT(34)
DIMENSION LINDAT(24)
EQUIVALENCE (LINDAT(1),WL)
DIMENSION XMU(20),QMU(40),WLEDGE(200),TITLE(74)
REAL*8 TEFF,GLOG,TITLE,WBEGIN,RESOLU,XMU,WLEDGE
REAL*8 QMU
DIMENSION QOUT(10000)
OPEN(UNIT=1,FORM='UNFORMATTED',READONLY,STATUS='OLD')
READ(1)TEFF,GLOG,TITLE,WBEGIN,RESOLU,NWL,IFSURF,NMU,XMU,NEDGE,
1WLEDGE
WRITE(6,1)TEFF,GLOG,TITLE
1 FORMAT(5HTEFF ,F7.0,7HGRAVITY,F7.3/7HTITLE ,74A1)
WRITE(2,1)TEFF,GLOG,TITLE
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
2 FORMAT(F10.1,F10.3/6HTITLE ,74A1/F10.3,F10.1,I10,I5,I5/
1 10F8.4/10F8.4/I10/(5F16.5))
npti=0
DO 6 IWL=1,NWL,100
N100=MIN0(NWL-IWL+1,100)
J=0
DO 4 I100=1,N100
READ(1)(QMU(I),I=1,NMU2)
DO 3 I=1,NMU2
J=J+1
3 QOUT(J)=QMU(I)
NIWL=IWL+I100-1
WAVE=WBEGIN*(1.+1./RESOLU)**(NIWL-1)
freq=2.997925e17/wave
npti=npti+1
c WRITE(2,5)j,WAVE,freq,QOUT(J-1),QOUT(J)
c 5 FORMAT(4HFLUX,I5,F9.5,1PE20.6,2E13.4)
wavea=10.*wave
fluxl=4.*qout(j-1)*2.99792458E18/(wavea*wavea)
fluxc=4.*qout(j)*2.99792458E18/(wavea*wavea)
resid=fluxl/fluxc
c WRITE(2,5)WAVE,freq,QOUT(J-1),QOUT(J)
WRITE(2,55)WAVEa,fluxl,fluxc,resid
5 FORMAT(4HFLUX,5x,F9.4,1PE20.6,2E13.4)
55 format(1x,f11.4,1x,1pE12.4,1x,1pE12.4,1x,0PF8.4)
4 CONTINUE
6 CONTINUE
C READ(1)NLINES
C WRITE(2,7)NLINES
C 7 FORMAT(I10)
C DO 9 I=1,NLINES
C READ(1)LINDAT
C WRITE(2,8)WL,GFLOG,XJ,E,XJP,EP,CODE,LABEL,LABELP,
C 1WL,NELION,GR,GS,GW,REF,NBLO,NBUP,ISO1,X1,ISO2,X2,OTHER1,OTHER2,
C 2WL,GF,WLVAC,GAMMAR,GAMMAS,GAMMAW,CENTER,CONCEN
C 2WL,ELO,GF,WLVAC,GAMMAR,GAMMAS,GAMMAW,CENTER,CONCEN
C ELO MUST BE RECONSTRUCTED
8 FORMAT(F10.4,F7.3,F5.1,F12.3,F5.1,F12.3,F9.2,A8,A2,A8,A2/
1F10.4,I4,3F6.2,A4,2I2,I3,F7.2,I3,F7.2,A8,A2,A8,A2/
2F10.4,1PE10.3,0PF10.3,1P5E10.3)
9 CONTINUE
type*,npti
CALL EXIT
END
|
