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
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
|
PROGRAM FF
C
CDC PROGRAM FF (TAPE3)
C
C LAST MAJOR REVISIONS - OCT 27, 1989
C JUN 25, 1991, FOR UNIX
C
C A NASTRAN STAND-ALONE PROGRAM TO GENERATE NASTRAN FIX-FIELD INPUT
C DECK FROM THIS FREE-FIELD INPUT PROGRAM.
C
C *** THIS PROGRAM MUST BE COMPILED USING THE FOLLOWING COMPILERS
C IBM VS FORTRAN, UNIVAC ASCII FORTRAN, CDC FORTRAN 5 (ANSI 77),
C VAX FORTRAN IV-PLUS, AND IBM PC FORTRAN 3.0 OR RMC PROFESSION-
C AL FORTRAN
C
C *** VAX ONLY - THE OPEN AND CLOSE FUNCTIONS IN FF AND FFREAD MAY
C REQUIRE THE USE OF THE VAX ACCEPTABLE KEYWORDS.
C (PRESENTLY, THE NON-VAX KEYWORDS ARE ACCEPTABLE BY ALL MACHINES)
C
C
C WRITTEN BY G.CHAN/UNISYS, APRIL 1985
C
C SEE FFREAD SUBROUTINE FOR MORE DETAIL OF FREE-FIELD INPUT.
C
C FILES ASSIGMENT
C 5 - CARD READER, OR CRT TERMINAL
C 6 - PRINTER, OR CRT TERMINAL
C 7 - PUNCH (IBM,CDC,VAX)
C 1 - PUNCH (UNIVAC ONLY)
C 2 - EQUATES TO USER FILE (ASSIGNED AUTOMATICALLY BY PROGRAM)
C 3 - A SCRATCH FILE TO HOLD THE USER ACTUAL INPUT CARDS
C 4 - USED ONLY IF READFILE IS USED TO READ AN OLD FILE
C
C LINK THIS MAIN PROGRAM WITH THE FOLLOWING ROUTINES -
C (THE EXECUTABLE IS CALLED LINKFF)
C
C FF,FFHELP,FFREAD,UPCASE
C INT2A8,A82INT,NA12IF,NA12A8,DUMMY
C
C *** CDC ONLY - PROCEDURE TO LINK FF INTERACTIVELY
C UPDATE,Q,P=EJPL,C=FF,L=0,N=0.
C ? *C FF
C ? <C/R>
C REWIND,FF.
C FTN5,STATIC,ARG=0,I=FF,L=0,B=FFLGO,LO=R/A/M/S.
C ATTACH,NASTLIB/PN=DISC#.
C LIBRARY,NASTLIB,FTN5LIB,BAMLIB.
C REWIND,*.
C LDSET,LIB=NASTLIB,PRESET=ZERO.
C LDR>? LOAD,FFLGO.
C LDR>? NOGO,LINKFF.
C
C *** VAX ONLY - TO LINK FF USING NASTRAN LIBRARY
C LINK/EXE=LINKFF.EXE NASTRAN.LIB/LIBRARY/INCLUDE=FF
C
C *** UNIVAC ONLY - TO LINK FF WITH RELOCATABLES IN OBJ FILE
C @PREP OBJ.
C @MAP,IS TPF$.MAP,NASTRAN.LINKFF
C LIB OBJ.
C IN FF
C END
C
C *** IBM ONLY - LINKAGE EDITOR INPUT CARDS
C INCLUDE LIB(FF,FFHELP,FFREAD,UPCASE)
C INCLUDE LIB(INT2A8,A82INT,NA12IF,NA12A8)
C INCLUDE PRIVLIB(IQZDDN,QQDCBF,QQGETF)
C ENTRY FF
C NAME LINKFF(R)
C
C (NOTE - PRIVLIB IS LOCALLY SUPPLIED
C SEE THE DESCRIPTIONS OF IZZDDN,QQDCBF,QQGETF BELOW)
C
C *** UNIX ONLY - TO LINK @LINKFF
C cd
C f77 ./mis/ff.f ./lib/nastlib.a -o @LINKFF
C
LOGICAL STAR, PCT, NOTYET, PUNCH, UPFLAG
INTEGER SCREEN, PROM, FFFLAG, FACSF, NC(7),
1 IBM, UNIVAC, CDC, VAX, PC,
2 UNIX
CHARACTER*1 FN(1), BK1, N1, Y1, X1,
1 S1, W1, A1, H1, CARD1(5),
2 FX, MARKQ, QMARK, TMP, RPRN,
3 SPL(8), DOT, D1, T1
CHARACTER*2 CARD2, REPL
CHARACTER*3 NEW, OLD, ODNW
CHARACTER*4 CARD(20), SAVE(20), BEGN, HELP, STOP,
1 LIST, BLANK, END1, END2, END3,
2 CANC1, CANC2, ALTER, CARD4, FN4,
3 BBK(2), KSMB(9)
CHARACTER*6 FN6, BEGN6, HELP6, STOP6, CARD6,
1 MTYPE(7), CNTLWD(3)
CHARACTER*8 FNAME(4), MYFILE, BLNK8, SITE, CNTRL,
1 USE(2), SYM(4), TAPEO3, TPF, FOROO3,
2 DORK, KEEP, SPILL
CHARACTER*11 F
CHARACTER*32 FN32
COMMON /SYSTEM/ IBUF, NOUT, NOGO, IN, ISYS(15)
COMMON /MACHIN/ MACH
COMMON /XXREAD/ INFLAG, INSAVE, LOOP4, IBMCDC
COMMON /XECHOX/ FFFLAG, IECHO(3), ISORT(5)
COMMON /XREADX/ SCREEN, LOOP, KOUNT, PROM, NOTYET,
1 STAR, PCT, ICONT(36)
COMMON /QMARKQ/ MARKQ, TMP(16), SPILL, SAVE
COMMON /UPCASX/ UPFLAG, UPID(3)
EQUIVALENCE (FN(1),FN4,FN6,FN32,FNAME(1)),(XXI,LLI),
1 (CARD(1),CARD6,CARD1(1),CARD2,CARD4),
2 (SPL(1),SPILL)
DATA BEGN, HELP, STOP, BLANK, BK1 /
1 'BEGI', 'HELP', 'STOP', ' ', ' ' /
DATA BEGN6, HELP6, STOP6, BLNK8, KEEP /
1 'BEGIN ', 'HELP ', 'STOP ', ' ', 'KEEP' /
DATA END1, END2, END3, N1, ALTER /
1 'ENDD', 'END ', 'ENDA', 'N', 'LTER' /
DATA CANC1, CANC2, DORK, LLI, LLJ /
1 'CANC', 'EL ', 'DELETE', 4H I , 4H J /
DATA CNTRL, MYFILE, NEW, OLD, Y1 /
1 'CENTRAL','MIFYLE', 'NEW', 'OLD', 'Y' /
DATA NC/ 12, 7, 28, 7, 28, 0, 28 /
DATA UNIVAC, IBM, CDC, VAX, PC, UNIX /
1 3, 2, 4, 5, 1, 7 /
DATA MTYPE /
1 'IBM PC', ' IBM', 'UNIVAC', ' CDC', ' VAX',
2 ' *** ', ' UNIX' /
DATA TAPEO3, TPF, FOROO3, F /
1 'TAPE3.', 'FF$$.', 'FT03.', 'FF FF' /
DATA S1, A1, BBK, LIST /
1 'S', 'A', '(BLA', 'NK) ', 'LIST' /
DATA W1, H1, FX, RPRN, ICNTL /
1 'O', 'H', 'X', ')', 0 /
DATA DOT, D1, T1 /
1 '.', 'D', 'T' /
DATA CNTLWD, NCNTL, REPL /
1 'CANCEL', 'PROMPT', 'LIST ', 3, 'R:' /
DATA KSMB / '+C0N', '+C1N', '+C2N', '+C3N' ,
1 '+C4N', '+C5N', '+C6N', '+C7N', '+C8N' /
DATA USE / '@USE 3.,', 'FF$$ . '/ PUNCH / .FALSE./
DATA SYM / '@SYM ', 'PUNCH$,,', '****', ' . ' /
DATA QMARK / '?' /
C QMARK IS QUESTION MARK - 0/12 PUNCH FOR 26 CODE
C 0/7/8 PUNCH FOR 29 CODE
C
J = LLJ - LLI
MACH = IBM
IF (J .EQ. 256) MACH = PC
IF (J .EQ. 512) MACH = UNIVAC
IF (J .GT. 65535) MACH = VAX
IF (J .GT. 2**30) MACH = CDC
IF (MACH.EQ.VAX .AND. (XXI.GT.1.60E-19 .OR. XXI.LT.1.8E-19))
1 MACH = UNIX
IF (MACH.EQ.VAX .AND. (XXI.GT.3.40E-20 .OR. XXI.LT.3.39E-20))
1 MACH = PC
C
LU = 2
LOUT = 3
IN = 5
NOUT = 6
IPUN = 7
SCREEN = 6
IF (MACH .EQ. VAX) SCREEN = 5
LOOP =-1
KOUNT = 0
KONTN = 10000000
IKI = 1
PROM =+1
STAR =.FALSE.
PCT =.FALSE.
NOTYET =.FALSE.
MARKQ = QMARK
IECHO(2)=-2
INSAVE = IN
INFLAG = 0
FFFLAG = 0
UPFLAG =.FALSE.
ISYS(15)= 0
J = NC(MACH)
CARD4 = BLANK
CARD6 = STOP6
FN4 = STOP
FN6 = STOP6
LOOP4 = LOOP - 4
DO 5 I = 1,20
5 SAVE(I) = BLANK
IBMCDC = UNIVAC + VAX + PC
IF (MACH.EQ.IBM .OR. MACH.EQ.CDC) IBMCDC = 0
C
C IF MACHINE IS CDC, OPEN INPUT, OUTPUT, AND PUNCH FILES
C
IF (MACH .NE. CDC) GO TO 20
OPEN (UNIT=IN ,FILE='INPUT' ,STATUS='UNKNOWN')
OPEN (UNIT=NOUT,FILE='OUTPUT',STATUS='UNKNOWN')
OPEN (UNIT=IPUN,FILE='PUNCH' ,STATUS='UNKNOWN')
OPEN (UNIT=LOUT,FILE='TAPE3' ,STATUS='UNKNOWN',ERR=15)
GO TO 20
C
15 STOP 'SCRATCH FILE ERROR, UNIT 3'
C
20 WRITE (NOUT,25) (F,I=1,7),MTYPE(MACH),(F,I=1,4)
25 FORMAT (/////15X,A11, /14X,A11, 3(/13X,A11), /8X,2(3X,'FFFFFF'),
1 2(/13X,A11),7X,A6,' VERSION / APRIL 93', /13X,A11,
2 /12X,A11,10X,'COSMIC, (706) 542-3265', /11X,A11,11X,
3 'UNIVERSITY OF GEORGIA', /10X,A11,12X,'ATHENS, GEORGIA',
4 ' 30602')
30 WRITE (NOUT,35) J
35 FORMAT (//,' *** ENTER A BLANK, ''HELP'', OR A FILE NAME (UP TO'
1, I3,' CHARACTERS)', /5X,'IF OUTPUT IS TO BE SAVED')
READ (IN,40,ERR=330,END=330) FNAME
40 FORMAT (4A8)
IF (FNAME(1) .EQ. MYFILE) CALL FFHELP (*30,*600,4)
IF (FNAME(1) .EQ. BLNK8) FNAME(1) = MYFILE
IF (FN(J+1).NE.BK1 .OR. FN(J+2).NE.BK1 .OR. FN(J+3).NE.BK1)
1 GO TO 330
IF (FNAME(2) .NE. BLNK8) GO TO 50
CALL UPCASE (FNAME,J)
IF (FN6 .EQ. BEGN6) GO TO 330
IF (FN6 .EQ. STOP6) GO TO 600
IF (FN6 .EQ. HELP6) CALL FFHELP (*30,*600,1)
50 ODNW = OLD
IF (MACH .NE. VAX) GO TO 60
DO 52 I = 2,J
IF (FN(I) .EQ. DOT) GO TO 60
IF (FN(I) .EQ. BK1) GO TO 55
52 CONTINUE
I = J + 1
55 FN(I ) = DOT
FN(I+1) = D1
FN(I+2) = A1
FN(I+3) = T1
60 IF (MACH .NE. IBM) GO TO 65
C
C IBM ONLY, WE CALL SYSTEM ROUTINES
C IQZDDN TO DETERMINE WHETHER FILES EXIST OR NOT
C QQDCBF TO DYNAMICALLY BUILD AN ATTRIBUTE LIST BY DDNAME
C QQGETF TO DYNAMICALLY ALLOCATE FILES IN TSO OR BATCH
C
I = IQZDDN(FNAME(1))
ODNW = OLD
IF (I .EQ. 0) ODNW = NEW
IF (ODNW .EQ. NEW) CALL QQDCBF (FNAME(1),0,'F ',80,80,DA)
CALL QQGETF (LU,FNAME(1),IERR)
IF (IERR .NE. 0) GO TO 130
C
65 IF (IBMCDC.EQ.0) OPEN (UNIT=LU,FILE=FNAME(1),STATUS=ODNW,ERR=130)
IF (IBMCDC.NE.0) OPEN (UNIT=LU,FILE=FN32 ,STATUS=ODNW,ERR=130)
IF (ODNW .EQ. NEW) GO TO 140
70 WRITE (NOUT,80)
80 FORMAT (/,' FILE ALREADY EXISTS, ENTER ''STOP'', ''OVERWRITE'',',
1 ' OR ''APPEND'' -')
IF (MACH.EQ.CDC .AND. IN.EQ.5) REWIND IN
READ (IN,90,END=70) X1
90 FORMAT (A1)
CALL UPCASE (X1,1)
IF (X1 .EQ. S1) GO TO 480
IF (X1 .EQ. W1) GO TO 140
IF (X1 .NE. A1) GO TO 70
SAVE(2) = BBK(1)
SAVE(3) = BBK(2)
110 READ (LU,180,END=115) SAVE
IF (SAVE(1).EQ.BEGN .AND. SAVE(4).EQ.BLANK) FFFLAG = 1234
IF (SAVE(19) .EQ. KSMB(IKI)) IKI = IKI + 1
GO TO 110
115 BACKSPACE LU
IF (FFFLAG .EQ. 1234) WRITE (NOUT,120)
120 FORMAT (/,' IF EXISTING FILE CONTAINS FREE-FIELD INPUT CARDS, ',
1 ' THIS PROGRAM WILL NOT', /5X,'EXPAND THEM TO FIXED-',
2 ' FIELD FORMATS',/)
WRITE (NOUT,255) SAVE
IF (FFFLAG.EQ.1234 .AND. INFLAG.EQ.0) CALL FFHELP (*125,*125,5)
125 CARD(1) = SAVE(1)
CARD(2) = SAVE(2)
GO TO 140
130 IF (ODNW .EQ. NEW) GO TO 310
ODNW = NEW
GO TO 60
140 IF (MACH .EQ. UNIVAC) J = FACSF(USE)
IF (FNAME(1) .EQ. MYFILE) FNAME(1) = BLNK8
IF (FNAME(1) .EQ. BLNK8) WRITE (NOUT,150)
150 FORMAT (/5X,'*** OUTPUT NOT SAVED ***',//)
WRITE (NOUT,160)
160 FORMAT (//,' *** NASTRAN FREE-FIELD INPUT PROGRAM ***',
1 /5X,'(THERE WILL BE NO INPUT ECHO UNTIL ''BEGIN BULK'' IS TYPED',
2 /5X,' TO TERMINATE JOB: ENTER ''ENDDATA'' OR ''STOP'')',
3 //5X,'PLEASE BEGIN -',/)
170 CALL FFREAD (*320,CARD)
IF (CARD4.EQ.CANC1 .AND. CARD(2).EQ.CANC2) GO TO 230
IF (CARD4.EQ. LIST .AND. CARD(2).EQ.BLANK) GO TO 230
IF (CARD2.EQ. REPL .AND. CARD(4).EQ.BLANK) GO TO 350
IF (CARD4.EQ. STOP .AND. CARD(2).EQ.BLANK) GO TO 400
IF (CARD4.EQ.BLANK .AND. CARD(2).EQ.BLANK) GO TO 370
IF (CARD4.EQ. HELP .AND. CARD(2).EQ.BLANK)
1 CALL FFHELP (*280,*400,2)
IF (LU .EQ. 2) WRITE (LU,180) CARD
180 FORMAT (20A4)
IF (FFFLAG.NE.1234 .AND. INFLAG.EQ.4) WRITE (NOUT,190) CARD
190 FORMAT (1X,20A4)
IF (CARD4.EQ.BEGN .AND. CARD(5).EQ.BLANK) GO TO 340
IF (CARD4.NE.END1 .AND. CARD4.NE.END2 .AND. CARD4.NE.END3)
1 GO TO 170
IF (CARD(2).EQ.BLANK .OR. CARD(2).EQ.ALTER) GO TO 170
GO TO 410
230 IF (LU .NE. 2) GO TO 290
J = 1
IF (CARD(5).EQ.CANC1 .AND. ICONT(1).GT.0) J = ICONT(1) + 1
IF (CARD(5).EQ. LIST .AND. ICONT(1).GT.0) J = ICONT(1)
DO 240 I = 1,J
240 BACKSPACE LU
ICONT(1) = 0
IF (CARD(5) .EQ. LIST) GO TO 260
READ (LU,180) SAVE
J = J - 1
WRITE (NOUT,250) J
250 FORMAT (1X,I4,' PREVIOUSLY GENERATED CARDS CANCELLED ***')
IF (J .GT. 0) WRITE (NOUT,255) SAVE
255 FORMAT (/,' *** LAST CARD WAS:', /1X,20A4)
GO TO 280
260 WRITE (NOUT,265) J
265 FORMAT (//,' *** PREVIOUS',I4,' CARDS WERE (COLS. 1-79) -',/)
DO 270 I = 1,J
READ (LU,180,END=285) SAVE
270 WRITE (NOUT,275) SAVE
275 FORMAT (1X,20A4)
280 CARD(1) = SAVE(1)
CARD(2) = SAVE(2)
GO TO 170
285 BACKSPACE LU
SAVE(1) = CARD(1)
SAVE(2) = CARD(2)
GO TO 170
290 WRITE (NOUT,300) CARD4,CARD(2)
300 FORMAT (' *** ',A4,A3,'OPTION NOT ACTIVE. NO SAVE FILE ',
1 'REQUESTED')
GO TO 170
310 WRITE (NOUT,315) FNAME
315 FORMAT (' *** CAN NOT ASSIGN FILE - ',4A8)
GO TO 20
320 WRITE (NOUT,325)
325 FORMAT (' *INPUT ERROR/FF*')
GO TO 170
330 WRITE (NOUT,335)
335 FORMAT (' *NOT A VALID FILE NAME*')
IF (MACH.EQ.CDC .AND. IN.EQ.5) REWIND IN
GO TO 20
340 FFFLAG = 1234
IF (INFLAG .EQ. 0) CALL FFHELP (*170,*170,5)
GO TO 170
C
C ... EDIT PREVIOUS LINE BY R:n)xxx
C
350 I = 3
IF (CARD1(5) .EQ. RPRN) I = 4
READ (CARD1(I),355,ERR=170) II
355 FORMAT (I1)
IF (II .EQ. 0) II = 10
I = I + 2
DO 360 J = 1,8
SPL(J) = CARD1(I)
360 I = I + 1
SAVE(II) = SPILL
DO 365 I = 1,10
365 CARD(I) = SAVE(I)
BACKSPACE LU
WRITE (LU, 180) SAVE
WRITE (NOUT,190) SAVE
GO TO 170
C
C ... FIRST 2 FIELDS ARE BLANK, OTHER FIELDS NOT, TREAT IT AS A
C CONTINUATION CARD IF PREVIOUS CARD HAS A BLANK CONTINUATION FIELD
C
370 IF (LU .NE. 2) GO TO 385
DO 375 J = 3,18
IF (CARD(J) .NE. BLANK) GO TO 380
375 CONTINUE
GO TO 170
380 BACKSPACE LU
READ (LU,180) SAVE
IF (SAVE(19) .EQ. BLANK) GO TO 390
WRITE (NOUT,382)
382 FORMAT (/,' BAD INPUT - FIRST FIELD BLANK. TRY AGAIN')
WRITE (NOUT,383)
383 FORMAT (13X,'NOT ALLOW. PREVIOUS CARD HAS CONTINUATION FIELD ',
1 'DEFINED')
GO TO 170
385 WRITE (NOUT,382)
WRITE (NOUT,387)
387 FORMAT (13X,'NOT ALLOW WITHOUT SAVE FILE')
GO TO 170
390 KONTN = KONTN + 1
IF (MOD(KONTN,10000) .EQ. 0) IKI = IKI + 1
CALL INT2K8 (*385,KONTN,SAVE(19))
SAVE(19) = KSMB(IKI)
CARD(1 ) = KSMB(IKI)
CARD(2 ) = SAVE(20)
WRITE (NOUT,395)
395 FORMAT (' ...PREVIOUS CARDS REPLACED BY:')
WRITE (NOUT,190) SAVE
WRITE (NOUT,190) CARD
BACKSPACE LU
WRITE (LU,180) SAVE
WRITE (LU,180) CARD
GO TO 170
C
400 BACKSPACE LOUT
410 ENDFILE LOUT
IF (LU .NE. 6) ENDFILE LU
PUNCH =.FALSE.
SITE = BLNK8
420 WRITE (NOUT,430) QMARK
430 FORMAT (/,' *** DO YOU WANT TO PUNCH OUT THE NASTRAN DECK',A1,
1 ' (Y,N,X,HELP) ')
IF (MACH.EQ.CDC .AND. IN.EQ.5) REWIND IN
READ (IN,90,END=420) X1
CALL UPCASE (X1,1)
IF (X1 .EQ. H1) CALL FFHELP (*420,*480,3)
IF (X1 .EQ. N1) GO TO 500
IF (X1.NE.Y1 .AND. X1.NE.FX) GO TO 420
PUNCH =.TRUE.
LX = LOUT
IF (X1 .EQ. FX) LX = LU
IF (MACH .NE. UNIVAC) GO TO 460
IPUN = 1
WRITE (NOUT,440)
440 FORMAT (/,' *** ENTER SITE-ID, OR ''CENTRAL'', WHERE CARDS ARE',
1 ' TO BE PUNCHED ')
450 READ (IN,40,ERR=450,END=450) SITE
IF (SITE .EQ. BLNK8) GO TO 490
CALL UPCASE (SITE,8)
IF (SITE .EQ. CNTRL) GO TO 460
C
C SEND PUNCH DECK TO SITE AS REQUESTED BY THE USER - UNIVAC ONLY
C-UNV FACSF IS UNIVAC SYSTEM FUNCTION
C
SYM(3) = SITE
J = FACSF(SYM)
460 REWIND LX
470 READ (LX,180,END=500) CARD
DO 475 J = 2,NCNTL
IF (CARD6 .NE. CNTLWD(J)) GO TO 475
IF (CARD(4) .EQ. BLANK) GO TO 470
475 CONTINUE
IF ((CARD6.EQ.HELP6 .OR. CARD6.EQ.STOP6) .AND. CARD(3).EQ.BLANK)
1 GO TO 470
IF (CARD6.EQ.CNTLWD(1) .AND. CARD(4).EQ.BLANK) ICNTL = ICNTL + 1
WRITE (IPUN,180) CARD
GO TO 470
C
480 FNAME(1) = BLNK8
490 PUNCH =.FALSE.
500 WRITE (NOUT,510)
510 FORMAT (//10X,'ADIEU MY FRIEND. IT IS A PLEASURE TO SERVE YOU')
IF (FNAME(1) .NE. BLNK8) WRITE (NOUT,520) FNAME
520 FORMAT (10X,'DON''T FORGET - YOUR NASTRAN DECK IS IN FILE -',
1 /25X,4A8, /10X,'WHICH IS ACCESSIBLE BY THE SYSTEM EDITOR')
IF (.NOT.PUNCH) GO TO 550
WRITE (NOUT,530)
530 FORMAT (/10X,'AND DON''T FORGET TO PICK UP YOUR PUNCHED CARDS')
IF (SITE .NE. BLNK8) WRITE (NOUT,535) SITE
IF (SITE.EQ.BLNK8 .AND. MACH.NE.VAX) WRITE (NOUT,540)
IF (SITE.EQ.BLNK8 .AND. MACH.EQ.VAX) WRITE (NOUT,545)
535 FORMAT (10X,'WHEN YOU SIGN OFF',22X,'SITE-ID: ',A8)
540 FORMAT (10X,'AT THE CENTRAL-SITE')
545 FORMAT (10X,'IN FORTRAN FILE FOR007.DAT')
550 IF (FNAME(1) .EQ. BLNK8) GO TO 570
IF (MACH .EQ. UNIVAC) FOROO3 = TPF
IF (MACH .EQ. CDC) FOROO3 = TAPEO3
WRITE (NOUT,555)
555 FORMAT (//10X,'A COPY OF YOUR ACTUAL INPUT CARDS WAS SAVED IN')
IF (MACH .NE. VAX) WRITE (NOUT,560) FOROO3
IF (MACH .EQ. VAX) WRITE (NOUT,565)
560 FORMAT (1H+,56X,'FORTRAN FILE - ',A8)
565 FORMAT (10X,'FORTRAN FILE FOR003.DAT')
570 IF (ICNTL .NE. 0) WRITE (NOUT,575)
575 FORMAT (/4X,'*** WARNING - CANCELLED CARDS IN PUNCHED DECK NEED ',
1 'TO BE REMOVED', /19X,'OR MODIFIED BEFORE USE')
IF (FNAME(1) .NE. BLNK8) DORK = KEEP
CLOSE (UNIT=LU ,STATUS=DORK)
CLOSE (UNIT=LOUT,STATUS=DORK)
IF (DORK.EQ.KEEP .OR. (PUNCH .AND. MACH.EQ.VAX)) WRITE (NOUT,585)
585 FORMAT (/4X,'*** DON''T FORGET TO DELETE YOUR FILES GENERATED BY',
1 ' THIS RUN ***')
WRITE (NOUT,590)
590 FORMAT (/26X,'*** JOB DONE ***',/)
600 CONTINUE
END
|
