ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c                           Version 1.1                     c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c  calls:
c
c     call contur(array,ix,iy,c0,c1,c2,iskipzero)
c        real array(ix,iy)
c
c     contours array using values c0,c0+c2,c0+2*c2,...c1
c       (do loop style)
c       negative contours are dashed
c       if iskipzero .eq. 1, zzero contour will be skipped
c
c     Note: does not set window-- precede by a call to
c       window(1.,1.,1.*ix,1.*iy) for plot to fill entire
c       screen. Or use window(1.,1.,1024.0/780.0*ix,1.0*iy)
c       for contours to fit in square area. This routine does
c       not draw a bounding box.
c
cccccccccccccccc
      SUBROUTINE contur ( Z, L, M, FLO, HI, FINC, Nzer )
C
      INTEGER  L, M, Nzer
      REAL     FLO, HI, FINC
      REAL     Z(L,M)
C
C **********************************************************************
C *   FIRST VERSION: 03/15/88                CURRENT VERSION: 03/15/88 *
C *--------------------------------------------------------------------*
C *                                                                    *
C *      Entry point similar to NCAR routine CONREC.  The following    *
C *   parameters do not have any effect in this implementation:        *
C *                                                                    *
C *                        NHI                                         *
C *                                                                    *
C *      This routine DOES NOT label the contour levels.  The          *
C *         following "Tektronix" routines are required:               *
C *                                                                    *
C *         SET, GETSET, PERIM, DASHD, FRAME, FLUSH, WTSTR             *
C *                                                                    *
C *      The actual plotting is done in routine DRLINE.  There the     *
C *   DSHLINE routines are called.  Substitute with your own stuff     *
C *   if you want.  Dashed line pattern are selected in this routine   *
C *   according to the sign of parameter NDOT.                         *
C *                                                                    *
C *      They are art of LLTS.  See NCAR manual for description of     *
C *   the input parameters.                                            *
C *                                                                    *
C *   Original NCAR routines modified by Arlindo da Silva.             *
C *                                                                    *
C **********************************************************************
C
C
C     COMMONS WITH INTERNAL PARAMETERS --- SET IN BLOCK DATA CONBD
C     ------------------------------------------------------------ 
      EXTERNAL  CONBD
      COMMON /CONRE1/IOFFP,SPVAL,EPSVAL,CNTMIN,CNTMAX,CNTINT,NOZERO
      COMMON /CONRE3/ IXBITS     ,IYBITS
      COMMON /CONRE4/ SIZEL      ,SIZEM      ,SIZEP      ,NREP       ,
     1                NCRT       ,ILAB       ,NULBLL     ,IOFFD      ,
     2                EXT        ,IOFFM      ,ISOLID     ,NLA        ,
     3                NLM        ,XLT        ,YBT        ,SIDE
C
C
C
C
C     SAVE INPUT PARAMETERS
C     ---------------------
      GL = FLO
      HA = HI
      GP = FINC
      MX = L
      NX = L
	zt=.1*finc
	ny=m
C
C
 
 
C
C     CONTOUR LEVELS
C     --------------
C     PROCESS EACH LEVEL
C     ------------------
CCC      PRINT *
         CONTR = gl
C
CCC         PRINT 2, CONTR
CCC 2       FORMAT('+ CONREC: plotting contour level ', 1PE10.3 )
C
C        DASHED LINE
C        -----------
932	 IF ( CONTR .LT. 0 ) THEN
              CALL setdash ( '----    ----    ' )
C
C        SOLID LINE
C        ----------
         else
              CALL setdash ( '----------------' )
         END IF
C
C        DRAW ALL LINES AT THIS LEVEL.
C        ----------------------------

	if(abs(contr).gt.zt .or. nzer.eq.0) CALL STLINE (Z,MX,NX,NY,CONTR)
C
  123 CONTINUE
C
CCC      PRINT 3
CCC 3    FORMAT('+ CONREC is done!                                    '/)
C
	contr=contr+finc
	if(contr.lt.ha+finc*0.5)goto 932
c      CALL tsend
      RETURN
 
C
C     LAST LINE OF CONREC
C----------------------------------------------------------------------
      END
 
