C----------------------------------------------------------------------------- C Program: R E S C T L C C Purpose: Restores saved answer files. C C Author: Han Lasance C Digital Equipment B.V., Utrecht, Holland C for Neurophysiology Group, Organon Intern.B.V., Oss, Holland C C Date: Nov-81 C C Language: Fortran-77 C C Modified by: Name Date Ident. Version C Jan H. Belgraver 24-Mar-89 JB01 V1.1 C Completed DOC-header, F77 style, and annotated. C C Calls to: CLOSE, OPEN, SPAWN, STOPFR C C Event flags: Number Description C 1 Used by SPAWN C C LUNs: Number Description C 1 .SAV saved answer_files file C 2 .CTL answer_files C 5 Terminal input C 6 Terminal output C C Description: RESCTL is used to restore .CTL answer files that were saved C in a .SAV file while running programs in Use-mode. C C----------------------------------------------------------------------------- PROGRAM RESCTL LOGICAL*1 STR(80), 1 SAVNAM(30), 2 CTLNAM(30), 3 TSKNAM(6), 4 CMD(34), 5 YN, 6 DUM INTEGER IESB(8) REAL MCR DATA MCR /6RMCR.../ DATA CMD /'P','I','P',' ',30*0/ EQUIVALENCE (CTLNAM(1), CMD(5)) WRITE (6,10) 10 FORMAT (/'$ENTER FILENAME: ') READ (5,20,END=1000) NCH,(SAVNAM(I),I=1,NCH) 20 FORMAT (Q,30A1) SAVNAM (NCH+1)=0 OPEN (UNIT=1,NAME=SAVNAM,TYPE='OLD',READONLY) READ (1,25,END=1000) NCH,(STR(I),I=1,NCH) 25 FORMAT (Q,80A1) WRITE (6,23) (STR(I),I=1,NCH) 23 FORMAT (/' FILE ID: ',<NCH>A1//'$CONTINUE? [Y/N]: ') READ (5,24,END=1000) YN 24 FORMAT (A1) IF (YN.NE.'Y') GO TO 1000 READ (1,25,END=1000) NCH,(STR(I),I=1,NCH) DO 30 I=1,30 IF (SAVNAM(I).NE.0.AND.SAVNAM(I).NE.'.') GO TO 30 CTLNAM(I)='.' CTLNAM(I+1)='C' CTLNAM(I+2)='T' CTLNAM(I+3)='L' NI=I+4 CTLNAM(I+4)=';' CTLNAM(I+5)='*' CTLNAM(I+6)='/' CTLNAM(I+7)='D' CTLNAM(I+8)='E' GOTO 35 30 CTLNAM(I)=SAVNAM(I) 35 WRITE (6,36) (CTLNAM(I),I=1,NI-1) 36 FORMAT (/'$DELETE ALL VERSIONS OF ',<NI-1>A1,'? [Y/N]: ') READ (5,24,END=1000) YN IF (YN.NE.'Y') GO TO 40 325 CALL SPAWN (MCR,,,1,,IESB,,CMD,NI+8,,,IDS) IF (IDS.EQ.1) GO TO 340 327 WRITE (6,330) IDS,IESB(1) 330 FORMAT (/' *** WARNING *** UNABLE TO DELETE FILES -- DSW: ',I4, $', EXIT STATUS: ',I2/'$',16X,'TRY AGAIN? [Y/N]: ') READ (5,24,END=1000) YN IF (YN.EQ.'Y') GO TO 325 GOTO 40 340 CALL STOPFR(1) IF (IESB(1).NE.1) GO TO 327 40 CTLNAM(NI)=0 42 OPEN (UNIT=2,NAME=CTLNAM,TYPE='NEW',CARRIAGECONTROL='LIST') WRITE (2,25) NCH,(STR(I),I=1,NCH) DO 45 I=7,12 45 TSKNAM(I-6)=STR(I) ITEL = 1 50 READ (1,25,END=200) NCH,(STR(I),I=1,NCH) DO 70 I=1,5 70 IF (STR(I).NE.'*') GO TO 100 DO 80 I=14,18 80 IF (STR(I).NE.'*') GO TO 100 CLOSE (UNIT=2) WRITE (6,90) TSKNAM,ITEL 90 FORMAT (/' ANSWER FILE OF TASK ',6A1,' HAS',I4,' RECORDS') GOTO 42 100 WRITE (2,25) NCH,(STR(I),I=1,NCH) ITEL = ITEL+1 GOTO 50 200 CLOSE (UNIT=2) WRITE (6,90) TSKNAM,ITEL 1000 STOP END