FTN4
      PROGRAM TMPG0(5),92903-16452 REV.1913  790119 
C 
C 
C     NAME:   TMPG0 
C     SOURCE: &TMPG0     92903-18452
C     RELOC:  %TMPG0     92903-16452
C 
C     PGMR: DANIEL POT / FRANCOIS GAULLIER   HPG
C 
C 
C     **************************************************************
C     * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    *
C     * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C     * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C     * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
C     **************************************************************
C 
C 
C 
C     ************************************************************* 
C     *                                                           * 
C     *     THIS IS THE FIRST SEGMENT OF  TMPGN                   * 
C     *                                                           * 
C     *     THIS SEGMENT IS CALL TO ANALYSE THE ANSWER TO THE     * 
C     *     MENU SCREEN OR AT THE END OF EACH TASK TO REQUEST     * 
C     *     THE NEXT ONE.                                         * 
C     *     THIS SEGMENT TAKES CARE ALSO OF ALL FATAL ERRORS.     * 
C     *                                                           * 
C     ************************************************************* 
C 
C 
C     STOP USED:  4 - 5 - 7 - 10 - 11 - 13 - 14 - 15 - 16 - 17 - 20 
C     ----------
C 
C 
C     IRQFLG(30) = NCRTH COMMON STATUS : 0 IF EMPTY, 1 IF FULL
C                  (NOT USED IN TMPGN)
C 
C 
C-----LABEL COMMON # 1  GENERAL INFORMATION 
C 
      COMMON /TMGC1/LU,LUPRT,LUOUT,ISYTP,ISCRN,IOFST,IEND,IJOB
C 
C-----LABEL COMMON # 2  FLAGS 
C 
      COMMON /TMGC2/ITMFL,IRQFLG(30),IMOTR(9),IVASC0(9) 
C 
C-----LABEL COMMON # 3  BUFFER AREA 
C 
      COMMON /TMGC3/IREFC,IDUM0(6),NCRTH(1) 
C 
C-----LABEL COMMON # 4  BUFFER USED IN CREATION PHASE & ERROR FLAG
C                       AND LINE BUFFER OF 90 WORDS MAX 
C 
      COMMON /TMGC4/IERFL,IERNB,IERTN,IERMS(7),LINEBU(1)
C 
C 
      DIMENSION NAME(3),IREG(2),IDCB(144),FNAME(3)
      DIMENSION ITEMP(3),IRSET(8),IPRES(26) 
C 
      INTEGER FNAME,OPEN,PURGE,AREG,BREG,FTYPE
      EQUIVALENCE (REG,IREG,AREG),(IREG(2),BREG)
C 
      LOGICAL JPAR,KPAR,ISBTW,OKABT,GETBK,OKABT,CMPB
      LOGICAL READF,WRITF,CREAT,RWNDF,DORMT 
C 
      DATA IRSET/15530B,15555B,15446B,2Hk0,2HB ,15542B,15510B,15512B/ 
      DATA IPRES/15542B,6412B,6412B,15446B,2Ha+,2H47,2HC ,15446B
     .,2HdJ,2HPr,2Hes,2Hs ,15446B,2HdK,2HNE,2HXT,2H S,2HCR,2HEE 
     .,2HN ,15446B,2HdJ,2Hke,74433B,2H&d,2H@ /
      DATA FNAME/2H& ,2H  ,2H  /
      DATA FTYPE/31/
D     DATA LUOXXX/40/ 
      DATA MAXCOP/2/
C 
      KPAR(IP1,IP2,IP3)=JPAR(LINEBU,LENSC0,IDXX,IP1,IP2,IFLG,IP3) 
C 
C-----TERMINATE  TMPGN ?
C 
D     WRITE(LUOXXX,9877)ISYTP,ISCRN,IOFST,IEND,IJOB 
D9877 FORMAT(2/" $OPSY="I3",  SCREEN# ="I2",  IOFST="I5",  IEND="I4,
D    .",  IJOB="I4) 
C 
      IF(IEND .EQ. 2)  GOTO 9900
