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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
*DECK T16FND
SUBROUTINE T16FND(IFT16 ,IPRINT,IOPT ,NKEY ,TKEY1 ,TKEY2 ,
> NBELEM)
*
*----
*
*Purpose:
* Find next record on tape16 identified by keys TKEY1 and TKEY2.
*
*Author(s):
* G. Marleau
*
*Parameters: input
* IFT16 tape16 file unit.
* IPRINT print level where:
* <100 for no print;
* >=100 print record to read;
* >=10000 print all record read.
* IOPT processing option with:
* =-1 start at current position and read to end of file with
* no backspace before return;
* =0 start at current position and read to end of file with
* backspace before return;
* =1 rewind before reading and read to end of file;
* =2 start at current position, rewind, start at beginning of
* file until end of file.
* NKEY number of keys set to test:
* =1 search for TKEY1(1),TKEY2(1) until end of file;
* >1 search for TKEY1(1),TKEY2(1) until
* (TKEY1(IK),TKEY2(IK),IK=2,NKEY) or end of file.
* TKEY1 primary key.
* TKEY2 secondary key.
*
*Parameters: output
* NBELEM number of element found on record with:
* <-1 record not found before alternative keys -NBELEM ;
* =-1 record not found before end of files;
* >=0 record found with NBELEM elements.
*
*----
*
IMPLICIT NONE
INTEGER IFT16,IPRINT,IOPT,NKEY,NBELEM
CHARACTER TKEY1(NKEY)*10,TKEY2(NKEY)*10
*----
* LOCAL VARIABLES
*----
INTEGER IOUT
CHARACTER NAMSBR*6
PARAMETER (IOUT=6,NAMSBR='T16FND')
CHARACTER RKEY1*10,RKEY2*10
INTEGER NBE,IEND,IKEY
*----
* Print keys if required
*----
IF(IPRINT .GE. 100) THEN
IF(IPRINT .LT. 10000) THEN
WRITE(6,6000) TKEY1(1),TKEY2(1)
ENDIF
ENDIF
*----
* REWIND FILE FIRST IF IOPT=1
*----
IEND=1
IF(IOPT .EQ. 1) THEN
REWIND(IFT16)
ELSE IF (IOPT .EQ. 2) THEN
IEND=0
ENDIF
*----
* LOOP FOR READ
*----
100 CONTINUE
READ(IFT16,END=105) RKEY1,RKEY2,NBE
IF(IPRINT .GE. 10000) THEN
WRITE(6,6003) RKEY1,RKEY2,NBE
ENDIF
IF(RKEY1 .EQ. TKEY1(1) .AND.
> RKEY2 .EQ. TKEY2(1) ) THEN
*----
* KEYS FOUND BACKSPACE AND RETURN
*----
NBELEM=NBE
IF(IOPT .GE. 0) BACKSPACE(IFT16)
IF(IPRINT .GE. 100) THEN
WRITE(6,6001) RKEY1,RKEY2,NBELEM
ENDIF
RETURN
ELSE IF(NKEY .GE. 2) THEN
DO IKEY=2,NKEY
IF(RKEY1 .EQ. TKEY1(IKEY) .AND.
> RKEY2 .EQ. TKEY2(IKEY) ) THEN
NBELEM=-IKEY
IF(IOPT .GE. 0) BACKSPACE(IFT16)
IF(IPRINT .GE. 100) THEN
WRITE(6,6004) RKEY1,RKEY2,NBE,
> TKEY1(1),TKEY2(1)
ENDIF
RETURN
ENDIF
ENDDO
ENDIF
*----
* KEYS NOT FOUND READ NEXT RECORD
*----
GO TO 100
*----
* END OF FILE REACHED
*----
105 CONTINUE
IF(IEND .EQ. 0) THEN
*----
* REWIND FILE AND CONTINUE READ
*----
IEND=1
REWIND(IFT16)
GO TO 100
ENDIF
*----
* RECORD ABSENT, RETURN
*----
NBELEM=-1
IF(IPRINT .GE. 100) THEN
IF(IPRINT .LT. 10000) THEN
WRITE(6,6002) TKEY1(1),TKEY2(1)
ENDIF
ENDIF
RETURN
*----
* PRINT FORMAT
*----
6000 FORMAT( 1X, 'FIND T16 RECORD = ',2(A10,2X))
6001 FORMAT( 1X, ' T16 RECORD = ',2(A10,2X),I10,
> 1X,'FOUND')
6002 FORMAT( 1X, ' T16 RECORD = ',2(A10,2X),10X,
> 1X,'NOT FOUND')
6003 FORMAT(11X,'T16 RECORD READ = ',2(A10,2X),I10)
6004 FORMAT( 1X,'T16 STOP RECORD = ',2(A10,2X),I10,
> 1X,'FOUND BEFORE RECORD = ',2(A10,2X))
END
|
