FTN4
      PROGRAM TMPG2(5),92080-16454 REV.2026  800115 
C 
C 
C     NAME: TMPG2 
C     SOURCE: &TMG2A    92080-18454 
C     BINARY: %TMG2A    92080-16454 
C 
C     PGMR: 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         *  THIS PROGRAM ALLOWS USER EITHER TO    *
C         *  CREATE ALL FILES OF AN APPLICATION    *
C         *  OR TO PURGE ONLY UNUSED OR ALL FILES  *
C         *  ASSOCIATED TO THIS APPLICATION.       *
C         *                                        *
C         *   IF P1 = 0  FUNCTION PURGE ALL        *
C         *   IF P1 = 1  FUNCTION CREATE           *
C         *   IF P1 = 2  FUNCTION PURGE UNUSED     *
C         *              FILES.                    *
C         ******************************************
C 
C 
C     STOP USED:  2000
C     ----------
C 
C     NOTE: WORKS ON PACKED FORM OF NCRTH 
C    ------ 
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 
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   - 
                        DIMENSION IFLG(29)
                        EQUIVALENCE (IFLG(1),NCRTH(2106)) 
C              IPRVS  - 
                        DIMENSION IPRVS(29) 
                        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 
      IF(ISCRN.EQ.0) GOTO 2000
      IF(ISCRN.EQ.2) GOTO 2500
      IF(ISCRN.NE.1) STOP 2000
C 
C     ************************
C     *  CREATION  OPERATION *
C     ************************
C 
C 
      CALL TMGCR(IEND)
      GOTO 3000 
C 
C     ********************
C     * PURGE OPERARTION *
C     ********************
C 
2000  CALL TMGPU(.TRUE.,.TRUE.,1,NBUPT(NCRTH))
C-----IF LIST OF PURGE ON AN OTHER LU, TERMINATE TMPGN
      IF(LU .NE. LUPRT)   CALL TMGSC(0,0,0,2) 
      IEND=3
      GOTO 3000 
C 
C-----PURGE UNUSED MODULE ONLY
C 
2500  I=LUPRT 
      LUPRT=LU
      CALL TMGPU(.FALSE.,.FALSE.,NBUPT(NCRTH)+1,NBPRO)
      LUPRT=I 
C 
C     PREPARATION OR PURGE IS FINISH
C     WRITE MESSAGE ON CRT IF NEEDED AND EXIT.
C 
3000  CALL TMGSC(0,0,0,IEND,IJOB) 
C 
C     DUMMY CALL TO MAIN  !!
C 
      CALL TMPGN
      END 
      END$
                                                