FTN4
      PROGRAM TMPG4(5),92080-16456 REV.2026  800502       
C 
C 
C     NAME:   TMPG4 
C     SOURCE: &TMG4A    92080-18456 
C     RELOC:  %TMG4A    92080-16456 
C 
C     PGMR:   DANIEL POT/FRANCOIS GAULLIER    HPG 
C 
C 
C     **************************************************************
C     * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  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 PROGRAM HANDLES SCREEN # 4 USING AN INTERACTIVE     *
C     *   DIALOGUE ON A 2645/2648 TERMINAL.                        *
C     *   DEFINITION OF THE IMAGE DATA-BASE                        *
C     *                                                            *
C     **************************************************************
C 
C     STOP USED:  4000 - 4010 
C     ----------
C 
C 
C     IJOB = 2   THE SCREEN HAS BEEN PRINT, READ AND ANALYSE ANSWER 
C     IJOB = 0   DO IMAGE & MAIN PROG DEFINITION
C 
C     IEND = 0 : CURRENT INTERACTIVE PROCESS
C     IEND = 1 : END OF INTERACTIVE PROCESS 
C     IEND = 2 : ABORT TMPGN PROGRAM
C     IEND = 3 : PREVIOUS FAMILY SCREEN 
C 
C 
CCB1
C*********************************************************************
C 
C-----LABELED COMMON # 1  GENERAL INFORMATION 
C 
      COMMON /TMGC1/LU,LUPRT,LUOUT,ISYTP,IPARAM(5)
C 
C     LU     - USER TERMIAL LU
C     LUPRT  - LISTING LU 
C     LUOUT  - NOT USED 
C     ISYTP  - SYSTEM TYPE (MUST BE .EQ. -9, RTE-IV)
C     IPARAM - TMSGN OPERATING PARAMETERS:
C              ISCRN  - CURRENT SCREEN NO.
                        EQUIVALENCE (ISCRN,IPARAM(1)) 
C              IOFST  - OFFSET INTO BUFFER NCRTH
                        EQUIVALENCE (IOFST,IPARAM(2)) 
C              IEND   - INTERACTIVE OPERATION INDICATOR 
C                       0 - CURRENT PROCESS 
C                       1 - END OF PROCESS
C                       2 - ABORT TMSGN 
C                       3 - PREVIOUS SCREEN 
                        EQUIVALENCE (IEND,IPARAM(3))
