c   ******************** CONTR *********************
c
c   DRAW CONTOURS OF THE POTENTIAL DISTRIBUTIONS
c
      SUBROUTINE CONTR(ETA1,VAC,TIP,SEM,VSINT,R,S,DELV,NRDIM,NVDIM,
     &NSDIM,NR,NV,NS,NUMC,DELP)
C
C   NUMC=NUMBER OF CONTOURS
C   DELP=SPACING OF POTENTIAL CONTOURS (IF 0., USE MAX_P-MIN_P/(NUMC+1))
C
      DIMENSION VAC(2,NRDIM,NVDIM),SEM(2,NRDIM,NSDIM),VSINT(2,NRDIM),
     &R(NRDIM),S(NSDIM),DELV(NRDIM)
      LOGICAL TIP(NRDIM,NVDIM),KDONE(1000)
C
C   DRAW TIP
C
      NRSKIP=NR/500
      IF (NRSKIP.EQ.0) NRSKIP=1
      DO 300 I=0,NR,NRSKIP
         II=I
         IF (II.EQ.0) II=1
         RSAV=R(II)
         IF (I.EQ.0) RSAV=-RSAV
         DO 250 J=1,NV
            IF (.NOT.TIP(II,J)) GO TO 250
            WRITE(20,*) RSAV*SQRT(1.-(ETA1*J/NV)**2),-J*DELV(II)
            GO TO 300
250      CONTINUE
300   CONTINUE
C
C   SEARCH FOR MIN, MAX POINTS IN POTENTIAL
C
      PMIN=1.E10
      PMAX=-1.E10
      DO 400 I=1,NR
         DO 330 J=1,NV
            IF (PMIN.LT.VAC(1,I,J)) GO TO 320
               PMIN=VAC(1,I,J)
320         IF (PMAX.GT.VAC(1,I,J)) GO TO 330
               PMAX=VAC(1,I,J)
330      CONTINUE
         IF (PMIN.LT.VSINT(1,I)) GO TO 340
            PMIN=VSINT(1,I)
340      IF (PMAX.GT.VSINT(1,I)) GO TO 350
            PMAX=VSINT(1,I)
350      DO 370 J=1,NS
            IF (PMIN.LT.SEM(1,I,J)) GO TO 360
               PMIN=SEM(1,I,J)
360         IF (PMAX.GT.SEM(1,I,J)) GO TO 370
               PMAX=SEM(1,I,J)
370      CONTINUE
400   CONTINUE
      WRITE(6,*) 'MIN, MAX POTENTIAL VALUES =',PMIN,PMAX
      WRITE(16,*) 'MIN, MAX POTENTIAL VALUES =',PMIN,PMAX
C
C   DRAW CONTOURS
C
      IF (DELP.NE.0.) GO TO 450
      DELP=(PMAX-PMIN)/(NUMC+1)
      WRITE(6,*) 'CONTOUR SPACING =',DELP
      WRITE(16,*) 'CONTOUR SPACING =',DELP
C
450   DO 600 I=0,NR,NRSKIP
         II=I
         IF (II.EQ.0) II=1
         RSAV=R(II)
         IF (I.EQ.0) RSAV=-RSAV
         DO 500 K=1,NUMC
            KDONE(K)=.FALSE.
500      CONTINUE
         DO 530 K=1,NUMC
         DO 520 J=NS,1,-1
            P=K*DELP+PMIN
            IF (J.EQ.1) GO TO 510
            IF ((SEM(1,II,J).GE.P.AND.SEM(1,II,J-1).LE.P).OR.
     &          (SEM(1,II,J).LE.P.AND.SEM(1,II,J-1).GE.P)) GO TO 515
            GO TO 520
510         IF ((SEM(1,II,J).GE.P.AND.VSINT(1,II).LE.P).OR.
     &          (SEM(1,II,J).LE.P.AND.VSINT(1,II).GE.P)) GO TO 515
            GO TO 520
515         WRITE(20+K,*) RSAV,S(J)
            KDONE(K)=.TRUE.
            GO TO 530
520      CONTINUE
530      CONTINUE
         DO 540 K=1,NUMC
         P=K*DELP+PMIN
         IF ((VSINT(1,II).GE.P.AND.VAC(1,II,1).LE.P).OR.
     &       (VSINT(1,II).LE.P.AND.VAC(1,II,1).GE.P)) GO TO 535
         GO TO 540
535      IF (.NOT.KDONE(K)) WRITE(20+K,*) RSAV,0.
         KDONE(K)=.TRUE.
540      CONTINUE
         DO 570 K=1,NUMC
         DO 560 J=1,NV-1
            IF (TIP(II,J)) GO TO 560
            P=K*DELP+PMIN
            IF ((VAC(1,II,J).GE.P.AND.VAC(1,II,J+1).LE.P).OR.
     &          (VAC(1,II,J).LE.P.AND.VAC(1,II,J+1).GE.P)) GO TO 550
            GO TO 560
550         IF (.NOT.KDONE(K))
     &         WRITE(20+K,*) RSAV*SQRT(1.-(ETA1*J/NV)**2),-J*DELV(II)
            KDONE(K)=.TRUE.
            GO TO 570
560      CONTINUE
570      CONTINUE
600   CONTINUE
C
      DO 700 I=NR,0,-NRSKIP
         II=I
         IF (II.EQ.0) II=1
         RSAV=R(II)
         IF (I.EQ.0) RSAV=-RSAV
         DO 605 K=1,NUMC
            KDONE(K)=.FALSE.
605      CONTINUE
         DO 630 K=1,NUMC
         DO 620 J=NV-1,1,-1
            IF (TIP(II,J)) GO TO 620
            P=K*DELP+PMIN
            IF ((VAC(1,II,J).GE.P.AND.VAC(1,II,J+1).LE.P).OR.
     &          (VAC(1,II,J).LE.P.AND.VAC(1,II,J+1).GE.P)) GO TO 610
            GO TO 620
610         IF (.NOT.KDONE(K)) 
     &         WRITE(20+K,*) RSAV*SQRT(1.-(ETA1*J/NV)**2),-J*DELV(II)
           KDONE(K)=.TRUE.
            GO TO 630
620      CONTINUE
630      CONTINUE
         DO 640 K=1,NUMC
         P=K*DELP+PMIN
         IF ((VSINT(1,II).GE.P.AND.VAC(1,II,1).LE.P).OR.
     &       (VSINT(1,II).LE.P.AND.VAC(1,II,1).GE.P)) GO TO 635
         GO TO 640
635      IF (.NOT.KDONE(K)) WRITE(20+K,*) RSAV,0.
         KDONE(K)=.TRUE.
640      CONTINUE
         DO 670 K=1,NUMC
         DO 660 J=1,NS
            P=K*DELP+PMIN
            IF (J.EQ.1) GO TO 645
            IF ((SEM(1,II,J).GE.P.AND.SEM(1,II,J-1).LE.P).OR.
     &          (SEM(1,II,J).LE.P.AND.SEM(1,II,J-1).GE.P)) GO TO 650
            GO TO 660
645         IF ((SEM(1,II,J).GE.P.AND.VSINT(1,II).LE.P).OR.
     &          (SEM(1,II,J).LE.P.AND.VSINT(1,II).GE.P)) GO TO 650
            GO TO 660
650         IF (.NOT.KDONE(K)) WRITE(20+K,*) RSAV,S(J)
            KDONE(K)=.TRUE.
            GO TO 670
660      CONTINUE
670      CONTINUE
700   CONTINUE
      RETURN
      END