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
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
|
SUBROUTINE CASE
C
C CASE READS THE CASE CONTROL DATA BLOCK AND WRITES A NEW
C DATA BLOCK WHICH CONTAINS ONLY THOSE RECORDS WHICH DESCRIBE THE
C CURRENT CASE IN THE LOOP. ADDITIONALLY, THE LOOP CONTROL PARAMETER
C IS SET.
C
C
INTEGER APP ,COUNT ,SYSBUF,CASECC,CASEXX,FILE ,Z ,
1 BUF1 ,BUF2 ,RFMTS ,BRANCH,BUF ,ERROR(2)
INTEGER BUF3 ,PSDL
DIMENSION NAM(2) ,BUF(20),MCB(7),RFMTS(40)
COMMON /BLANK / APP(2) ,COUNT ,LOOP
COMMON /SYSTEM/ SYSBUF
COMMON /NAMES / RD ,RDREW ,WRT ,WRTREW,CLSREW
COMMON /ZZZZZZ/ Z(1)
C
C DATA DESCRIBING DATA BLOCK FILE NAMES AND POSITION
C OF PARAMETERS IN THE CASE CONTROL RECORD.
C
DATA CASECC / 101/ ,CASEXX /201/ ,IK2PP /139/ ,IM2PP /141/ ,
1 IB2PP / 143/ ,ITFL / 15/ ,PSDL /102/ ,IRAND /163/
DATA ERROR / 4HPSDL,4HCASE/
DATA IFREQ / 14/ ,IMETH / 5/
C
C DATA DEFINING RIGID FORMATS.
C
DATA NRIGDS / 10 /, RFMTS /
1 4HSTAT,4HICS , 4HREIG,4HEN , 4HDS0 ,4H ,
2 4HDS1 ,4H , 4HFREQ,4H , 4HTRAN,4HSNT ,
3 4HBKL0,4H , 4HBKL1,4H , 4HCEIG,4HEN ,
4 4HPLA ,4H , 20*0 /
C
C MISC DATA
C
DATA NAM / 4HCASE,4H /, MCB / 7*0 /
C
C PERFORM BUFFER ALLOCATION.
C
BUF1 = KORSZ(Z) - SYSBUF + 1
BUF3 = BUF1 - SYSBUF
BUF2 = BUF3 - SYSBUF
IRY = 0
M8 = -8
IF (COUNT .LE. 0) COUNT = 1
LOOP = 1
IOCNT = COUNT
C
C SET PARAMETER FOR APPROACH.
C
N = 2*NRIGDS - 1
DO 20 I = 1,N,2
IF (RFMTS(I) .EQ. APP(1)) GO TO 30
20 CONTINUE
CALL MESAGE (30,75,APP)
I = 19
30 BRANCH = (I+1)/2
C
C OPEN CASECC. SKIP RECORDS ALREADY PROCESSED. OPEN CASEXX.
C WRITE HEADER RECORD. THEN BRANCH ON APPROACH.
C
FILE = CASECC
CALL OPEN (*130,CASECC,Z(BUF1),RDREW)
DO 40 I = 1,COUNT
40 CALL FWDREC (*140,CASECC)
FILE = CASEXX
CALL OPEN (*130,CASEXX,Z(BUF2),WRTREW)
CALL FNAME (CASEXX,BUF)
CALL WRITE (CASEXX,BUF,2,1)
GO TO (120,50,120,120,50,100,120,120,50,120), BRANCH
C
C COMPLEX EIGENVALUES OR FREQUENCY RESPONSE.
C
50 CALL READ (*140,*60,CASECC,Z,BUF2,1,NCC)
CALL MESAGE (M8,0,NAM)
60 BUF(1) = Z(IK2PP )
BUF(2) = Z(IK2PP+1)
BUF(3) = Z(IM2PP )
BUF(4) = Z(IM2PP+1)
BUF(5) = Z(IB2PP )
BUF(6) = Z(IB2PP+1)
BUF(7) = Z(ITFL)
IRSET = Z(IRAND)
IFRQST = Z(IFREQ)
IMRQST = Z(IMETH)
IF (BRANCH.EQ.5 .AND. IRSET.NE.0) IRY = 1
IF (IRY .EQ. 0) GO TO 70
C
C BUILD LIST OF UNIQUE LOAD ID-S
C
FILE = PSDL
CALL OPEN (*68,PSDL,Z(BUF3),RDREW)
CALL FWDREC (*90,PSDL)
ILS = BUF2
ILF = BUF2 - 1
61 CALL READ (*90,*66,PSDL,Z(NCC+1),6,0,J)
IF (Z(NCC+1) .NE. IRSET) GO TO 61
J = 1
ILOAD = Z(NCC+2)
IF (ILS .EQ. ILF+1) GO TO 63
65 DO 62 I = ILS,ILF
IF (Z(I) .EQ. ILOAD) GO TO 64
62 CONTINUE
C
C NEW LOAD ID
C
63 ILS = ILS - 1
Z(ILS) = ILOAD
64 IF (J .EQ. 0) GO TO 61
J = 0
ILOAD = Z(NCC+3)
GO TO 65
C
C END OF PSDL RECORD
C
66 CALL CLOSE (PSDL,CLSREW)
IF (ILS .EQ. ILF+1) CALL MESAGE (-31,IRSET,ERROR(1))
BUF2 = ILS - 1
GO TO 70
C
C NO PSDL IS EQUIVALENT TO NO RANDOM
C
68 IRY = 0
70 CALL WRITE (CASEXX,Z,NCC,1)
COUNT = COUNT + 1
IF (IRY .EQ. 0) GO TO 71
C
C CHECK SUBCASE ID-S
C
DO 72 I = ILS,ILF
IF (Z(1) .EQ. Z(I)) GO TO 74
72 CONTINUE
GO TO 71
C
C MARK USED
C
74 Z(I) = -Z(I)
71 CONTINUE
CALL READ (*90,*80,CASECC,Z,BUF2,1,NCC)
CALL MESAGE (M8,0,NAM)
80 IF (Z(IK2PP).NE.BUF(1) .OR. Z(IK2PP+1).NE.BUF(2) .OR.
1 Z(IM2PP).NE.BUF(3) .OR. Z(IM2PP+1).NE.BUF(4) .OR.
2 Z(IB2PP).NE.BUF(5) .OR. Z(IB2PP+1).NE.BUF(6)) GO TO 120
IF (Z(ITFL) .NE. BUF(7)) GO TO 120
IF (Z(IMETH).NE.0 .AND. Z(IMETH).NE.IMRQST) GO TO 120
C
C TEST FOR CHANGED FREQUENCY SET
C
IF (Z(IFREQ).NE.IFRQST .AND. BRANCH.EQ.5) GO TO 120
GO TO 70
90 COUNT = -1
GO TO 120
C
C TRANSIENT RESPONSE.
C
100 CALL READ (*140,*110,CASECC,Z,BUF2,1,NCC)
CALL MESAGE (M8,0,NAM)
110 CALL WRITE (CASEXX,Z,NCC,1)
COUNT = COUNT + 1
CALL READ (*90,*120,CASECC,Z,BUF2,1,NCC)
GO TO 120
C
C CLOSE FILES. WRITE TRAILER. RETURN.
C
120 CALL CLOSE (CASECC,CLSREW)
CALL CLOSE (CASEXX,CLSREW)
MCB(1) = CASEXX
MCB(2) = COUNT
CALL WRTTRL (MCB)
IF (COUNT.LE.1 .AND. IOCNT.EQ.1) LOOP = -1
C
C CHECK ALL PSDL ACCOUNTED FOR
C
IF (IRY .EQ. 0) GO TO 125
NOGO = 0
DO 121 I = ILS,ILF
IF (Z(I) .LT. 0) GO TO 121
NOGO = -1
CALL MESAGE (33,Z(I),NAM)
121 CONTINUE
IF (NOGO .LT. 0) CALL MESAGE (-7,0,NAM)
125 RETURN
C
C FATAL FILE ERRORS.
C
130 N = -1
GO TO 150
140 N = -2
FILE = CASECC
150 CALL MESAGE (N,FILE,NAM)
GO TO 150
END
|
