SUBROUTINE VIPCN(A)
      INTEGER*2 A(2)
      INTEGER*2 ANPTS,ATYPE,AXA,AXF,AXI,AXMIN,ADELX
      INTEGER*2 AYA,AYF,AYI,AEA,AJOIN,AOFF
      INTEGER*2 AXP,AYP,AEP,AXC,AYC,AEC,AXN,AYN,AEN,AIC
      COMMON/VAOFF/ANPTS,ATYPE,AXA,AXF,AXI,AYA,AYF,AYI,AEA,AJOIN,AOFF,
     1             AXP,AYP,AEP,AXC,AYC,AEC,AXN,AYN,AEN,AIC
      EQUIVALENCE (AXA,AXMIN),(AXF,ADELX)
      REAL*4    XFAC,XOFF
      INTEGER*2 XTYPE,XMAXB,XSMINB,XSMAXB,XSNOWB
      COMMON/VXDES/XFAC,XOFF,XTYPE,XMAXB,XSMINB,XSMAXB,XSNOWB
      IF(A(AXC).EQ.32767)GO TO 990
      A(AIC)=0
      I=0
      GO TO 1040
990   I=1
1000  CALL VGETXY(A,I,IXB,IYB,IEB)
      IF(IXB.GE.XSMINB)GO TO 1020
      I=I+1
      IF(I.LE.A(ANPTS))GO TO 1000
      DO 1010 I=AXP,AEN
1010  A(I)=32767
      A(AIC)=A(ANPTS)
      GO TO 2000
1020  A(AXP)=IXB
      A(AYP)=IYB
      A(AEP)=IEB
      A(AXC)=IXB
      A(AYC)=IYB
      A(AEC)=IEB
      A(AIC)=I
1040  CALL VGETXY(A,I+1,A(AXN),A(AYN),A(AEN))
2000  RETURN
      END