SUBROUTINE CONOUT(MENUS)
!
      USE WINTERACTER
      USE BLK1MOD 
      SAVE
!      INCLUDE 'BLK1.COM'
!
      COMMON /OPTION/ SWITCH(4),NUMV,CONTUR(99),IQUAL,XCSQ,NUMCOL
!
      DIMENSION VALUS(MAXP)

      CHARACTER*60  STRELS 

      DATA STRELS/' You have tried to reorder before executing "FILL"'/ 
!                                                                       
!
!  Test to make sure fill has been executed.                            
!               
      IF(MENUUS .EQ. 13) ifilltmp=0
      DO N=1,NE 
        IF(IMAT(N) .GT. 0) THEN 
          DO M=2,NCORN(N),2 
!ipkoct93                                                               
            if(imat(n) .LT. 900) THEN
              IF(NOP(N,M) .EQ. 0) THEN 
                CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'You have tried to plot contours before filling'//char(13)//&
                    'Do you wish to temporarily fill and proceed?'//&
                      CHAR(13)//' ','PLOTTING CONTOURS WITHOUT A FILLED NETWORK?')
!
!   If answer 'No', return
!
                IF (WInfoDialog(4).EQ.2) THEN
                  RETURN     
                ENDIF
                CALL FILM(1)
                ifilltmp=1
	   	    	call hedr
                GO TO 300
              ENDIF
            ENDIF
          ENDDO
        ENDIF 
      ENDDO
!
300   CONTINUE  
      DO N=1,NP
        VALUS(N)=WD(N)
      ENDDO
!
      CALL TOLMAX(VALUS,TTMIN,TTMAX)

      ISZ=0
      IF(MENUS .EQ. 13) THEN
        ISZ=1
        CALL CSET(TTMIN,TTMAX,isz) 
        RETURN
      ENDIF 

      PSCL=1.0
      CALL ELCONT(VALUS,PSCL)
      
      if(ifilltmp .eq. 1) CALL DELETM(0) 

      RETURN
      END
      SUBROUTINE ELCONT(VALUS,PSCL)
!
!  Routine to draw element contours
!
      USE BLK1MOD 
      
!      INCLUDE 'BLK1.COM'
!
      INCLUDE 'BFILES.I90'
      COMMON /BRK/ X(10),Y(10),VL(10),DL(10),VLM(10)
      COMMON /OPTION/ SWITCH(4),NUMV,CONTUR(99),IQUAL,XCSQ,NUMCOL
      LOGICAL SWITCH
!      DIMENSION X(10),Y(10),VL(10),VALUS(*)
      DIMENSION VALUS(*)
      DATA PSCL1/1.0/ITIME/0/
 
      IF(PSCL .eq. 0.) then
        PSCL=PSCL1
      ELSE
        PSCL1=PSCL
      ENDIF
      CALL RRed
      
      CALL GETXC
      
      IF(.NOT. ALLOCATED(NKEY1)) THEN
        ALLOCATE (NKEY1(MAXE))
      ENDIF
      CALL SORTDB(YC,NKEY1,NE)

      DO 500 NN=NE,1,-1
        N=NKEY1(NN)
        IF(IESKP(N) .EQ. 1) GO TO 500
        NCN=NCORN(N)
        IF(NCN .EQ. 9) NCN=8
        DO  M=1,NCN,2
		  if(nop(n,m) .eq. 0) go to 500
          IF(VALUS(NOP(N,M)) .LT. -9998.) GO TO 500
        ENDDO
!
!  Copy values into work array
!
        NCN=NCORN(N)
!        if(ncn .lt. 6) go to 500
        IF(IMAT(N) .GT. 900 .AND.  IMAT(N) .LT. 904) GO TO 500
        IOK=0
        DO 300 M=1,NCN
          IF(NOP(N,M) .EQ. 0) GO TO 500
          X(M)=CORD(NOP(N,M),1)
          Y(M)=CORD(NOP(N,M),2)
          IF(I3DVIEW .EQ. 1) THEN
            IF(VRTSCAL .GT. 0.) THEN
              Y(M)=Y(M)+(WD(NOP(N,M))-VRTORIG)*COS(VANG/57.29578)/VRTSCAL
	        ENDIF
          ENDIF 
         
          IF(X(M) .GT. 0.  .AND.  X(M) .LT. HSIZE) THEN
            IF(Y(M) .GT. 0.  .AND.  Y(M) .LT. 7.) THEN
              IOK=1
            ENDIF
          ENDIF
          VL(M)=VALUS(NOP(N,M))*PSCL
  300   CONTINUE
        IF(IOK .EQ. 0) GO TO 500
!        CALL BRKDWN(X,Y,VL,NCN)
        NELNO=N
        CALL BRKDWN(NCN,NELNO)

!ipkoct93                                                               
      if(ipsw(4) .eq. 1) then 
        NLINP=NCN+1
        X(NLINP)=X(1)
        Y(NLINP)=Y(1)
        CALL DASHLN(X,Y,NLINP,0) 
      endif        
        
  500 CONTINUE