C                 < < <    C   O   N   R   E   C    > > >
 
 
      SUBROUTINE DRLINE (Z,L,MM,NN)
 
      DIMENSION       Z(L,NN)
C
C **********************************************************************

C *   FIRST VERSION: dark ages             CURRENT VERSION: 03/15/88   *
C *--------------------------------------------------------------------*
C *                                                                    *
C *      This routine traces a contour line when given the beginning   *
C *   by stline. Transformations can be added by deleting the          *
C *   statement functions for FX and FY in DRLINE and MINMAX and       *
C *   adding external functions.                                       *
C *                                                                    *
C *               X=1. at Z(1,J), X=FLOAT(M) at Z(M,J).                *   
C *               Y=1. at Z(I,1), Y=FLOAT(N) at Z(I,N).                *
C *                                                                    *
C *    Notice that X and Y takes on non-integer values.                *
C *                                                                    *
C **********************************************************************
 
 
      COMMON /CONRE2/ IX         ,IY         ,IDX        ,IDY        ,
     1                IS         ,ISS        ,NP         ,CV         ,
     2                INX(8)     ,INY(8)     ,IR(1500)    ,NR
 
      COMMON /CONRE1/IOFFP,SPVAL,EPSVAL,CNTMIN,CNTMAX,CNTINT,NOZERO
      COMMON /CONRE3/ IXBITS     ,IYBITS
      LOGICAL         IPEN       ,IPENO
      DATA IPEN,IPENO/.TRUE.,.TRUE./
C
      FX(X,Y) = X
      FY(X,Y) = Y
C
C     Use SHIFT function if your compiler has it
C     ------------------------------------------
CCC   IXYPAK(IXX,IYY) = ISHIFT(IXX,IYBITS)+IYY
      IXYPAK(IXX,IYY) = -32000 + IYY * ( MM-1 ) + IXX
      C(P1,P2) = (P1-CV)/(P1-P2)
C
      M = MM
      N = NN
      IF (IOFFP .EQ. 0) GO TO 101
      ASSIGN 110 TO JUMP1
      ASSIGN 115 TO JUMP2
      GO TO 102
  101 ASSIGN 112 TO JUMP1
      ASSIGN 117 TO JUMP2
  102 IX0 = IX
      IY0 = IY
      IS0 = IS
      IF (IOFFP .EQ. 0) GO TO 103
      IX2 = IX+INX(IS)
      IY2 = IY+INY(IS)
      IPEN = ABS(Z(IX,IY)-SPVAL).GT.EPSVAL .AND.
     .      ABS(Z(IX2,IY2)-SPVAL).GT.EPSVAL
      IPENO = IPEN
  103 IF (IDX .EQ. 0) GO TO 104
      Y = IY
      ISUB = IX+IDX
      X = C(Z(IX,IY),Z(ISUB,IY))*FLOAT(IDX)+FLOAT(IX)
      GO TO 105
  104 X = IX
      ISUB = IY+IDY
      Y = C(Z(IX,IY),Z(IX,ISUB))*FLOAT(IDY)+FLOAT(IY)
  105 CALL dashup
      call dash ( FX(X,Y), FY(X,Y) )
  106 IS = IS+1
      IF (IS .GT. 8) IS = IS-8
      IDX = INX(IS)
      IDY = INY(IS)
      IX2 = IX+IDX
      IY2 = IY+IDY
      IF (ISS .NE. 0) GO TO 107
      IF (IX2.GT.M .OR. IY2.GT.N .OR. IX2.LT.1 .OR. IY2.LT.1) GO TO 120
  107 IF (CV-Z(IX2,IY2)) 108,108,109
  108 IS = IS+4
      IX = IX2
      IY = IY2
      GO TO 106
  109 IF (IS/2*2 .EQ. IS) GO TO 106
      GO TO JUMP1,(110,112)
  110 ISBIG = IS+(8-IS)/6*8
      IX3 = IX+INX(ISBIG-1)
      IY3 = IY+INY(ISBIG-1)
      IX4 = IX+INX(ISBIG-2)
      IY4 = IY+INY(ISBIG-2)
      IPENO = IPEN
      IF (ISS .NE. 0) GO TO 111
      IF (IX3.GT.M .OR. IY3.GT.N .OR. IX3.LT.1 .OR. IY3.LT.1) GO TO 120
      IF (IX4.GT.M .OR. IY4.GT.N .OR. IX4.LT.1 .OR. IY4.LT.1) GO TO 120
  111 IPEN = ABS(Z(IX,IY)-SPVAL).GT.EPSVAL .AND.
     .   ABS(Z(IX2,IY2)-SPVAL).GT.EPSVAL .AND.
     .   ABS(Z(IX3,IY3)-SPVAL).GT.EPSVAL .AND.
     .   ABS(Z(IX4,IY4)-SPVAL).GT.EPSVAL
  112 IF (IDX .EQ. 0) GO TO 113
      Y = IY
      ISUB = IX+IDX
      X = C(Z(IX,IY),Z(ISUB,IY))*FLOAT(IDX)+FLOAT(IX)
      GO TO 114
  113 X = IX
      ISUB = IY+IDY
      Y = C(Z(IX,IY),Z(IX,ISUB))*FLOAT(IDY)+FLOAT(IY)
  114 GO TO JUMP2,(115,117)
  115 IF (.NOT.IPEN) GO TO 118
      IF (IPENO) GO TO 116
