FTN4,L
      PROGRAM TXPM1(3,89),91711-16003  REV 1926  790421 
C 
C*********************************************************************
C 
C  DESCRIPTION: 
C  ------------ 
C 
C    THE PURPOSE OF THIS PROGRAM IS TO EXECUTE THE
C    MEMORY VERIFICATIONS PROGRAM "TXPM2" IN ALL
C    PARTITIONS, STARTING WITH THE FIRST PARTITION. 
C 
C 
C  OPERATING PROCEDURE: 
C  -------------------- 
C 
C    SCHEDULE THE PROGRAM "TXPM1" USING THE RUN COMMAND:
C 
C      :RU,TXPM1,LGLU,# PASSES
C 
C      WHERE LGLU     =  LU ON WHICH MESSAGES ARE LOGGED. 
C            # PASSES = NUMBER OF PASSES OF TEST PROGRAM. 
C 
C************************************************************************ 
C 
      DIMENSION ICMD(30),IPRAM(5),NAME(3),IERR(2),MSG1(15)
      DIMENSION MSG2(27),MSG3(14),MSG4(15),MSG5(23),MSG6(6) 
      EQUIVALENCE (IERR(2),ICMD)
      DATA MSG1 /2H  ,2HTX,2HPM,2H1 ,2H- ,2HME,2HMO,2HRY, 
     *           2H T,2HES,2HT ,2HRU,2HNN,2HIN,2HG /
      DATA MSG2 /2H  ,2HTX,2HPM,2H1 ,2H- ,2HME,2HMO,2HRY,2H T,
     *           2HES,2HT ,2HFI,2HNI,2HSH,2HED,2H  ,2H  ,2H##,
     *           2H P,2HAR,2HTI,2HTI,2HON,2HS ,2HTE,2HST,2HED/
      DATA MSG3 /2H  ,2HTX,2HPM,2H1 ,2H- ,2HME,2HMO,2HRY, 
     *           2H T,2HES,2HT ,2HER,2HRO,2HR!/ 
      DATA MSG4 /2H  ,2HTX,2HPM,2H1 ,2H- ,2HME,2HMO,2HRY, 
     *           2H T,2HES,2HT ,2HAB,2HOR,2HTE,2HD!/
      DATA MSG5 /2H  ,2HTX,2HPM,2H1 ,2H- ,2HAT,2HTE,
     *           2HMP,2HT ,2HTO,2H T,2HES,2HT ,2HNO,2HN-,2HEX,
     *           2HIS,2HTE,2HNT,2H M,2HEM,2HOR,2HY!/
      DATA MSG6 /2HAS,2H,T,2HXP,2HM2,2H, ,2H 0/ 
      DATA NAME /2HTX,2HPM,2H2 /
      DATA IERR /2H  ,2H  / 
C 
C***************** GET TERMINAL LOGICAL UNIT NO. ********************** 
C 
      CALL RMPAR(IPRAM) 
      LU=IPRAM(1) 
      IF (LU.LE.0) LU=LOGLU(LU) 
C 
C************************ SET UP LOOP **********************************
C 
      IF(IPRAM(2).LE.0) IPRAM(2)=1
C 
C***********************************************************************
C************** GET NUMBER OF GENERATED PARTITIONS ************** 
C 
      LAST = NPART(K) 
C 
C*******DO ONE LINE SPACE AND DISPLAY INFORMATION MESSAGE ******
C 
      CALL EXEC(3,LU+1100B,1) 
      CALL EXEC(2,LU,MSG1,15) 
      CALL EXEC(3,LU+1100B,1) 
C 
C************************ START TESTING ************************
C 
      IPASS = IPRAM(2)
      ILOOP = 0 
50    ITEST = 0 
      IPART = 1 
C 
C********************* GET PARTITION STATUS ********************* 
C 
100   CALL EXEC(25,IPART,IPAGE,ISIZE,ISTAT) 
C   SKIP UNDEFINED PARTITIONS 
      IF (ISIZE.EQ.-1)  GO TO 300 
C   SKIP MOTHER PARTITIONS
      IF (IAND(ISTAT,20000B).NE.0)  GO TO 300 
C 
C******************* UNASSIGN PROGRAM "TXPM2" ******************* 
C 
      DO 200  I = 1,6 
      ICMD(I) = MSG6(I) 
200   CONTINUE
      LENG = 12 
      MLENG = MESSS(ICMD,LENG)
      IF (MLENG.LT.0)  GO TO 400
C 
C***** ADJUST PROGRAM SIZE OF "TXPM2" TO FIT ANY PARTITION *****
C 
      ICMD(1) = 2HSZ
      ICMD(6) = 2H 2
      MLENG = MESSS(ICMD,LENG)
      IF (MLENG.LT.0)  GO TO 400
C 
C********** ASSIGN PROGRAM "TXPM2" TO PARTITION IPART **********
C 
      ICMD(1) = 2HAS
      ICMD(6) = KCVT(IPART) 
      MLENG = MESSS(ICMD,LENG)
      IF (MLENG.LT.0)  GO TO 400
C 
C****** INCREASE SIZE OF "TXPM2" TO MATCH PARTITION IPART ******
C 
      ICMD(1) = 2HSZ
      ICMD(6) = KCVT(ISIZE) 
      MLENG = MESSS(ICMD,LENG)
      IF (MLENG.LT.0)  GO TO 400
C***********************************************************************
C*********************** SCHEDULE "TXPM2" *********************** 
C 
      CALL EXEC(23,NAME)
      CALL RMPAR(IPRAM) 
      IF (IPRAM(1).EQ.100000B)  CALL EXEC(2,LU,MSG3,15) 
      IF (IAND(IPRAM(1),77777B).NE.0)  CALL EXEC(2,LU,MSG5,23)
C 
C********************* TEST ALL PARTITIONS *********************
C 
      ITEST = ITEST+1 
300   IF (IPART.GE.LAST)  GO TO 350 
      IPART = IPART+1 
      GO TO 100 
C 
C**************** COMPLETE ALL PASSES OF THE PROGRAM *****************
C 
350   ILOOP = ILOOP+1 
      IF(ILOOP.GE.IPASS) GOTO 500 
      GOTO 50 
C 
C******************** DISPLAY ERROR MESSAGE ********************
C 
400   CALL EXEC(2,LU,IERR,MLENG-2)
      CALL EXEC(2,LU,MSG4,15) 
      GO TO 600 
C 
C**************** DISPLAY TEST FINISHED MESSAGE ****************
C 
500   MSG2(18) = KCVT(ITEST)
      CALL EXEC(3,LU+1100B,1) 
      CALL EXEC(2,LU,MSG2,27) 
      CALL EXEC(3,LU+1100B,1) 
600   CALL EXEC(13,LU,ISTAT)
      IF (IAND(ISTAT,100000B).NE.0)  GO TO 600
      END 
      END$
                                                                                                                                                                                                                                        