PROGRAM TEST C C Test the routines of VRTARY.MAC. C DIMENSION * BUFF(2048), ! local buffer for row or column data * ORIG(2048) ! original data values C INTEGER * BUFF, * ICOL, ! column index number * IROW, ! row index number * NCOL, ! maximum number of columns * NROW, ! maximum number of rows * NSIZ, ! number of bytes per element * ORIG, * TSXFLG, ! =0 for RT-11, >0 for TSX-Plus * ZERO ! null value for loading array elements C DATA * NSIZ /2/, ! integer elements * ZERO /0/ C 1 FORMAT (/,' TEST: 85f05a') 2 FORMAT (/,' TEST: All done',/) 3 FORMAT (/,' IVINIT: Array initialized') 4 FORMAT (/,' IVINIT: IERR =',I3) 5 FORMAT (/,' IVELIM: Array eliminated') 6 FORMAT (/,' IVELIM: IERR =',I3) 7 FORMAT (/,'$Enter NCOL and NROW values: ') 8 FORMAT (2I5) 9 FORMAT (/,' IPTROW/IGTROW:',/) 10 FORMAT ('+ IROW =',I5) 11 FORMAT (/,' IPTROW: IERR =',I3) 12 FORMAT (/,' IGTROW: IERR =',I3) 13 FORMAT (/,' IPTCOL/IGTCOL:',/) 14 FORMAT ('+ ICOL =',I5) 15 FORMAT (/,' IPTCOL: IERR =',I3) 16 FORMAT (/,' IGTCOL: IERR =',I3) 17 FORMAT (/,' Match error, ',2I5) C C TYPE 1 C C If running under TSX-Plus, lock the job into lowest possible memory. C TSXFLG = ITSLIN () IF (TSXFLG .GT. 0) CALL LKLOMY C C Prompt for and accept array size values. C TYPE 7 ACCEPT 8,NCOL,NROW C C Create and initialize the array. C IERR = IVINIT (NROW,NCOL,NSIZ,BUFF) IF (IERR .EQ. 0) GO TO 100 TYPE 4,IERR GO TO 220 100 CONTINUE TYPE 3 C C Test the transfer of rows of data between the array and the buffer. C TYPE 9 DO 150 IROW = 1,NROW TYPE 10,IROW DO 110 ICOL = 1,NCOL BUFF(ICOL) = MOD ((IROW+ICOL),NCOL) ORIG(ICOL) = BUFF(ICOL) 110 CONTINUE IERR = IPTROW (IROW) IF (IERR .EQ. 0) GO TO 120 TYPE 11,IERR GO TO 220 120 CONTINUE DO 130 ICOL = 1,NCOL BUFF(ICOL) = ZERO 130 CONTINUE IERR = IGTROW (IROW) IF (IERR .EQ. 0) GO TO 140 TYPE 12,IERR GO TO 220 140 CONTINUE DO 145 ICOL = 1,NCOL IF (BUFF(ICOL) .EQ. ORIG(ICOL)) GO TO 142 TYPE 17,BUFF(ICOL),ORIG(ICOL) GO TO 220 142 CONTINUE 145 CONTINUE 150 CONTINUE C C Test the transfer of columns between the array and the buffer. C TYPE 13 DO 200 ICOL = 1,NCOL TYPE 14,ICOL DO 160 IROW = 1,NROW BUFF(IROW) = MOD ((ICOL+IROW),NROW) ORIG(IROW) = BUFF(IROW) 160 CONTINUE IERR = IPTCOL (ICOL) IF (IERR .EQ. 0) GO TO 170 TYPE 15,IERR GO TO 220 170 CONTINUE DO 180 IROW = 1,NROW BUFF(IROW) = ZERO 180 CONTINUE IERR = IGTCOL (ICOL) IF (IERR .EQ. 0) GO TO 190 TYPE 16,IERR GO TO 220 190 CONTINUE DO 195 IROW = 1,NROW IF (BUFF(IROW) .EQ. ORIG(IROW)) GO TO 192 TYPE 17,BUFF(IROW),ORIG(IROW) GO TO 220 192 CONTINUE 195 CONTINUE 200 CONTINUE C C Eliminate the array. C IERR = IVELIM () IF (IERR .EQ. 0) GO TO 210 TYPE 6,IERR GO TO 220 210 CONTINUE TYPE 5 C C If running under TSX-Plus, unlock the job from memory. C 220 CONTINUE IF (TSXFLG .GT. 0) CALL IUNLKM C C End it all! C TYPE 2 CALL EXIT END