!
!  Print title
!
      ncharr=lenstr(title)
      call rblue
      IF(NCHARR .GT. 1) CALL SYMBL(0.5,7.25,0.20,TITLE,0.0,ncharr)

      XLEG=8.8
      YLEG=7.4

      CALL LEGND(XLEG,YLEG,CONTUR,NUMV,NUMCOL)
      CALL RBlue
      RETURN
      END

      SUBROUTINE LEGND(XLEG,YLEG,CONTUR,NUMV,NUMCOL)
      SAVE
      DIMENSION CONTUR(99),X(10),Y(10)
      DATA LDIGO/2/
          XLOC=XLEG+0.5
          YLOC=YLEG
          csfact=1.0001
          DO 80 N=1,NUMV
            IF(N .LT. NUMV) THEN
!
! Define polygon
!
              X(1)=XLEG
              X(2)=XLEG
              X(3)=XLEG+0.4
              X(4)=XLEG+0.4
              Y(1)=YLOC
              Y(2)=YLOC-0.3
              Y(3)=YLOC-0.3
              Y(4)=YLOC
              nn=(n+1)*csfact
	      if(numv .le. 10) nn=nn+2
              CALL POLYG(X,Y,4,nn)
            ENDIF
!
!  Plot the value on the screen
!
            if(contur(n) .ne. 0.) then
              DIG = ALOG10(ABS(CONTUR(N))) 
            else
              dig = -2.
            endif
            IF(DIG .GT. 2.999) THEN
              LDIG=-DIG - 1
            ELSEIF (DIG .GT. 1.999) THEN
              LDIG = 0
            ELSEIF (DIG .GT. 0.999)  THEN
              LDIG = 1
            ELSEIF (DIG .GT. 0)  THEN
              LDIG = 2
            ELSE
              LDIG = DIG - 2. + .01
              LDIG = -LDIG
            ENDIF
            IF(LDIG .LT. 0) GO TO  70
            DO 60 KK=1,3
              ANUM=10.**(-LDIG)
              IF(N .EQ. 1) THEN
                IF(ABS(CONTUR(2)-CONTUR(1)) .LT. ANUM) THEN
                  LDIG = LDIG + 1
                ELSE
                  GO TO 70
                ENDIF
              ELSE
                IF(ABS(CONTUR(N)-CONTUR(N-1)) .LT. ANUM) THEN
                  LDIG = LDIG + 1
                ELSE
                  GO TO 70
                ENDIF
              ENDIF
   60       CONTINUE
   70       CONTINUE
            call rblue
            CTMP=CONTUR(N)
            IF(ABS(CTMP) .LT. 1.E-7) THEN
              CTMP=0.
              LDIG=LDIGO
            ENDIF

               CALL rblack
            CALL NUMBR(XLOC,YLOC-0.09,0.2,CTMP,0.0,LDIG)
              LDIGO=LDIG
               CALL rblack
!
            CALL PLOTT(X(1),Y(1),3)
            CALL PLOTT(X(2),Y(2),2)
            CALL PLOTT(X(3),Y(3),2)
            CALL PLOTT(X(4),Y(4),2)
            CALL PLOTT(X(1),Y(1),2)
!               
             YLOC=YLOC-0.30
   80     CONTINUE
        CALL RBlue
          RETURN
          END


      SUBROUTINE TOLMAX(VALUS,TTMIN,TTMAX)
!
      USE BLK1MOD
!      INCLUDE 'BLK1.COM'

      DIMENSION VALUS(*)
!
         TMAX = -1.E+20
         TMIN =  1.E+20
         DO 218 J=1,NP
            IF (VALUS(J) .GT. TMAX)  THEN
                TMAX = VALUS(J)
                ITMAX = J
            ENDIF
            IF (VALUS(J) .LT. TMIN)  THEN
                TMIN = VALUS(J)
                ITMIN = J
            ENDIF
  218    CONTINUE
         WRITE(90,*) ' '
         WRITE(90,*) '  Max, Min for entire network '
         WRITE(90,*) '  MAX value = ', TMAX, ' at node ', ITMAX
         WRITE(90,*) '  MIN value = ', TMIN, ' at node ', ITMIN
         WRITE(90,*) ' '
!
! Check for max and min values of elements in the plotting area
!
         TTMAX = -1.E+20
         TTMIN =  1.E+20
         DO 228 N=1,NE
           IF(IESKP(N) .EQ. 0) THEN
              DO 220 M=1,NCORN(N)
                J=NOP(N,M)
!ipk sep99
                if(j .eq. 0) go to 220
                IF (VALUS(J) .GT. TTMAX)  THEN
                  TTMAX = VALUS(J)
                  ITTMAX = J
                ENDIF
                IF (VALUS(J) .LT. TTMIN)  THEN
                  TTMIN = VALUS(J)
                  ITTMIN = J
                ENDIF
  220         CONTINUE
           ENDIF 
  228    CONTINUE
!        
         WRITE(90,*) ' '
         WRITE(90,*) '  Max, Min for plot area '
         WRITE(90,*) '  MAX value = ', TTMAX, ' at node ', ITTMAX
         WRITE(90,*) '  MIN value = ', TTMIN, ' at node ', ITTMIN
!
         RETURN
         END