C              IJOB   - TMS FUNCTION INDICATOR
C                       0 - DEFINE (INT. AND AUX. LU'S, AND T.U.S.) 
C                       1 - SCREEN HAS BEEN PRINTED, PERFORM ANALYSIS 
C                       3 - DEFINE T.U.S. INTO USER PARTITION 
                        EQUIVALENCE (IJOB,IPARAM(4))
C 
C*********************************************************************
CCB1
C 
C 
C 
CCB2
C*********************************************************************
C 
C-----LABELED COMMON # 2  FLAGS 
C 
      COMMON /TMGC2/ITMFL,IRQFLG(30),IMOTR(9),IVASC0(9) 
C 
C     ITMFL  -
C     IRQFLG - LOAD FLAGS 
C     IMOTR  - BUFFER FOR TMS INFORMATION:
C              IMOFNC - TMS OPERATION CODE
C                       1 - CREATE/MODIFY 
C                       2 - MODIFY LU # 
C                       3 - MODIFY MAIN PROG
C                       4 - RELOAD TMS-SUBROUTINES
C                       5 - LOAD AN APPLICATION 
C                       6 - LIST
C                       7 - PURGE APPLICATION 
C                       8 - END TMSGN 
                        EQUIVALENCE (IMOFNC,IMOTR(1)) 
C              IMOLOA - LOAD OPTION (SCREEN 0)
C                       1 - NO LOAD 
C                       2 - BACKGROUND TEMPORARILY
C                       3 - BACKGROUND REPLACEMENT
C                       4 - BACKGROUND ADDITION 
C                       5 - REAL TIME TEMPORARILY 
C                       6 - REAL TIME REPLACEMENT 
C                       7 - REAL TIME ADDITION
                        EQUIVALENCE (IMOTR(2),IMOLOA) 
C              IMOMAP - LOADER MAP OPTION 
                        EQUIVALENCE (IMOTR(3),IMOMAP) 
C              IMOFLG - SEARCH %TMSLB FLAG
                        EQUIVALENCE (IMOTR(4),IMOFLG) 
C              IMONAM - APPLICATION NAME
                        DIMENSION IMONAM(2) 
                        EQUIVALENCE (IMOTR(6),IMONAM(1))
C              IMOSEC - SECURITY CODE 
                        EQUIVALENCE (IMOTR(8),IMOSEC) 
C              IMOCRN - CARTRIDGE NUMBER
                        EQUIVALENCE (IMOTR(9),IMOCRN) 
C     IVASC0 - DISPLAY BUFFER FOR SCREEN INFORMATION
C 
C*********************************************************************
CCB2
C 
C 
C 
CCB3
C*********************************************************************
C 
C-----LABELED COMMON # 3  BUFFER AREA 
C 
      COMMON /TMGC3/IREFC,ILUGH,INTMS,ILPRG,IDECL,ILGMX,NBPRO 
     .             ,NCRTH(2540) 
C 
C     IREFC  -
C     ILUGH  -
C     INTMS  -
C     ILPRG  -
C     IDECL  -
C     ILGMX  -
C     NBPRO  -
C     NCRTH  - OUTPUT FILE BUFFER:
C              NCNOWD - NO. OF WORDS IN FILE
                        EQUIVALENCE (NCNOWD,NCRTH(1)) 
C              NCINLU - BUFFER ADDR OF INTERACTIVE LU TABLE 
                        EQUIVALENCE (NCINLU,NCRTH(2)) 
C              NCAXLU - BUFFER ADDR OF AUX LU TABLE 
                        EQUIVALENCE (NCAXLU,NCRTH(3)) 
C              NCPAR1 - BUFFER ADDR OF FIRST PARTITION
                        EQUIVALENCE (NCPAR1,NCRTH(4)) 
C              NCNAME - APPLICATION NAME (2 WDS)
                        DIMENSION NCNAME(2) 
                        EQUIVALENCE (NCNAME,NCRTH(5)) 
C              NCSCOD - SECURITY CODE 
                        EQUIVALENCE (NCSCOD,NCRTH(7)) 
C              NCCRNO - CARTRIDGE NO. 
                        EQUIVALENCE (NCCRNO,NCRTH(8)) 
C              NCEMAS - EMA SIZE IN KWDS
                        EQUIVALENCE (NCEMAS,NCRTH(9)) 
C              NCMSEG - MSEG SIZE IN KWDS 
                        EQUIVALENCE (NCMSEG,NCRTH(10))
C              NCPARS - PARTITION SIZE IN KWDS
                        EQUIVALENCE (NCPARS,NCRTH(11))
C              NCPARN - PARTITION NO. 
                        EQUIVALENCE (NCPARN,NCRTH(12))
C              NCLOGD - LOGGING DEVICE LU OR FILENAME (5 WDS) 
                        DIMENSION NCLOGD(5) 
                        EQUIVALENCE (NCLOGD(1),NCRTH(13)) 
C              NCTUSP - TUS NAME OF STARTING PROCESS (3 WDS)
                        DIMENSION NCTUSP(3) 
                        EQUIVALENCE (NCTUSP(1),NCRTH(18)) 
C              NCSTCK - STACK LENGTH
                        EQUIVALENCE (NCSTCK,NCRTH(21))
C              NCINIP - TUS NAME OF INITIAL PROCESS (3 WDS) 
                        DIMENSION NCINIP(3) 
                        EQUIVALENCE (NCINIP(1),NCRTH(22)) 
C              NCLUIN - LU FOR INITIAL PROCESS
                        EQUIVALENCE (NCLUIN,NCRTH(25))
C              NCDBNO - NO. OF DATA BASES 
                        EQUIVALENCE (NCDBNO,NCRTH(26))
C 
C NOTE: THE FOLLOWING VARIABLES ARE EQUIVALENCED TO "NCRTH" FOR USE 
C       BY TMSG5. 
C 
C              IEXFL  - 
                        EQUIVALENCE (IEXFL,NCRTH(2101)) 
C              IPTR   - 
                        EQUIVALENCE (IPTR,NCRTH(2102))
C              NBSCR  - 
                        EQUIVALENCE (NBSCR,NCRTH(2103)) 
C              IFSCR  - 
                        EQUIVALENCE (IFSCR,NCRTH(2104)) 
C              ILAST  - 
                        EQUIVALENCE (ILAST,NCRTH(2105)) 
C              IFLG   - 
C                       DIMENSION IFLG(29)
C                       EQUIVALENCE (IFLG(1),NCRTH(2106)) 
C              IPRVS  - 
C                       DIMENSION IPRVS(29) 
C                       EQUIVALENCE (IPRVS(1),NCRTH(2135))
C              IBUFR  - DATA BUFFER USED BY SUBROUTINE "TMPRS"
                        DIMENSION IBUFR(62) 
                        EQUIVALENCE (IBUFR(1),NCRTH(2164))
C              ITEMP  - 
                        DIMENSION ITEMP(3)
                        EQUIVALENCE (ITEMP(1),NCRTH(2226))
C              ITOSC  - 
                        EQUIVALENCE (ITOSC,NCRTH(2229)) 
C 
C*********************************************************************
CCB3
C 
C 
C 
CCB4
C*********************************************************************
C 
C-----LABELED COMMON # 4  BUFFER USED IN CREATION PHASE & ERROR FLAG
C                       OR I/O BUFFER USED IN THE INTERACTIVE DEFINITION
C                       PHASE.
C 
      COMMON /TMGC4/IERFL,IERNB,IERTN,IERMS(7),IRLOC(70),ITRSF(20)
C 
C NOTE: THE VARIABLES IN THIS COMMON ARE EQUIVALENCED TO "IOBUF"
C       FOR USE BY TMSG4 & TMSG5. 
C 
      DIMENSION IOBUF(100)
      EQUIVALENCE (IOBUF(1),IERFL)
C     IERFL  -
C     IERNB  -
C     IERMS  -
C     IRLOC  -
C     ITRSF  -
C 
C*********************************************************************
CCB4
C 
      DIMENSION NAME(3),IPOB(3),IBUFF(30) 
      DIMENSION KBUFR(44),LNFLD(5)
      DIMENSION ISTAT2(16)
C 
      LOGICAL JPAR,KPAR,CMPW,GETBK,OKABT,STUSP,INAMR
      LOGICAL PSFLG 
      LOGICAL JJJJ
      LOGICAL IMBED,ISBTW,CMPW
      LOGICAL ISBIT 
      INTEGER OPEN,PURGE
C 
      DATA LNFLD/5,5,6,6,1/,IBFSZ/15/ 
      DATA LUOXXX/6 / 
C 
      KPAR(IX1,IX2,IX3)=JPAR(IOBUF,LENGH,IFLD,IX1,IX2,IFLG,IX3) 
C 
C 
C     JOB ? 
C 
C 
      ISZSC=27
      NOCHRS=0
      IF(IJOB.EQ.2) GOTO 220
      IF(IJOB.NE.0) STOP 4000 
C 
C     ***************************************************************** 
C     *                                                               * 
C     *   DATA-BASE DEFINITION:                                       * 
C     *                                                               * 
C     ***************************************************************** 
C 
C     DISPLAY SCREEN # 4
C 
5     ISCRN=4 
      IF(IOFST .EQ. 0)  IOFST=IDECL-ISZSC 
10    IOFST=IOFST+ISZSC 
      K=1+(IOFST-IDECL)/ISZSC 
      J=27+IBFSZ*(K-1)
11    IF(NCRTH(J) .NE. 0)  GOTO 12
C-----NO DATA-BASE DEFINED YET, INIT THE BUFFER 
      CALL MOVEW(12H            ,NCRTH(J),6)
      NCRTH(J+6)=0
      NCRTH(J+7)=0
      NCRTH(J+8)=0
12    CALL MOVCA(K,1,NCRTH,IOFST+1,2) 
      CALL MOVCA(NCRTH(J),1,NCRTH,IOFST+3,5)
      CALL MOVCA(NCRTH(J+3),1,NCRTH,IOFST+8,6)
      CALL MOVCA(NCRTH(J+6),1,NCRTH,IOFST+14,2) 
      CALL MOVCA(NCRTH(J+7),1,NCRTH,IOFST+16,2) 
D     I1=IDECL/2+1
D     WRITE(LUOXXX,9877)K,J,IOFST,(NCRTH(I),I=I1,I1+79) 
D9877 FORMAT(/"   K="I2,",    J="I3",   IOFST="I6",   NCRTH:" 
D    .,10(/8@8))
D     WRITE(LUOXXX,9878)K,J,IOFST,(NCRTH(I),I=I1,I1+79) 
D9878 FORMAT(/"   K="I2,",    J="I3",   IORST="I6",   NCRTH:" 
D    .,10(/8A2))
      GOTO 210
C 
C     PROCESS SCREEN # 4
C 
20    PSFLG=.FALSE. 
      K=1+(IOFST-IDECL)/ISZSC 
      J=27+IBFSZ*(K-1)
      L=J 
      I=1 
C 
C     DATA BASE NAME
C 
      IFLD=1
      IF(KPAR(IBUFF,LNFLD(IFLD),IPOB)) GO TO 360
      NUERO=18
      IF(IFLG.NE.0 .AND. IFLG.NE.3) GO TO 440 
      IF(IMBED(IBUFF,1,LNFLD(IFLD))) GO TO 440
      CALL ISUPB(IBUFF,3) 
      CALL MOVEW(IBUFF,NCRTH(J),3)
C 
C     DATA BASE SECURITY CODE 
C 
30    I=I+2 
      IFLD=2
      IF(KPAR(IBUFF,LNFLD(IFLD),IPOB)) GO TO 360
      NUERO=39
      IF(IFLG.NE.0 .AND.  NCRTH(J).EQ.2H  ) GO TO 440 
      NUERO=29
      IF(IFLG.NE.0 .AND. IFLG.NE.1 .AND. IFLG.NE.3) GO TO 440 
      IF(IFLG.NE.3) GO TO 37
      IF(ISUPB(IBUFF,3).NE.1) GO TO 440 
      IF(ISBTW(IGETB(IBUFF,1),101B,132B)) GO TO 440 
      IF(ISBTW(IGETB(IBUFF,2),101B,132B) .AND.
     .   ISBTW(IGETB(IBUFF,2),60B,71B)   .AND.
     .   IGETB(IBUFF,2).NE.40B) GO TO 440 
      NCRTH(J+6)=IBUFF
      GO TO 38
   37 NUERO=29
      IF(IPOB.LT.0) GO TO 440 
      NCRTH(J+6)=IPOB 
C 
C     DATA BASE CARTRIDGE REFERENCE NUMBER
C 
38    IFLD=3
      IF(KPAR(IBUFF,LNFLD(IFLD),IPOB)) GO TO 360
      NUERO=39
      IF(IFLG.NE.0 .AND. NCRTH(J).EQ.2H  ) GO TO 440
      NUERO=5 
      IF(IFLG.NE.0 .AND. IFLG.NE.1 .AND. IFLG.NE.3) GO TO 440 
      IF(IFLG.NE.3) GO TO 371 
      IF(ISUPB(IBUFF,3).NE.1) GO TO 440 
      IF(ISBTW(IGETB(IBUFF,1),101B,132B)) GO TO 440 
      IF(ISBTW(IGETB(IBUFF,2),101B,132B) .AND.
     .   ISBTW(IGETB(IBUFF,2),60B,71B)   .AND.
     .   IGETB(IBUFF,2).NE.40B) GO TO 440 
      NCRTH(J+7)=IBUFF
      NUERO=35
      IF(ICRLU(NCRTH(J+7)) .EQ. -1) GO TO 440 
      GO TO 372 
371   IF(IPOB.LT.0) GO TO 440 
      NUERO=35
      IF(ICRLU(IPOB) .EQ. -1) GO TO 440 
      NCRTH(J+7)=IPOB 
C 
C     DATA BASE HIGHEST LEVEL ACCESS WORD 
C 
372   IFLD=4
      IF(KPAR(IBUFF,LNFLD(IFLD),IPOB)) GO TO 360
      NUERO=18
      IF(IFLG.NE.0 .AND. IFLG.NE.1 .AND. IFLG.NE.3) GO TO 440 
      IF(IMBED(IBUFF,1,LNFLD(IFLD))) GO TO 440
      CALL ISUPB(IBUFF,3) 
      NUERO=39
      IF(NCRTH(J).EQ.2H  .AND.IFLG.NE.0) GO TO 440
      CALL MOVEW(IBUFF,NCRTH(J+3),3)
C 
C     LOCKK DATA BASE ON DEMAND?
C 
      IFLD=5
      IF(KPAR(IBUFF,LNFLD(IFLD),IPOB)) GO TO 360
      NCRTH(J+8)=0
      NUERO=39
      IF(IFLG.NE.0.AND.NCRTH(J).EQ.2H  ) GO TO 440
      NUERO=19
      IF(IBUFF.NE.1H .AND.IBUFF.NE.1HX) GO TO 440 
C 
C-----IF AN X WAS ENTERRED, SET THE NODE NUMBER (NOT USED) TO 1.
C        IF TMP2 IS BEING CREATED SET HIGH BIT ON, ELSE LEAVE 0 
C        FOR TMP1.
C 
      IF(IBUFF.EQ.1HX) NCRTH(J+8)=1 
      IF(IMOTR(7).EQ.2HP2) CALL SETBT(NCRTH(J+8),15,1)
      IF(NCRTH(J) .EQ. 2H  )  GOTO 130
C 
C-----VERIFY THAT THE SAME DATA BASE IS NOT DEFINED TWICE 
C 
      IF(K .EQ. 1)  GOTO 70 
      L=27
      NUERO=40
      IKK=1 
      DO 53 KK=1,K-1
      IF( CMPW(NCRTH(L),NCRTH(J),3) )  GOTO 400 
53    L=L+15
C 
C     THE DATA BASE IS DEFINED BY NAME,...  OPEN IT 
C     TO VERIFY SECURITY CODE, HIGHEST LEVEL ACCESS WORD, 
C     AND CART. REF. #
C 
C     NOTE:  NAME IS AT NCRTH(J)
C            LEVEL ACCESS WORD IS AT NCRTH(J+3) 
C            SECURITY CODE IS AT NCRTH(J+6) 
C            CR# IS AT NCRTH(J+7) 
C            LOCK DATA BASE ON DEMAND ONLY AT NCRTH(J+8)
C 
C  NOTE FOR FUTURE ENHANCEMENT -- DB NODE # WILL BE AT NCRTH(J+8) 
C 
C 
70    CALL NUL (KBUFR,44) 
      NOCHRS=0
      KBUFR(1)=2H 
      CALL MOVEW(NCRTH(J),IBUFF,3)
      IBUFF(5)=NCRTH(J+6) 
      IBUFF(6)=NCRTH(J+7) 
      IBUFF(4)=27B
      IBUFF(7)=0B 
      IBUFF(8)=0B 
      IBUFF(9)=0B 
      IBUFF(10)=0B
      JJJJ=INAMR(IBUFF,KBUFR(2),22,NOCHRS)
      CALL PUTCA(KBUFR,035400B,NOCHRS+2)
      CALL MOVEW(NCRTH(J+3),IBUFF,3)
      CALL DBOPN(KBUFR,IBUFF,1,IPOB)
      IF(IPOB .NE. 0)  GOTO 75
      IF(IPOB(2) .NE. 15)  IPOB=10000 
75    CALL DBCLS(KBUFR,1,1,ISTAT) 
      IF(IPOB .EQ. 0)  GOTO 82
78    IFLD=1
      NUERO=0 
      IF(IPOB .EQ. 128)  NUERO=25 
      IF(IPOB .EQ. 129)  NUERO=26 
      IF(IPOB .EQ. 119)  NUERO=27 
      IF(IPOB .EQ. 116)  NUERO=27 
      IF(IPOB .EQ. 6)    NUERO=27 
      IF(NUERO .NE. 0)   GOTO 410 
      IFLD=4
      IF(IPOB .EQ. 10000) NUERO=28
      IF(NUERO .NE. 0)  GOTO 410
      IFLD=2
      IF(IPOB .EQ. 117)  NUERO=29 
      IF(NUERO .NE. 0)   GOTO 410 
      IFLD=1
      IF(IPOB.NE.0)NUERO=30 
C     IF(NUERO.NE.0)GO TO 410 
      CALL JASC(IPOB,IBUFF,1,6) 
      CALL TMPGE(30,2,IBUFF(2)) 
      GOTO 220
82    IPOB=ISTAT
      IF(IPOB .NE. 0)  GOTO 78
      CALL VFYDB(NCRTH(J),ISTAT2) 
      IF(ISTAT2(1).EQ.1) GO TO 84 
      IFLD=1
      NUERO=49
      IF((ISBIT(ISTAT2(11),15).AND.IMOTR(7).NE.2HP2).OR.
     .((.NOT.ISBIT(ISTAT2(11),15)).AND.IMOTR(7).NE.2HP1)) GO TO 440 
      NUERO=50
      IF(ISTAT2(1).EQ.3) GO TO 440
      NUERO=51
      IF(ISTAT2(1).EQ.0.AND.ISTAT2(2).GT.0.AND. 
     .  ISTAT2(11).NE.NCRTH(J+8)) GO TO 440 
84    CONTINUE
C 
C-----IMAGE DEFINITION OK, SET THE PROGRAM NAME 
C        CHANGE CR# AND SEC-COD TO 2 ASCII CHARS IF REQ'D.
C 
      CALL MOVEW(NCRTH(J),NCRTH(J+9),3) 
C-----SET LOCK TABLE SIZE 
      NCRTH(J+14)=4096
      IF( PSFLG )  GOTO 368 
      GOTO 140
130   CALL NUL(NCRTH(J),IBFSZ)
      IF( PSFLG )  GOTO 368 
      IF(K .EQ. 4)  GOTO 160
      CALL MOVEW(NCRTH(J+IBFSZ),NCRTH(J),IBFSZ*(4-K)) 
      CALL NUL(NCRTH(27+3*IBFSZ),IBFSZ) 
      IOFST=IOFST-ISZSC 
      IF(NCRTH(J) .EQ. 0)  GOTO 160 
140   IF(K .LT. 4)  GOTO 10 
      K=K+1 
C-----END OF INTERACTIVE PROCESS, RETURN TO MONITOR (SEG# 0)
160   NCRTH(26)=K-1 
      CALL TMGSC(0,0,0,1,2) 
C 
C 
C     PRINT SCREEN
C 
210   CALL TMGSC(3,ISCRN,IOFST,IEND,2)
C 
C     READ FROM THE 2645 TERMINAL 
C 
220   LENGH=0 
      IF(IEND .LT. 0)  GOTO 420 
      IF(ISCRN.EQ.4) LENGH=27 
      IF(LENGH.EQ.0)  STOP 4010 
C 
      IF(.NOT.GETBK(LU,IOBUF,LENGH)) GOTO 350 
C 
C     RE-DISPATCH AFTER AN HARD ERROR, RE-ISSUE THE SCREEN
C 
310   IF(ISCRN.EQ.4) GOTO 11
      STOP 4012 
C 
C     DISPATCH TO SCREEN ANALYSIS PART
C 
C 
350   IF(ISCRN.EQ.4)GO TO 20
C     ABORT OR PREVIOUS SCREEN COMMAND
C 
360   IF(IFLG .EQ. 8)  GOTO 365 
      NUERO=34
      IF(IFLG .NE. 9)  GOTO 400 
C-----USER WANTS TO ABORT ? 
      IF( .NOT. OKABT(LU))  GOTO 310
C-----YES, OPERATOR WANTS TO ABORT
      CALL TMGSC(0,0,0,2) 
C-----EXECUTE THE PREVIOUS SCREEN COMMAND 
365   IF(.NOT. PSFLG)  IPS=IFLD 
      PSFLG=.TRUE.
      IF(ISCRN.EQ.4) GOTO (30,38,368),I 
C 
368   IF(ISCRN.NE.4)  STOP 4015 
      IF(IOFST .LE. IDECL)  GOTO 370
      IOFST=IOFST-2*ISZSC 
      GOTO 10 
370   IF(IMOTR.NE.1) GOTO 380 
C-----GO TO PREVIOUS SCREEN (SCREEN#3, DEFINITION OF TUS) 
      CALL TMGSC(5,0,0,0,3) 
C 
380   IEND=-33
      IOFST=0 
      GOTO 5
C 
C     ERROR MESSAGE 
C 
400   IFLD=IKK
410   IF( PSFLG )  GOTO 365 
      GOTO 440
420   IFLD=1
      NUERO=-IEND 
      IEND=0
440   CALL TMPGE(NUERO,IFLD)
      GOTO 220
450   CALL TMPGE(NUERO,IFLD,IPOB) 
      GO TO 220 
C 
C     DUMMY CALL TO MAIN  !!
C 
7777  CALL TMPGN
      END 
      END$
                                                                                                                                                                                                                  