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
|
PROGRAM RPACKEDLINES
IMPLICIT REAL*8 (A-H,O-Z)
COMMON /PACK8000/PACK8000(4,2000)
INTEGER*2 IELION,IELO,IGFLOG,IGR,IGS,IGW
COMMON /IIIIIII/IWL,IELION,IELO,IGFLOG,IGR,IGS,IGW
INTEGER*4 IIIIIII(4),PACK8000
EQUIVALENCE (IIIIIII(1),IWL)
RATIOLOG=LOG(1.D0+1.D0/2000000.D0)
RATIOLG=LOG(1.D0+1.D0/500000.D0)
WLBEG=8.97666
WLEND=10000.
IXWLBEG=DLOG(WLBEG)/RATIOLG
IF(DEXP(IXWLBEG*RATIOLG).LT.WLBEG)IXWLBEG=IXWLBEG+1
IWLSTART=DLOG(WLBEG)/RATIOLOG+.5
IWLSTOP=DLOG(WLEND)/RATIOLOG+.5
NLINES=0
C TIOLINES
OPEN(UNIT=11,TYPE='OLD',FORM='UNFORMATTED',
1RECORDTYPE='FIXED',BLOCKSIZE=8000,RECL=4)
OPEN(UNIT=12,TYPE='NEW',FORM='UNFORMATTED',
1RECORDTYPE='FIXED',BLOCKSIZE=32000,RECL=8000)
DO 5 LINE=1,50000000
READ(11,END=8)IIIIIII
IF(IWL.LT.IWLSTART)GO TO 5
IF(IWL.GT.IWLSTOP)GO TO 5
KGFLOG=IGFLOG
ISO=ABS(IELION)-8949
GO TO (811,812,813,814,815),ISO
C 46TiO
811 IGFLOG=MAX(KGFLOG-1101,1)
GO TO 816
C 47TiO
812 IGFLOG=MAX(KGFLOG-1138,1)
GO TO 816
C 48TiO
813 IGFLOG=MAX(KGFLOG-131,1)
GO TO 816
C 49TiO
814 IGFLOG=MAX(KGFLOG-1259,1)
GO TO 816
C 50TiO
815 IGFLOG=MAX(KGFLOG-1272,1)
816 IELION=366
IGS=1
C added 27 apr 2009--Evan Kirby
IGW=9384
C
WLVAC=EXP(IWL*RATIOLOG)
IXWL=DLOG(WLVAC)/RATIOLG+.5D0
NBUFF=IXWL-IXWLBEG+1
IWL=NBUFF
CALL PACK(IIIIIII)
NLINES=NLINES+1
5 CONTINUE
8 PRINT 1,NLINES
1 FORMAT(I10,' LINES FROM TIOLINES')
WRITE(12)PACK8000
CALL EXIT
END
SUBROUTINE PACK(IIIIIII)
INTEGER*4 PACK8000,IIIIIII(4)
COMMON /PACK8000/PACK8000(4,2000)
DATA IREC/0/
IREC=IREC+1
PACK8000(1,IREC)=IIIIIII(1)
PACK8000(2,IREC)=IIIIIII(2)
PACK8000(3,IREC)=IIIIIII(3)
PACK8000(4,IREC)=IIIIIII(4)
IF(IREC.EQ.2000)THEN
WRITE(12)PACK8000
IREC=0
ENDIF
RETURN
END
|
