FTN4 PROGRAM TMPG2(5),92903-16454 REV.1913 781113 C C C NAME: TMPG2 C SOURCE: &TMPG2 92903-18454 C BINARY:%TMPG2 92903-16454 C C PGMR: 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 * 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 C-----LABEL COMMON # 1 GENERAL INFORMATION C COMMON /TMGC1/LU,LUPRT,LUOUT,ISYTP,IRQ(2),IEND,IJOB C C-----LABEL COMMON # 3 BUFFER AREA C COMMON /TMGC3/IDUM0(7),NCRTH(1) C C IF(IRQ.EQ.0) GOTO 2000 IF(IRQ.EQ.2) GOTO 2500 IF(IRQ.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$