SUBROUTINE RECT( X1, X2, Y1, Y2, IFLG ) C C NAME: RECT C C LANGUAGE: FORTRAN C C OPERATING SYSTEM: UNIVERSAL C C ORDER NUMBER: 5428-SE C C PART NUMBER: 000-026366 NOVEMBER 1985 C C PRODUCT: UNIVERSAL VERSAPLOT COLOR RANDOM 2.0 C C VERSATEC, INC., SANTA CLARA, CALIFORNIA 95051 C A XEROX COMPANY C C Copyright (C) 1985 by Xerox Corporation. All rights reserved. C C "NOTICE. THIS PROGRAM IS THE EXCLUSIVE PROPERTY OF VERSATEC, C INC. AND IS ISSUED IN STRICT CONFIDENCE UNDER A PREARRANGED C LICENSE AGREEMENT AND IS NOT TO BE DISCLOSED IN ANY MANNER TO C PERSONS OUTSIDE THE LICENSED ORGANIZATION AND SHALL NOT BE C REPRODUCED OR DISSEMINATED, IN WHOLE OR PART, TO ANYONE OUTSIDE C THE LICENSED ORGANIZATION WITHOUT THE PRIOR WRITTEN APPROVAL OF C VERSATEC, INC. UNLESS OTHERWISE PROVIDED FOR BY SUCH LICENSE C AGREEMENT. THIS WORK IS PROTECTED AS AN UNPUBLISHED WORK UNDER C THE COPYRIGHT ACT OF 1976." C C REVISION HISTORY C REV. C C 2/20/85 THIS IS A NEW SUBROUTINE CREATED FOR C THIS REVISION. C C RECT - PERFORM PATTERN SHADING OF A USER-DEFINED RECTANGLE C (A RECTANGLE WITH HORIZONTAL AND VERTICAL SIDES) C C THE RECTANGLE DEFINED BY THE FOUR POINTS ,, C , AND IS DRAWN USING THE CURRENTLY DEFINED C FILL PATTERN. THE FILL PATTERN MUST ALREADY HAVE BEEN DEFINED C AND ACTIVATED BY EITHER A DEFPAT, SETPAT SEQUENCE OR A C CALL TO TONE. IF IFLG <> 0, THEN THE RECTANGLE IS OUTLINED C USING THE CURRENT PEN. OTHERWISE, NO OUTLINE IS DRAWN. C IF THE RECTANGLE IS OUTLINED, THE CURRENT POINT BECOMES . C C ENTRY: CALL RECT( X1, X2, Y1, Y2, IFLG ) C C ,, - COORDINATES OF THE FOUR CORNERS C , OF THE RECTANGLE C C IFLG - FLAG INDICATING WHETHER TO OUTLINE C THE RECTANGLE: C = 0 NO OUTLINE C # 0 OUTLINE USING CURRENT PEN C C EXIT: THE PARAMETERS ARE UNCHANGED. THE FILLED RECTANGLE AND C POSSIBLY ITS OUTLINE HAVE BEEN DRAWN. IF THE OUTLINE C IS DRAWN, THE CURRENT POSITION BECOMES . C C CALLS: PLOT, TRAP C C CALLED BY: USER, GRID C C COMMON USED: C /DVCOM/ C I ILWP - (LINE WIDTH - 1)/2 C I ILWM - LINE WIDTH/2 C I KPAT - NUMBER OF CURRENTLY ACTIVE TONE PATTERN C I MSB - WORD TO SET HIGH ORDER BIT DETERMINED BY C PRECISION (16/32) SELECTED. C I NCLIP - NUMBER OF CLIPPED VECTORS C L PMOVE - STATUS OF LAST PLOT CALL (.TRUE.=MOVE) C R RORG() - AN X,Y PAIR WHICH DEFINES THE CURRENT C SOFTWARE ORIGIN. SET BY REORIGIN CALL C TO *PLOT* C L ROT90 - IF ROT90 = .TRUE. THEN ROTATE THE PLOT C COUNTERCLOCKWISE 90 DEGREES C R VCP() - CURRENT POINT IN COMPUTATIONAL COORDINATES C L VSFLAG - .TRUE. IFF STRIPPING IN THE Y-DIRECTION C IS NECESSARY C R WIN() - THE CURRENT VIEW WINDOW IN COMPUTATIONAL C COORDINATES C R WTV() - WINDOW TRANSFORMATION VARIABLES. USED TO C TRANSFORM COORDINATES FROM THE VIEW WINDOW C SYSTEM TO THE VIEWPORT SYSTEM C I XNIPS - NUMBER OF NIBS PER PAGE IN THE X-DIRECTION C I YNIPS - NIBS PER SCAN C /VRFCOM/ C R BYTKNT()- BYTE COUNT FOR EACH COLOR C R DRWKNT - BYTE COUNT FOR A DRAW COMMAND C I IBXMAX - MAXIMUM X VALUE (USED FOR BANDING) C R VRFKNT()- COUNTER FOR RANDOM ELEMENTS C R OBJKNT()- NUMBER OF EACH TYPE OF OBJECT OUTPUT C OBJKNT(1) - VECTORS C OBJKNT(2) - POLYGONS C OBJKNT(3) - CIRCLES C OBJKNT(4) - CHARACTERS C I PRECIS - COORDINATE PRECISION FOR THE VRF C OUTPUT FILE (16 OR 32-BIT PRECISION) C /CLRCOM/ C I ICLRDF()- ARRAY CONTAINING COLOR DEFINITIONS C I ITNCLR - CURRENT TONE COLOR INDEX C I ITNFLG - USE PEN OR TONE COLOR FOR AREAS C I ITNSEQ()- TONING SEQUENCE FOR OUTPUT C I NCPASS - NUMBER OF COLOR PASSES C C /PRMCOM/ C I IFONT - DEFAULT FONT PATTERN NUMBER. C I KREP - TARGET OUTPUT CONTROLLER C = 0 - UNKNOWN C = 1 - REP CONTROLLER C = 4 - RPM CONTROLLER C /KLCOM/ C L KFLAG - FLAG INDICATING REP OUTPUT AND .GT. 13.65' C PLOTTING REQUIRED. C I KSIZE - VARIABLE DEFINING 13.65' IN SCANS, USED TO C DETERMINE IF ELEMENT CROSSES A 13.65' PAGE C BOUNDARY. C C LOCAL: C I ICOM - DRAW-POLYGON COMMAND C I JX1,JY1, - INTEGER COORDINATES OF THE RECTANGLE C JX2,JY2 C I MINX,MAXX- MIN AND MAX VALUES OF THE RECTANGLE IN C MINY,MAXY INTEGER COORDINATES C I NSTRIP - THE STRIP NUMBER WHERE THE RECTANGLE IS C I NTNSEQ() - (,1) - SAVED VALUE OF ITNSEQ() C (,2) - TURNED ON IFF AN OUTLINE IS TO BE DONE C (,3) - TURNED ON IFF A FILL IS TO BE DONE C I POLYGN - VRF DRAW-POLYGON COMMAND WORD C L SAVROT - SAVED VALUE OF ROT90 C I SAVORG() - SAVED VALUES OF RORG() C R T() - ARRAY USED TO PASS A TRAPEZOID TO TRAP C R XMIN,YMIN- MIN AND MAX VALUES OF THE RECTANGLE IN THE C XMAX,YMAX WINDOW COORDINATES C R XX1,XX2, - LOCAL VARIABLES CORRESPONDING TO C YY1,YY2 X1, X2, Y1, AND Y2 C R XX1SAV, - SAVED VALUES OF XX1 AND YY1 C YY1SAV C C LOGICAL ROT90,PMOVE,IPDEF,DASHPN,XMAJOR,VSFLAG INTEGER PWIDTH,XNIPS,YNIPS,PENPAT,VSMAX,PFONT C... COMMON /DVCOM/ PHASE I COMMON VARIABLES C COMMON /DVCOM/ * ANC, DASHPN, FACT, HTC, ICUT, ICWTV, ICXPTS, * IEOJ, ILWM, ILWP, IOPEN, ISORT, ITFLAG, IX1, * IX2, IY1, IY2, JFONT, JPEN, KPAT, KWIDTH, * LASTX, LASTY, MAXPAT, MSB, MSKALL, NCH, NCLIP, * NIBSX, NLPAT, NPLOT, PFONT, PMOVE, PXMIN, PXMAX, * PYMIN, PYMAX, RADN, ROT90, SXC, SYC, TSINA, * TCOSA, XDEN, XFAC, XNIPS, XOFF, YDEN, YFAC, * YOFF, YNIPS, VSFLAG, VSMAX, XMAJOR, * IPAT(16,256), IEOP(4), IHBUF(2), IPDEF(64), * NPAT(255), PENPAT(4,64), PWIDTH(64), * RORG(2), VCP(2), VP(4), WIN(4), WTV(4), WX(4), WY(4), * IAUTXT(15) C C C C... COMMON /VRFCOM/ - VRF COMMON VARIABLES C INTEGER PRECIS INTEGER OBUF COMMON /VRFCOM/ * DRWELM, DRWMAX, DRWMIN, DRWKNT, ICOPY, * ICNSTX, IBXMAX, IHDCNT, MIN, * NBYTS, NCHUNK, NHEAD, NREC, PRECIS, * RMXELM, VRFMAX, * BYTKNT(4), IBEGIN(4), ICOMD(2), IOCODE(2), IREC(4), * MAX(4), NEXTO(4), OBJKNT(4), VRFKNT(4), OBUF(640) C C... COMMON /CLRCOM/ - COLOR VARIABLES C INTEGER PCOLOR, CURPEN LOGICAL PENCHG COMMON /CLRCOM/ * ICLMAX, ITNCLR, ITNFLG, IVCFLG, NCPASS, PENCHG, * CURPEN(4), ICLRDF(4,512), IDASRT(4), ITNSEQ(4), * PCOLOR(64) C C... COMMON /PRMCOM/ - DEFAULT PLOTTING PARAMETERS C INTEGER PENTBL,BMODEL,BBYTES,CMODEL,CBYTES LOGICAL VSTRP COMMON /PRMCOM/ * IBYTES, IDISK, IFFAP, LASTFF, * IJPEN, INHNCE, INITFF, INVERS, * IRDT, ISPACE, ISPEED, ISFLAG, * IUSER, JBYTES(75), KREP, IFONT, * MIRROR, MODEL, MODL(75), MXPEN, * NCOPY, NMODL, PENTBL(64,2), RDEN, * RDENS(75), SCALE, UNITS, XFACT, * YFACT, XSTART, YSTART, * VXMIN, VXMAX, VYMIN, VYMAX, * WXMIN, WXMAX, WYMIN, WYMAX, * BMODEL, BDEN, BBYTES, * CMODEL, CDEN, CBYTES, * IDEFLG(256), IUCLR, MODE1, IPRISM(61), * MUXOUT, PMSIZE, MAXPEN, KTWO, * LTNFLG, LTNCLR, MTAPE, VSTRP, * JSORT, JCPCMD, JCUT, KDISK C C... COMMON /KLCOM/ - X STRIPPING VARIABLES C LOGICAL KFLAG COMMON /KLCOM/ KFLAG, KSIZE C DIMENSION SAVORG(2) C LOGICAL SAVROT,LPAT INTEGER NTNSEQ(4,3),T(6),POLYGN C C... VRF DRAW-POLYGON COMMAND WORD DATA POLYGN/34817/ C C... CHECK FOR A NULL WINDOW IF (WIN(1) .LT. WIN(3) .AND. WIN(2) .LT. WIN(4)) GO TO 20 NCLIP = NCLIP + 1 GO TO 999 C C... GET WORKING COPIES IF THE VARIABLES 20 XX1 = X1 XX2 = X2 YY1 = Y1 YY2 = Y2 C C... TRANSLATE COORDINATES TO ACCOUNT FOR REORIGIN IF ( RORG(1) .EQ. 0.0 ) GO TO 30 XX1 = XX1 + RORG(1) XX2 = XX2 + RORG(1) 30 IF ( RORG(2) .EQ. 0.0 ) GO TO 40 YY1 = YY1 + RORG(2) YY2 = YY2 + RORG(2) 40 CONTINUE C C... ROTATE COORDINATES TO SCAN LINE ORIENTATION, IF NECESSARY IF ( .NOT. ROT90 ) GO TO 50 TMP = XX1 XX1 = -YY1 YY1 = TMP TMP = XX2 XX2 = -YY2 YY2 = TMP 50 CONTINUE C C... SAVE COORDINATE POSITION XX1SAV = XX1 YY1SAV = YY1 C C... CHECK IF FILL PATTERN DEFINED LPAT = .FALSE. IF (ITNFLG .NE. 0 .OR. KPAT .GE. 0) GO TO 55 CALL MSGLG1 (124) LPAT = .TRUE. KPAT = 63 C C... CHECK IF A NULL RECTANGLE 55 IF (IFLG.EQ.0 .AND. ITNFLG.EQ.0 .AND. KPAT.EQ.63) GO TO 999 C C... GET THE MAX AND MIN VALUES XMIN = AMIN1(XX1,XX2) XMAX = AMAX1(XX1,XX2) YMIN = AMIN1(YY1,YY2) YMAX = AMAX1(YY1,YY2) C C... CHECK IF THE RECTANGLE NEEDS TO BE CLIPPED IF (XMIN .GE. WIN(1) .AND. XMAX .LE. WIN(3) .AND. * YMIN .GE. WIN(2) .AND. YMAX .LE. WIN(4)) GO TO 100 C NCLIP = NCLIP + 1 C C... CHECK FOR AN INVISIBLE RECTANGLE IF (XMIN .GT. WIN(3) .OR. XMAX .LT. WIN(1) .OR. * YMIN .GT. WIN(4) .OR. YMAX .LT. WIN(2)) GO TO 999 C C... CLIP THE RECTANGLE IF (XMIN .GE. WIN(1)) GO TO 60 XMIN = WIN(1) IF (XX1 .LT. XMIN) XX1 = XMIN IF (XX2 .LT. XMIN) XX2 = XMIN 60 IF (YMIN .GE. WIN(2)) GO TO 70 YMIN = WIN(2) IF (YY1 .LT. YMIN) YY1 = YMIN IF (YY2 .LT. YMIN) YY2 = YMIN 70 IF (XMAX .LE. WIN(3)) GO TO 80 XMAX = WIN(3) IF (XX1 .GT. XMAX) XX1 = XMAX IF (XX2 .GT. XMAX) XX2 = XMAX 80 IF (YMAX .LE. WIN(4)) GO TO 100 YMAX = WIN(4) IF (YY1 .GT. YMAX) YY1 = YMAX IF (YY2 .GT. YMAX) YY2 = YMAX C 100 CONTINUE C C... COMPUTE THE INTEGER ORDINATES OF THE RECTANGLE JX1 = XX1*WTV(1) + WTV(2) JX2 = XX2*WTV(1) + WTV(2) JY1 = YY1*WTV(3) + WTV(4) JY2 = YY2*WTV(3) + WTV(4) C C... GET THE MAX AND MIN VALUES MINX = MIN0(JX1,JX2) MAXX = MAX0(JX1,JX2) MINY = MIN0(JY1,JY2) MAXY = MAX0(JY1,JY2) C C... ADJUST FOR THE OUTLINE, IF ANY IF (IFLG .EQ. 0) GO TO 110 MINX = MINX - ILWM MAXX = MAXX + ILWP MINY = MINY - ILWM MAXY = MAXY + ILWP 110 CONTINUE C C.. UPDATE IBXMAX IF (MAXX .GT. IBXMAX) IBXMAX = MAXX C C... CHECK IF THE RECTANGLE IS OUTLINED WITH A DASHED PEN IF (IFLG .NE. 0 .AND. DASHPN) GO TO 900 C C... CHECK IF THE RECTANGLE CROSSES A Y-STRIPPING BOUNDARY IF (.NOT. VSFLAG) GO TO 120 IF ((MINY/YNIPS) .NE. (MAXY/YNIPS)) GO TO 900 C C... ADJUST THE RECTANGLE IF IT IS NOT IN THE FIRST STRIP NSTRIP = MINY/YNIPS IF (NSTRIP .EQ. 0) GO TO 120 ITMP = NSTRIP*XNIPS JX1 = JX1 + ITMP JX2 = JX2 + ITMP MINX = MINX + ITMP MAXX = MAXX + ITMP ITMP = NSTRIP*YNIPS JY1 = JY1 - ITMP JY2 = JY2 - ITMP C 120 CONTINUE C C... CHECK IF X-STRIPPING CHECK REQUIRED IF (.NOT. KFLAG) GO TO 200 IF (MAXX-MINX .GE. KSIZE) GO TO 900 IF (KREP .EQ. 4) GO TO 200 IF ((MINX+8)/KSIZE .NE. (MAXX+8)/KSIZE) GO TO 900 200 CONTINUE C C... THE RECTANGLE (AND OUTLINE) DOES NOT CROSS A STRIPPING C BOUNDARY. C C... SET UP NTNSEQ IF A TONE COLOR IF (ITNFLG .EQ. 0) GO TO 250 DO 225 IBND=1,NCPASS C C... SAVE CURRENT VALUE NTNSEQ(IBND,1) = ITNSEQ(IBND) C C... CHECK IF RECTANGLE IS OUTLINED WITH THIS TONER NTNSEQ(IBND,2) = ITNSEQ(IBND) ITNSEQ(IBND) = IABS(ITNSEQ(IBND)) IF (IFLG .EQ. 0) NTNSEQ(IBND,2) = ITNSEQ(IBND) C C... CHECK IF RECTANGLE IS FILLED WITH THIS TONER NTNSEQ(IBND,3) = ITNSEQ(IBND) IF (ICLRDF(NTNSEQ(IBND,3),ITNCLR).NE.63) * NTNSEQ(IBND,3) = -NTNSEQ(IBND,3) C IF (NTNSEQ(IBND,2) .LT. 0 .OR. NTNSEQ(IBND,3) .LT. 0) * ITNSEQ(IBND) = -ITNSEQ(IBND) 225 CONTINUE 250 CONTINUE C C... OUTPUT THE FIRST POINT AS A MOVE COMMAND CALL OCHUNK (JX1,-1) CALL OCHUNK (JY1,-1) C IF (ITNFLG .EQ. 0) GO TO 290 C C... *** TONE COLOR *** C C... TURN OFF ITNSEQ DO 260 IBND=1,NCPASS ITNSEQ(IBND) = IABS(ITNSEQ(IBND)) 260 CONTINUE C C... OUTPUT THE DRAW POLYGON COMMANDS DO 270 IBND=1,NCPASS IF (NTNSEQ(IBND,2).GE.0 .AND. NTNSEQ(IBND,3).GE.0) GO TO 270 ITNSEQ(IBND) = -ITNSEQ(IBND) C C... DETERMINE COUNT ITMP = 6 IF (NTNSEQ(IBND,2) .LT. 0) ITMP = 8 IF (PRECIS .EQ. 32) ITMP = ITMP*2 ICOM = POLYGN + ITMP C C... OUTPUT POLYGON COMMAND AND FILL PATTERN CALL OCHUNK (ICOM,0) CALL OCHUNK (ICLRDF(-ITNSEQ(IBND),ITNCLR),0) ITNSEQ(IBND) = -ITNSEQ(IBND) C C... COUNT BYTES VRFKNT(IBND) = VRFKNT(IBND) + 5.0 BYTKNT(IBND) = BYTKNT(IBND) + 14.0 IF (NTNSEQ(IBND,2).LT.0) * BYTKNT(IBND) = BYTKNT(IBND) + DRWKNT * 4.0 C 270 CONTINUE C C... CHECK IF OUTLINED IF (IFLG .NE. 0) GO TO 275 C C... TURN ON TONERS FOR THE FILL DO 272 IBND=1,NCPASS ITNSEQ(IBND) = NTNSEQ(IBND,3) 272 CONTINUE GO TO 320 C C... TURN ON TONERS FOR THE OUTLINE 275 DO 280 IBND=1,NCPASS ITNSEQ(IBND) = NTNSEQ(IBND,2) 280 CONTINUE GO TO 300 C C... *** HATCH PATTERN AND PEN COLOR *** C C... DETERMINE COUNT 290 ITMP = 6 IF (IFLG .NE. 0) ITMP = 8 IF (PRECIS .EQ. 32) ITMP = ITMP*2 ICOM = POLYGN + ITMP C C... OUTPUT POLYGON COMMAND AND FILL PATTERN CALL OCHUNK (ICOM,0) CALL OCHUNK (KPAT,0) C C... COUNT BYTES DO 295 IBND=1,NCPASS IF (ITNSEQ(IBND) .GE. 0) GO TO 295 VRFKNT(IBND) = VRFKNT(IBND) + 5.0 BYTKNT(IBND) = BYTKNT(IBND) + 14.0 IF (IFLG.NE.0) BYTKNT(IBND) = BYTKNT(IBND) + DRWKNT * 4.0 295 CONTINUE C IF (IFLG .EQ. 0) GO TO 320 C C C... OUTPUT AN OUTLINED RECTANGLE 300 CONTINUE IY = OR (JY2,MSB) CALL OCHUNK (JX1,-1) CALL OCHUNK (IY,-1) CALL OCHUNK (JX2,-1) CALL OCHUNK (IY,-1) IY = OR (JY1,MSB) CALL OCHUNK (JX2,-1) CALL OCHUNK (IY,-1) CALL OCHUNK (JX1,-1) CALL OCHUNK (IY,-1) C IF (ITNFLG .EQ. 0) GO TO 400 C C... CHECK IF ANY OF THE FILL COLORS ARE DIFFERENT FROM THE OUTLINE C COLORS. TURN THESE COLORS ON. ICNT = 0 DO 310 IBND=1,NCPASS ITNSEQ(IBND) = IABS(ITNSEQ(IBND)) IF (NTNSEQ(IBND,2).LT.0 .AND. NTNSEQ(IBND,3).GE.0) GO TO 310 ITNSEQ(IBND) = -ITNSEQ(IBND) ICNT = 1 310 CONTINUE IF (ICNT .EQ. 0) GO TO 380 C C... OUTPUT A NON-OUTLINED RECTANGLE 320 CALL OCHUNK (JX1,-1) CALL OCHUNK (JY2,-1) CALL OCHUNK (JX2,-1) CALL OCHUNK (JY2,-1) CALL OCHUNK (JX2,-1) CALL OCHUNK (JY1,-1) IF (ITNFLG .EQ. 0) GO TO 400 C C... RESET ITNSEQ 380 DO 390 IBND=1,NCPASS ITNSEQ(IBND) = NTNSEQ(IBND,1) 390 CONTINUE C C... COUNT ANOTHER POLYGON 400 OBJKNT(2) = OBJKNT(2) + 1.0 C GO TO 999 C C... THE RECTANGLE CROSSES A STRIPPING BOUNDARY OR IS OUTLINED C WITH A DASHED PEN. C THE OUTLINE IS OUTPUT USING PLOT CALLS AND THE C RECTANGLE IS OUTPUT (AND STRIPPED) BY TRAP. 900 CONTINUE C C... CHECK FOR A NULL FILL PATTERN IF (ITNFLG .EQ. 0 .AND. KPAT .EQ. 63) GO TO 940 C C... SET TONING SEQUENCE IF TONE COLOR IF (ITNFLG .EQ. 0) GO TO 920 DO 910 IBND=1,NCPASS NTNSEQ(IBND,1) = ITNSEQ(IBND) ITNSEQ(IBND) = IABS(ITNSEQ(IBND)) IF (ICLRDF(ITNSEQ(IBND),ITNCLR) .NE. 63) * ITNSEQ(IBND) = -ITNSEQ(IBND) 910 CONTINUE C 920 T(1) = JX1 T(2) = JX2 T(3) = JY1 T(4) = JY2 T(5) = JY1 T(6) = JY2 CALL TRAP(T) C C... RESET TONE SEQUENCE IF TONE COLOR IF (ITNFLG .EQ. 0) GO TO 940 DO 930 IBND=1,NCPASS ITNSEQ(IBND) = NTNSEQ(IBND,1) 930 CONTINUE C 940 IF (IFLG .EQ. 0) GO TO 999 C C... SAVE THE REORIGIN AND ROTATE VALUES SAVROT = ROT90 SAVORG(1) = RORG(1) SAVORG(2) = RORG(2) ROT90 = .FALSE. RORG(1) = 0.0 RORG(2) = 0.0 C C... OUTLINE THE RECTANGLE CALL PLOT ( XX1, YY1, 3 ) CALL PLOT ( XX1, YY2, 2 ) CALL PLOT ( XX2, YY2, 2 ) CALL PLOT ( XX2, YY1, 2 ) CALL PLOT ( XX1, YY1, 2 ) C C... RESTORE THE REORIGIN AND ROTATE VALUES ROT90 = SAVROT RORG(1) = SAVORG(1) RORG(2) = SAVORG(2) C C... UPDATE COORDINATE POSITION 999 VCP(1) = XX1SAV VCP(2) = YY1SAV PMOVE = .TRUE. C C... RESET KPAT IF NECESSARY IF (LPAT) KPAT = -1 C RETURN END