C
C     END OF LINE SEGMENT
C     -------------------
      CALL dashup
c      CALL dash ( FX(XOLD,YOLD), FY(XOLD,YOLD) )
C
C     CONTINUE LINE SEGMENT
C     ---------------------
  116 CONTINUE
  117 CALL dash ( FX(X,Y), FY(X,Y) )
  118 XOLD = X
      YOLD = Y
      IF (IS .NE. 1) GO TO 119
      NP = NP+1
      IF (NP .GT. NR) GO TO 120
      IR(NP) = IXYPAK(IX,IY)
  119 IF (ISS .EQ. 0) GO TO 106
      IF (IX.NE.IX0 .OR. IY.NE.IY0 .OR. IS.NE.IS0) GO TO 106
C
C END OF LINE
C
  120 CONTINUE
      call dashup
      RETURN
C
C     LAST LINE OF DRLINE
C----------------------------------------------------------------------
      END
 
      SUBROUTINE STLINE (Z,LL,MM,NN,CONV)
 
      DIMENSION       Z(LL,NN)
C
C **********************************************************************
C *   FIRST VERSION: dark ages             CURRENT VERSION: 03/15/88   *
C *--------------------------------------------------------------------*
C *                                                                    *
C *      This routine finds the beginnings of all contour lines at     *
C *   level CONV.  First the edges are searched for lines intersecting *
C *   the edge (open lines) then the interior is searched for lines    *
C *   which do not intersect the edge (closed lines).  Beginnings are  *
C *   stored in IR to prevent re-tracing of lines.  If IR is filled,   *
C *   the search is stopped for this CONV.                             *
C *                                                                    *
C **********************************************************************
 
      COMMON /CONRE1/IOFFP,SPVAL,EPSVAL,CNTMIN,CNTMAX,CNTINT,NOZERO
      COMMON /CONRE2/ IX         ,IY         ,IDX        ,IDY        ,
     1                IS         ,ISS        ,NP         ,CV         ,
     2                INX(8)     ,INY(8)     ,IR(1500)    ,NR
      COMMON /CONRE3/ IXBITS     ,IYBITS
C
C     Use ISHIFT function if your compiler has it
C     -------------------------------------------
CCC   IXYPAK(IXX,IYY) = ISHIFT(IXX,IYBITS)+IYY
      IXYPAK(IXX,IYY) = -32000 + IYY * ( MM-1 ) + IXX
C
C     PATCH TO SUPPRESS DRAWING OF ZERO VALUE CONTOUR LINES
C     -----------------------------------------------------
      IF(NOZERO.EQ.1)THEN
        IF(CONV.EQ.0.)RETURN
      ENDIF