C 
C-----SYSTEM TYPE OK ?  (RTE-IV ONLY) 
C 
      IF(ISYTP.NE.-9)  GOTO 9900
C 
C     JOB ? 
C 
      IF(IJOB.EQ.2) GOTO 300
      IF(IJOB.EQ.4) GOTO 270
C 
C-----ANALYSE SFK OR MENU SCREEN (#8 OR #6 OR #7) 
C 
      IDXX=1
      NERR=-IEND
      IF(NERR .EQ. 0)  GOTO 10
C 
5     CALL TMPGE(NERR,IDXX,IASC(IGET(1653B))) 
C 
C-----GET DATA FROM THE 2645/2648 TERMINAL
C 
10    LENSC0=0
      IF(ISCRN .EQ. 6)  LENSC0=9
      IF(ISCRN .EQ. 7)  LENSC0=4
      IF(ISCRN .EQ. 8)  LENSC0=2
      IF(LENSC0 .EQ. 0)  STOP 0004
C-----IF GET FAIL, RE-ISSUE THE SCREEN (MENU) 
      IF( GETBK(LU,LINEBU,LENSC0) )  GOTO 198 
C 
C     IMOTR(1) = TMPGN FUNCTION 
C     IMOTR(2) = LOAD OPTION
C     IMOTR(3) = PRINT LOAD MAP (0 DO NOT PRINT)
C     IMOTR(4) =
C     IMOTR(5) =
C     IMOTR(6) = APPLICATION NAME 
C     IMOTR(8) = SECURITY CODE  (ALWAYS 0)
C     IMOTR(9) = CARTRIDGE #
C 
C-----ANALYSE USER'S ANSWER 
C 
      IF(ISCRN .EQ. 8)  GOTO 60 
      IEND=0
      IF( ISCRN .EQ. 6 )  GOTO 40 
C 
C-----MODIFICATION OF THE TMP IS PERFORMED, FUNCTION SELECTED ? 
C 
      IMOTR=0 
      IDXX=1
      IF(KPAR(ITEMP,1,JVAL)) GOTO 195 
      NERR=1
      IF(IFLG.NE.3) GOTO 5
      IF(ITEMP .EQ. 2HM ) IMOTR=1 
      IF(ITEMP .EQ. 2HT ) IMOTR=2 
      IF(ITEMP .EQ. 2HU ) IMOTR=4 
      IF(ITEMP .EQ. 2HL ) IMOTR=6 
      IF(ITEMP .EQ. 2HK ) IMOTR=7 
      IF(ITEMP .EQ. 2HI ) IMOTR=8 
      IF(IMOTR .EQ. 0)  GOTO 5
      IVASC0(3)=ITEMP 
      GOTO 56 
C 
C-----CREATION OF A NEW TMP IS PERFORMED, 
C     INITIALIZE  NCRTH  IN PACKED FORMAT WITH BLANK OR 0 
C 
40    CONTINUE
C 
C========================================= SPECIAL TMPGN
C 
C     SET UP SYSTEM MODULE:  ZTMP, TSE, STORA, STORB, TSMG
C     INTO 2 USER PARTITION 
C 
C     UPT 1:  ZTMP, TSE, STORA, STORB 
C             NO PARTITION SIZE, NO PARTITION ASSIG.
C 
C     UPT 2:  TSMG
C             PARTITION SIZE, NO PARTITION ASSIG. 
C 
C 
      K=6 
C 
C-----FIXED PART INITIALISATION 
C 
      CALL MOVEW(IMOTR(6),NCRTH(5),4) 
      CALL NUL(NCRTH(9),9)
      CALL MOVEW(14HZTMP    TSE   ,NCRTH(18),7) 
      NCRTH(21)=67
      NCRTH(25)=0 
      CALL NUL(NCRTH(26),74)
      CALL MOVEW(20HTMP REV.1913        ,NCRTH(87),10)
C 
C     INTERACTIVE AND AUXILIARY LU
C     (1 DUMMY INTERACTIVE DEVICE & 3 AUXILIARY DEVICES)
C 
      I=IREFC 
      NCRTH(2)=I
      NCRTH(I)=00 
      NCRTH(I+1)=3070 
      I=I+2 
      NCRTH(3)=I
      NCRTH(I)=LU 
      NCRTH(I+1)=2645 
      NCRTH(I+2)=2
      NCRTH(I+3)=7905 
      NCRTH(I+4)=3
      NCRTH(I+5)=7905 
      I=I+6 
      NCRTH(4)=I
C 
C-----PROGRAMS
C 
      NCRTH(I+1)=0
      NCRTH(I+2)=0
      CALL MOVEW(24HTSE   STORA STORB IOM70 ,NCRTH(I+3),12) 
      NCRTH(I)=I+15 
      I=NCRTH(I)
      NCRTH(I+1)=0
      NCRTH(I+2)=0
      CALL MOVEW(6HTSMG  ,NCRTH(I+3),3) 
      NCRTH(I)=I+6
      I=NCRTH(I)
      NCRTH(I+1)=0
      NCRTH(I+2)=0
      CALL MOVEW(18HZTMP  OFLPO IOM75 ,NCRTH(I+3),9)
      NCRTH(I)=I+12 
      NCRTH=NCRTH(I)-1
C 
C========================================= END SPECIAL TMPGN
C 
C-----CREATION OF A NEW TMP, GET THE CR#
C 
      IMOTR=1 
      IDXX=1
      IF(KPAR(ITEMP,6,IMOTR(9))) GOTO 195 
      IF(IFLG .EQ. 0)  GOTO 55
      NERR=5
      IF(IFLG .NE. 3)  GOTO 52
      IF(ISUPB(ITEMP,3) .NE. 1)  GOTO 5 
      IMOTR(9)=ITEMP
      GOTO 54 
52    IF(IFLG.NE.1) GOTO 5
      IF(IMOTR(9) .EQ. 100000B)  GOTO 5 
C 
C-----CARTRIDGE MOUNTED ? 
C 
54    NERR=35 
      IF(ICRLU(IMOTR(9)) .LT. 0) GOTO 5 
55    NCRTH(8)=IMOTR(9) 
C 
C-----GET THE LOGGING LU #
C 
56    IDXX=2
      JVAL=0
      IF( KPAR(ITEMP,2,JVAL) )  GOTO 195
      IF(IFLG .EQ. 0)  GOTO 58
      NERR=2
      IF(IFLG .NE. 1)  GOTO 5 
      NERR=44 
      IF(ISBTW(JVAL,1,IGET(1653B)) )  GOTO 5
      NERR=9
      IEQT=IAND(IGET(IGET(1652B)+JVAL-1),77B) 
      IF(IEQT .EQ. 0)  GOTO 5 
      IF(IAND(IGET(IGET(1650B)+((IEQT-1)*15)+4),37400B)/256 
     .   .NE. 23B)  GOTO 5
58    NCRTH(13)=JVAL
      GOTO 200
C 
C-----ANALYSE KEY MAP SCREEN
C     VERIFY THAT THE TMP IS NOT CURRENTTLY RUNNING 
C     TRY TO OPEN THE FILE TO KNOW IF IT IS A CREATE/MODIFY REQUEST 
C 
60    IF(IEND.NE.0 .AND. IEND.NE.-33)  GOTO 9900
      IEND=0
      CALL MOVEW(IMOTR(6),ITEMP,2)
      ITEMP(3)=2H 
      NERR=4
      IF( .NOT. DORMT(ITEMP))  GOTO 97
      IDXX=1
      IF( KPAR(ITEMP,1,JVAL) .AND. IFLG.EQ.9)  GOTO 197 
      IF(IFLG .NE. 0)  GOTO 198 
      IMOTR(9)=0
      CALL MOVCA(IMOTR,11,FNAME,2,4)
      IF(OPEN(IDCB,IERR,FNAME,3,IMOTR(8),IMOTR(9)).GE.0) GOTO 65
C-----IF FILE DOESNT EXIT, INIT NCRTH & CREATE TE NEW TMP 
      IF( IERR .NE. -6 )  GOTO 64 
C 
C-----THE FILE DOESNT EXIST, IT IS A CREATION 
C 
      ISCRN=6 
      CALL NUL(IVASC0,2)
      IVASC0(3)=2H
      GOTO 198
C 
C-----THE FILE EXIST, VERIFY IF IT IS A GOOD ONE
C 
64    NERR=6
      IF(IERR.EQ.-7) GOTO 97
      STOP 0005 
C 
65    NERR=38 
      IF(IERR .NE. FTYPE) GOTO 95 
C 
C-----READ FILE INTO NCRTH
C 
      I=1 
80    IF(READF(IDCB,IERR,NCRTH(I),200,LEN)) STOP 0007 
      I=I+LEN 
      IF(LEN .NE. -1)  GOTO 80
C 
C-----CHECK THAT THE FILE IS OK 
C 
      IF(NCRTH .NE. I) GOTO 95
      IF(NCRTH(8) .EQ. 0)  NCRTH(8)=ICRLU(-IAND(IDCB,77B))
      IF(IMOTR(9) .LE. 0)  IMOTR(9)=NCRTH(8)
      IF(NCRTH(8) .NE. IMOTR(9))  GOTO 95 
C 
C-----OK, WRITE IT BACK TO CHECK NOW THE SECURITY CODE
C 
      IF(RWNDF(IDCB,IERR)) STOP 0010
      NERR=6
      I=NCRTH/128 
      LEN=128 
      IF(I.EQ.0) LEN=NCRTH
      IF( .NOT. WRITF(IDCB,IERR,NCRTH,LEN) ) GOTO 85
      IF(IERR.EQ.-7) GOTO 95
      CALL CLOSE(IDCB)
      STOP 0011 
85    CALL CLOSE(IDCB)
C-----INIT FLAG TO NOT PREPARE AND NOT LOAD ANY PROGRAM 
      DO 88 I=1,28
88    IRQFLG(I)=0 
C 
C-----SINCE THE FILE EXIST AND IS CORRECT, IT IS A MODIFY 
C 
      ISCRN=7 
      IVASC0=NCRTH(8) 
      IVASC0(2)=NCRTH(13) 
      IVASC0(3)=2H
      GOTO 198
C 
C-----ERROR ON THE FILE ALREADY OPEN, CLOSE IT AND REPORT ERROR 
C 
95    CALL CLOSE(IDCB)
C-----OUTPUT/RE-OUTPUT SCREEN, PRINT THE ERROR MESSAGE AND THEN READ
97    CALL TMGSC(3,ISCRN,0,-NERR) 
C 
C-----SPECIAL CHARACTER FROM THE 2645/2648
C     PREVIOUS SCREEN OR ABORT ?
C 
195   NERR=33 
      IF(IFLG .EQ. 8)  GOTO 97
      NERR=34 
      IF(IFLG .NE. 9)  GOTO 5 
C 
C-----USER WANTS TO ABORT ? 
C 
197   IF(OKABT(LU))  GOTO 9900
C 
C-----IT IS NOT ABORT REQUEST, RE-ISSUE THE SCREEN
C 
198   CALL TMGSC(3,ISCRN) 
C 
C*********************************************************************
C 
C 
C-----PROCESS THE REQUESTED FUNCTION
C 
200   IVASC0=NCRTH(8) 
      IVASC0(2)=NCRTH(13) 
      IVASC0(9)=ISCRN 
C 
C-----SET-UP SEGMENTS' PARAMETERS 
C 
      ISEGNB=5
      IRQ=0 
      IJOB=0
C 
C     *****     LIST ?
C 
      IF(IMOTR .EQ. 6)  GOTO 278
C 
C     *****     PURGE ? 
C 
      IF(IMOTR .NE. 7)  GOTO 210
      IVASC0(2)=0 
      IVASC0(9)=6 
      IEND=3
      GOTO 238
C 
C     *****     MODIFY LU ? 
C 
210   IF(IMOTR .EQ. 2)  GOTO 223
C 
C     *****     MODIFY / CREATE REQUEST ? 
C 
      IF(IMOTR .NE. 1)  GOTO 215
      K=2 
213   DO 218 I=K,28 
218   IRQFLG(I)=1 
      GOTO 223
C 
C     *****     DEFINE USER WRITTEN MODULES ? 
C 
215   IF(IMOTR .NE. 4) GOTO 220 
      IJOB=3
      K=5 
      GOTO 213
C 
C     *****     MODIFY MAIN PROGRAM ? 
C 
220   IF(IMOTR .NE. 3) GOTO 227 
223   IRQFLG=1
      NBPRO=NBUPT(NCRTH)
      CALL DEPAK
C-----EDITING PROCESSING, CALL SEG # 5 OR 4,
C     (LU & PRG.  OR  DATA-BASE & MAIN / RELOAD SOME PARTITION) 
      CALL TMGSC(ISEGNB,0,0,0,IJOB) 
C 
C     *****     MODIFY DATA-BASE DEFINITON ?
C 
227   IF(IMOTR .NE. 8)  GOTO 230
      ISEGNB=4
      IRQFLG(2)=1 
      GOTO 223
C 
C     *****     PREPARE AND LOAD ALL THE APPLICATION ?
C 
230   IF(IMOTR .NE. 5)  STOP 0013 
      DO 232 I=1,28 
232   IRQFLG(I)=1 
C-----CALL PREP. MODULE 
C     (STOP THE APPLT., PREP. FILES AND LOAD AS REQUESTED)
235   IF(IMOTR(2) .EQ. 1)  GOTO 900 
      IRQ=1 
238   CALL TMGSC(2,IRQ,0,IEND,4)
C 
C-----RETURN FROM THE COMPILER, THE LISTING, THE PURGE OR 
C     THE LOAD OPERATION. 
C 
270   IF(IEND .EQ. -1)  GOTO 420
      IF(IEND .EQ. -2)  GOTO 280
      IF(IEND .EQ.  1)  GOTO 900
      IF(IEND .NE.  0)  GOTO 450
C-----PREP. WAS OK, LOAD PROGRAMS.
      IRQ=1 
278   CALL TMGSC(1,IRQ,0,0,4) 
C-----LOAD HAS FAIL, STOP TMPGN OPERATION 
280   CALL MOVEW(16H Loading ERROR  ,LINEBU,8)
      CALL MOVEW(IERMS(3),LINEBU(9),2)
      CALL MOVEW(16H, Program       ,LINEBU(11),8)
      CALL MOVEW(IERMS(5),LINEBU(16),3) 
      CALL MOVEW(22H has not been loaded. ,LINEBU(19),11) 
      LINEBU(30)=6412B
      CALL BLANC(LINEBU(31),8)
      GOTO 440
C 
C-----RETURN FROM THE INTERACTIVE EDITING PROCESSING, 
C     FUNCTION MUST BE 1,2,3,4 OR 8 AND IEND=1 TO BE THE END
C     (REPACK, WRITE THE FILE AND LOAD IF NEEDED) 
C 
300   IF( IEND .NE. 1 )   STOP 0014 
      IF(IMOTR.NE.1 .AND. IMOTR.NE.2 .AND. IMOTR.NE.3 
     .  .AND. IMOTR.NE.4 .AND. IMOTR.NE.8 )  STOP 0015
      CALL REPAK
      CALL MOVCA(NCRTH,9,FNAME,2,4) 
C 
C========================================= SPECIAL TMPGN
C 
C     SETUP PARTITION SIZE FOR ALL SYSTEM MODULE
C 
C     MAIN = CODE SIZE + BUFFER + EMA 
C 
      ICODZ=8 
      CALL MADSP(ITEMP) 
      N=(NCRTH(4)-NCRTH(2))/2 
C-----EMA SIZE = 1.6 * N + ( N ** 2 ) / 75. 
C     MINIMUM IS 5
      I= 0.5 + 1.6*N*(075.+N)/75. 
      IF(I .LT. 5)  I=5 
C-----MSEG SIZE = 3 + EMA / 50
      J=3+I/50
C-----BUFFER SIZE IN WORDS = ( STACKLEN + 200 ) * N 
      K= (NCRTH(21)+200)*N
C-----CHECK THAT MAXIMUM ADDR SPACE IS OK 
C     CODE SIZE + BUFFER + MSEG + 1  = <  MAX ADDR. SPACE 
      K= ICODZ + 1 + K/1024 
      IF(K+J+1 .GT. ITEMP(2))  K=ITEMP(2)-J-1 
C-----SET EMA SIZE AND MSEG SIZE
      NCRTH(9)=I
      NCRTH(10)=J 
C-----SET PARTITION SIZE = CODE + BUFFER
      NCRTH(11)=K 
C 
C     TMP.B = 5K  +  .350 * NUMBER OF TRANS. SPEC.
C 
      X=5.+.35*25.
      I=NCRTH(NCRTH(4)) 
      NCRTH(I+1)=IFIX(X)+1
C 
C     IMAGE = CODE SIZE + LOCK TABLE + ROOT FILE + IMAGE DCB
C                12 K   + LCKTB SIZE +           4K 
C 
      IF(NCRTH(26) .EQ. 0)  GOTO 340
      J=27
      DO 320 I=1,NCRTH(26)
      NCRTH(J+12)=(12288.+FLOAT(NCRTH(J+14))+4000.)/1000
320   J=J+15
C 
C-----REINIT THE CRT AUXILIARY LU TO THE CRT USED BY TMPGN
C 
340   NCRTH(NCRTH(3))=LU
C 
C-----IF TMP # 1, SET SYSTEM COMMON FLAG FOR ALL UPT
C 
      IF( NCRTH(6) .NE. 2HP1 )  GOTO 360
      J=NCRTH(4)
  350 CALL SETBT(NCRTH(J+2),15,1) 
      J=NCRTH(J)
      IF(J .NE. NCRTH+1)  GOTO 350
  360 CONTINUE
C 
C========================================= END SPECIAL TMPGN
C 
      IF(OPEN(IDCB,IERR,FNAME,1,NCRTH(7),NCRTH(8)).EQ.31) GOTO 303
      IF(IERR.NE.-006) STOP 0015
      IF(CREAT(IDCB,IERR,FNAME,2,FTYPE,NCRTH(7),NCRTH(8))) GOTO 400 
303   I=NCRTH/128 
      IF(I.EQ.0) GOTO 309 
      DO 307 K=1,I
      IF(WRITF(IDCB,IERR,NCRTH((128*K)-127),128)) STOP 0016 
307   CONTINUE
309   LEN=(NCRTH)-(128*I) 
      IF(WRITF(IDCB,IERR,NCRTH((128*(I+1))-127),LEN)) STOP 0017 
      IF(WRITF(IDCB,IERR,NCRTH,-1)) STOP 0020 
      CALL CLOSE(IDCB)
C-----RE-INIT  SCREEN DATA & IMOTR  WITH  &XXXX:SC:CR  FROM NCRTH 
      IVASC0(9)=7 
      CALL MOVEW(NCRTH(5),IMOTR(6),4) 
      IF(IMOTR.NE.1 .AND. IMOTR.NE.4)  GOTO 316 
C-----IF THE NUMBER OF PROGRAM HAS DECREASE, CLEAN UP UNUSED MODULE 
      IF(NBPRO .EQ. 0)  GOTO 316
      IF(NBPRO .LE. NBUPT(NCRTH))  GOTO 316 
      CALL MOVEW(IRSET,LINEBU,8)
      CALL MOVEW(26H Clean up unused modules. ,LINEBU(9),13)
      CALL EXEC(2,LU,LINEBU,21) 
      IRQ=2 
      IEND=4
      GOTO 238
316   NBPRO=NBUPT(NCRTH)
C-----ANY PROGRAM TO PREPARE AND LOAD ? 
      DO 318 I=1,28 
      IF(IRQFLG(I) .NE. 0)  GOTO 235
318   CONTINUE
C-----GO BACK TO SCREEN # 0  (MENU) 
      GOTO 900
C 
C-----NO ROOM ON THE CARTRIDGE !! 
C 
400   CALL MOVEW(FNAME,LINEBU(24),3)
      CALL MOVEW(IRSET,LINEBU,8)
      GOTO 430
420   CALL MOVEW(IERMS,LINEBU(20),7)
      CALL BLANC(LINEBU,7)
      LINEBU(8)=6412B 
      IF(IERNB .EQ. -6)  GOTO 430 
C 
C-----FATAL FMP ERROR DURING CREATION PHASE 
C 
      CALL MOVEW(22H  Illegal file type on,LINEBU(9),11)
      IF(IERNB .GT. 0)  GOTO 427
      CALL MOVEW(22H FMP ERROR # XXXXXX on,LINEBU(9),11)
      CALL JASC(IERNB,LINEBU(15),1,7) 
427   CALL MOVEW(22H !!                   ,LINEBU(27),11) 
      GOTO 438
430   CALL MOVEW(14H NO ROOM on CR,LINEBU(9),7) 
      CALL CNUMD(NCRTH(8),LINEBU(16)) 
      CALL MOVEW(10H ,  file: ,LINEBU(19),5)
      CALL MOVEW(22H has not been created.,LINEBU(27),11) 
438   LINEBU(38)=6412B
440   LINEBU(39)=6412B
      CALL MOVEW(30H generation is NOT completed, ,LINEBU(40),15) 
      CALL MOVEW(32Hcorrective action MUST be taken.,LINEBU(55),16) 
      CALL EXEC(2,LU,LINEBU,70) 
      IEND=0
C-----WAIT ACKNOWLEDGMENT FROM THE OPERATOR 
450   CALL EXEC(2,LU,IPRES,26)
      REG= EXEC(1,LU,I,1) 
      IF(IEND .EQ. 4)  GOTO 316 
      ISCRN=IVASC0(9) 
      IF(BREG.EQ.1 .AND. IGET1(I,1).EQ.60440B)  GOTO 197
      GOTO 900
C 
C     END TMPGN 
C 
900   CONTINUE
9900  CALL MOVEW(IRSET,LINEBU,8)
      CALL MOVEW(14H /TMPGN: $END ,LINEBU(9),7) 
      CALL PNAME(LINEBU(10))
      LINEBU(12)=IOR(LINEBU(12),72B)
      CALL EXEC(2,LU,LINEBU,8)
C-----TRY TO SCHEDULE 'DCMON',  ATTENTION TO ABORT RETURN 
      CALL EXEC(100000B+24,6HDCMON ,LU,0,0,0,0) 
      GOTO 9920 
9918  GOTO 9950 
C-----DCMON NOT LOADED, PRINT "/TMPGN: $END"
9920  CALL EXEC(2,LU,LINEBU(9),7) 
C 
C-----RELEASE TRACKS
C 
9950  CALL EXEC(5,-1) 
C 
C-----TERMINATE PROGRAM 
C 
      CALL EXEC(6)
C     DUMMY CALL TO MAIN !! 
      CALL TMPGN
      END 
      END$