C
      L = LL
      M = MM
      N = NN
      CV = CONV
      NP = 0
      ISS = 0
      DO 102 IP1=2,M
         I = IP1-1
         IF (Z(I,1).GE.CV .OR. Z(IP1,1).LT.CV) GO TO 101
         IX = IP1
         IY = 1
         IDX = -1
         IDY = 0
         IS = 1
         CALL DRLINE (Z,L,M,N)
  101    IF (Z(IP1,N).GE.CV .OR. Z(I,N).LT.CV) GO TO 102
         IX = I
         IY = N
         IDX = 1
         IDY = 0
         IS = 5
         CALL DRLINE (Z,L,M,N)
  102 CONTINUE
      DO 104 JP1=2,N
         J = JP1-1
         IF (Z(M,J).GE.CV .OR. Z(M,JP1).LT.CV) GO TO 103
         IX = M
         IY = JP1
         IDX = 0
         IDY = -1
         IS = 7
         CALL DRLINE (Z,L,M,N)
  103    IF (Z(1,JP1).GE.CV .OR. Z(1,J).LT.CV) GO TO 104
         IX = 1
         IY = J
         IDX = 0
         IDY = 1
         IS = 3
         CALL DRLINE (Z,L,M,N)
  104 CONTINUE
      ISS = 1
      DO 108 JP1=3,N
         J = JP1-1
         DO 107 IP1=2,M
            I = IP1-1
            IF (Z(I,J).GE.CV .OR. Z(IP1,J).LT.CV) GO TO 107
            IXY = IXYPAK(IP1,J)
            IF (NP .EQ. 0) GO TO 106
            DO 105 K=1,NP
               IF (IR(K) .EQ. IXY) GO TO 107
  105       CONTINUE
  106       NP = NP+1
            IF (NP .GT. NR) RETURN
            IR(NP) = IXY
            IX = IP1
            IY = J
            IDX = -1
            IDY = 0
            IS = 1
            CALL DRLINE (Z,L,M,N)
  107    CONTINUE
  108 CONTINUE
      RETURN
C
C     LAST LINE OF STLINE
C----------------------------------------------------------------------
      END
 
      BLOCK DATA CONBD
 
C **********************************************************************
C *   FIRST VERSION: dark ages             CURRENT VERSION: 03/15/88   *
C *--------------------------------------------------------------------*
C *                                                                    *
C *       Initializes parameters for CONREC.  Some of the parameters   *
C *   may not be relevant to this implementation.                      *
C *                                                                    *
C **********************************************************************
 
      COMMON /CONRE1/IOFFP,SPVAL,EPSVAL,CNTMIN,CNTMAX,CNTINT,NOZERO
 
      COMMON /CONRE2/ IX         ,IY         ,IDX        ,IDY        ,
     1                IS         ,ISS        ,NP         ,CV         ,
     2                INX(8)     ,INY(8)     ,IR(1500)   ,NR
 
      COMMON /CONRE4/ SIZEL      ,SIZEM      ,SIZEP      ,NREP       ,
     1                NCRT       ,ILAB       ,NULBLL     ,IOFFD      ,
     2                EXT        ,IOFFM      ,ISOLID     ,NLA        ,
     3                NLM        ,XLT        ,YBT        ,SIDE
 
      DATA IOFFP,SPVAL,EPSVAL,CNTMIN,CNTMAX,CNTINT,NOZERO/0,5*0.0,0/
      DATA SIZEL,SIZEM,SIZEP,NLA,NLM,XLT,YBT,SIDE,ISOLID,NREP,NCRT,ILAB/
     1       1.5,  2.5,   1., 16, 200,.05,.05,  .9,  1023,  6,   4,   1/
      DATA EXT,IOFFD,NULBLL,IOFFM/.25,0,3,0/
      DATA INX(1),INX(2),INX(3),INX(4),INX(5),INX(6),INX(7),INX(8)/
     1        -1 ,   -1 ,    0 ,    1 ,    1 ,    1 ,    0 ,   -1 /
      DATA INY(1),INY(2),INY(3),INY(4),INY(5),INY(6),INY(7),INY(8)/
     1         0 ,    1 ,    1 ,    1 ,    0 ,   -1 ,   -1 ,   -1 /
 
      DATA NR/1500/
 
C
C     LAST LINE OF BLOCK DATA
C----------------------------------------------------------------------
      END
 
C ::::::::::::::::::   E N D    O F    C O N R E C   ::::::::::::::::::::
