!ipk  last update March 6 2000 fix IMAT display bug
!ipk  last update Feb 22 1999 add element type option                   
!ipk  last update Jan 21 1999 add plotting of storage widths            
!ipk  lsat update oct 23 1998 change location of label in pgrid         
!                                                                       
!****************************************************************       
!                                                                       
!ipk nov97 change call                                                  
      SUBROUTINE PLOTOT(imz) 
!                                                                       
!  Display grid according to switch setting                             
!       
      USE WINTERACTER
      USE BLKMAP
      USE BLK1MOD
      USE BLK2MOD
!      INCLUDE 'BLK1.COM' 
      INCLUDE 'BFILES.I90'
      include 'TXFRM.COM'
      DIMENSION XLIN(350),YLIN(350)
      CHARACTER*1 IFLAG 
      CHARACTER*80 LIND 
                                   !ycw mar97 add for cross section     
      REAL XPL(5),YPL(5)
      INTEGER           :: iw,ih,ihandle,ient,IHAND1,IHAND2,IXPM,IYPX,IXPX,IYPM
      common /hands/ iw,ih,ihandle,IHAND1,IHAND2,IXPM,IYPX,IXPX,IYPM
      DATA IFIRST/0/
      IF(IFIRST .EQ. 0) THEN
        NTTRAC=0
        IFIRST=1
      ENDIF
      HT=0.2 
!      CALL CHEXIT
!                                                                       
      if(imz .ne. 2) CALL CLSCRN 
!                                                                       
!ipk oct97 output to backup file                                        
!                                                                       
!ipk test for write to backup                                           
      if(imz .eq. 1) then 
        rewind ibak 
        call wrtout(0) 
      endif 
!                                                                       
!ycw mar97 add for cross section                                        
      if(LCROSS) then 
!!         call plotcs 
         return 
      endif 
!ycw                                                                    
!                                                                       
!  Rescale coordinates for plotting                                     
!                                                                       
      CALL SCLMAP 
!rrr                                                                    
      IF (IPSW(8) .EQ. 1)  CALL PGRID 
!                                                                       
      CALL SCLCRD 
!ycw mar97 add for cross section                                        
      if(ICRS.ne.0) then 
         do i=1,2 
            XPCS(i)=(XPCS(i)-XMIN)/PSCALE 
            YPCS(i)=(YPCS(i)-YMIN)/PSCALE 
         enddo 
         do i=1,NCSNOD 
            XCND(i)=(XCND(i)-XMIN)/PSCALE 
            YCND(i)=(YCND(i)-YMIN)/PSCALE 
         enddo 
      endif 
!ycw                                                                    
      PSCALE = 1. 
      XMIN = 0. 
      YMIN = 0. 
!      if(np .gt. 100000) call backc(1)

!      if(ipsw(4) .eq. 1) then
!        do j=1,ne
!          if(ieskp(j) .eq. 0  .and.  imz .ne. 2)  call fillemC(j,1) 
!        enddo
!      endif
!      write(90,*) 'going to drawbk',nbkfl,iswbkfl(1)
!      IF(NBKFL .GT. 0) THEN
!        DO I=1,NBKFL
!          IF(ISWBKFL(I) .EQ. 1) CALL DRAWBK(I,IMZ)
!          IF(ISWBKFL(I) .EQ. 2) CALL DRAWBKBM(I,IMZ)
!        ENDDO
!      ENDIF
      IF(IDDSW .EQ. -1) THEN
        IF(NP .GT. 100000) THEN
          IDDSW=0
        ELSE
          IDDSW=1
        ENDIF
      ENDIF
      IF(IPSW(6) .EQ. 1  .AND.  IGUNIT .EQ. 203) THEN
        IDDSW=0
      ELSEIF(NP .LE. 100000) THEN
        IDDSW=1
      ENDIF
      if(IDDSW .EQ. 0) call backc(1)

      if(ipsw(4) .eq. 1) then
        jj=1
        if(nbkfl .gt. 0) jj=16
        do j=1,ne
        
          if(ieskp(j) .eq. 0  .and.  imz .ne. 2)  call fillemC(j,jj) 
        enddo
      endif

      IF(NBKFL .GT. 0) THEN
        DO I=1,NBKFL
          IF(ISWBKFL(I) .EQ. 1) CALL DRAWBK(I,IMZ)
          IF(ISWBKFL(I) .EQ. 2) CALL DRAWBKBM(I,IMZ)
        ENDDO
      ENDIF
!      write(90,*) 'finished drawbk'
!                                                                       
!  Plot map data                                                        
!  
      IF(IMP .NE. 0) THEN 
         IF(IPSW(1) .EQ. 1) THEN 
           CALL PLTMAP 
         ENDIF 
      ENDIF 
!                                                                       
!  If IPSW(1) = 1 plot map or plot outline if no map                    
!                                                                       
      IF(IMP .EQ. 0) THEN 
        IF(IPSW(1) .EQ. 1) IPSW(2)=1 
!ipk sep94 allow plotting of outline after map                          
!     ELSE                                                              
!       IF(IPSW(1) .EQ. 1) GO TO 10                                     
      ENDIF 
!                                                                       
!  Plot outline of grid only                                            
!                                                                       
      IF(IPSW(2) .EQ. 1) THEN 
        CALL OUTLN 
!        GO TO 250                                                      
      ENDIF 
!                                                                       
!  Plot nodes when IPSW(3) .EQ. 1                                       
!                                                                       
   10 CONTINUE 
      IF(IPSW(3) .EQ. 1  .OR.  IPSW(9) .EQ. 1  .OR. IPSW(14) .EQ. 1) THEN 
        IF(NP .GT. 0) THEN 
          IF(IPSW(3) .EQ. 1) ITP=0 
          IF(IPSW(14) .EQ. 1) ITP=2
          IF(IPSW(9) .EQ. 1) then
            ITP=-1
            wdmin=1.e10
            wdmax=-1.e10
            do j=1,np
              IF(INSKP(J) .EQ. 1) cycle
              IF(CORD(J,1) .GT. 0.  .AND.  CORD(J,1) .LT. HSIZE) THEN 
                IF(CORD(J,2) .GT. 0.  .AND.  CORD(J,2) .LT. 7.5) THEN 
                  wdmin=min(wdmin,wd(j))
                  wdmax=max(wdmax,wd(j))
                else
                  cycle
                endif
              else
                cycle
              endif
            enddo
            if(abs(wdmin) .gt. abs(wdmax)) then
              temp=log10(abs(wdmin))
            elseif(wdmin .eq. 0) then
              temp=2.5
            else
              temp=log10(wdmax)
            endif
            if(temp .gt. 2.) then
              itp=-3
            elseif(temp .gt. 1.) then
              itp=-4
            else
              itp=-5
            endif
          endif
          DO 15  J=1,NP 
!            IF(MOD(J,10) .EQ. 0) THEN 
!              CALL CHINT(IFLAG) 
!              IF(IFLAG .EQ. 'i') GO TO 250 
!            ENDIF 
            IF(INSKP(J) .EQ. 1) GO TO 15 
            IF(CORD(J,1) .GT. 0.  .AND.  CORD(J,1) .LT. HSIZE) THEN 
              IF(CORD(J,2) .GT. 0.  .AND.  CORD(J,2) .LT. 7.5) THEN 
                CALL PLTNOD(J,ITP) 
                GO TO 15 
              ENDIF 
            ENDIF 
            INSKP(J)=1 
   15     CONTINUE 
        ENDIF 
      ENDIF 
!                                                                       
!  Plot data points                                                     
!                                                                       
      IF(IPSW(6) .EQ. 1) THEN
        IF(IGUNIT .EQ.203) THEN
          LENROW=NCOLS1*4
          FCT=10**NSIGF 
		  raddisp=rad/txscal
		  if(raddisp .lt. 0.01) raddisp=0.01
          if(colint .eq. 0.) colint=1.
          CALL IGrFillPattern(4)
          IF(ICOLSW .EQ. 0) THEN
            INTH=TXSCAL*0.08*FLOAT(NSIGF+3)/CELLSIZX+1
            DO J=1,NCOLS1
              XCOL(J)=(CELLSIZX*(J-1)+XXORG+XS)/TXSCAL
            ENDDO
            INTV=TXSCAL*0.12/CELLSIZY+1
            DO I=1,NROWS1,INTV
              IF(NGRTYP .EQ. 2) THEN
                YCOL(I)=(CELLSIZY*(NROWS1+1-I)+YYORG+YS)/TXSCAL
              ELSE
                YCOL(I)=(CELLSIZY*(I-1)+YYORG+YS)/TXSCAL
              ENDIF
              IF(YCOL(I) .GT. 0.  .AND.  YCOL(I) .LT. 7.5) THEN 
                READ(203,POS=LENROW*(I-1)+1) (VALLIN(J),J=1,NCOLS1)
                DO J=1,NCOLS1,INTH
                  IF(VALLIN(J) .GT. -9000.   .AND.  VALLIN(J) .LT. 1.E20 ) THEN 
                    IF(XCOL(J) .LT. 0.  .AND.  XCOL(J) .GT. HSIZE) CYCLE 
                    CALL PLOTT(XCOL(J),YCOL(I),3) 
                    CALL PLOTT(XCOL(J),YCOL(I),2) 

                    CALL Rblack 
                    if(nsigf .lt.1) then
                      nsigff=1
                    else
                      nsigff=nsigf
                    endif
                    CALL NUMBR(XCOL(J),YCOL(I),0.12,VALLIN(J),0.0,NSIGFF)
                    CALL RBlue 
                  ENDIF
                ENDDO  
              ENDIF
            ENDDO  
          ELSE
            DO J=1,NCOLS1
              XCOL(J)=(CELLSIZX*(J-1)+XXORG+XS)/TXSCAL
            ENDDO
            INTV=TXSCAL*7.5/(FLOAT(IH)*CELLSIZY)+1
            DO I=1,NROWS1,INTV
              IF(NGRTYP .EQ. 2) THEN
                YCOL(I)=(CELLSIZY*(NROWS1+1-I)+YYORG+YS)/TXSCAL
              ELSE
                YCOL(I)=(CELLSIZY*(I-1)+YYORG+YS)/TXSCAL
              ENDIF
              IF(YCOL(I) .GT. 0.  .AND.  YCOL(I) .LT. 7.5) THEN 
                READ(203,POS=LENROW*(I-1)+1) (VALLIN(J),J=1,NCOLS1)
                DO J=1,NCOLS1,INTV
                  IF(VALLIN(J) .GT. -9000.   .AND.  VALLIN(J) .LT. 1.E20 ) THEN 
                    IF(XCOL(J) .LT. 0.  .AND.  XCOL(J) .GT. HSIZE) CYCLE 
                    IF(VALLIN(J) .GE. 0.) THEN
                      NCOLN=VALLIN(J)/COLINT+0.5
                    ELSE
                      NCOLN=-VALLIN(J)/COLINT-0.5
                    ENDIF
                    NCOLN=MOD(NCOLN,13)+2
                    CALL CHANGE_COLOR(NCOLN)
!                    CALL IGrCircle(XCOL(J),YCOL(I),RADDISP)
                     CALL IGrRectangle(XCOL(J)-RADDISP,YCOL(I)-RADDISP,XCOL(J)+RADDISP,YCOL(I)+RADDISP)
                  ENDIF  
                ENDDO      
              ENDIF
            ENDDO
          ENDIF
        ENDIF
        IF(MAXPTS .GT. 0) THEN
		  raddisp=rad/txscal
		  if(raddisp .lt. 0.01) raddisp=0.01
          if(colint .eq. 0.) colint=1.
          DO 40 J=1,MAXPTS,nmapf 
            IF(MOD(J,100000) .EQ. 0) WRITE(155,*) J,' points processed'
            IF(VAL(J) .GT. -9000.) THEN 
              X=CMAP(J,1) 
              Y=CMAP(J,2) 
              IF(X .GT. 0.  .AND.  X .LT. HSIZE) THEN 
                IF(Y .GT. 0.  .AND.  Y .LT. 7.5) THEN 
                  CALL PLOTT(X,Y,3) 
                  if(icolsw .eq. 0) then
                    CALL PLOTT(X,Y,2) 

                    CALL Rblack 
! ipk mar01
! ipk jun04                  CALL NUMBR(X,Y,0.15,VAL(J)*FCT,0.0,-1) 
                    if(nsigf .lt.1) then
                      nsigff=1
                    else
                      nsigff=nsigf
                    endif
                    call numbr(x,y,0.12,val(j),0.0,nsigff)
                    CALL RBlue 
                  else
                    if(val(j) .ge. 0.) then
                      ncoln=val(j)/colint
                    else
                      ncoln=-val(j)/colint
                    endif
                    ncoln=mod(ncoln,13)+2
                    call change_color(ncoln)
                    CALL IGrCircle(X,Y,RADDISP)
!                  call circle(x,y,raddisp)
                  endif
                ENDIF 
              ENDIF 
            ENDIF 
40        CONTINUE 
        ENDIF
        Call RBlue
!        GO TO 250                                                      
      ENDIF 
!                                                                       
!  Plot existing elements                                               
!                                                                       
!ipk add element type option                                            
      IF(IPSW(5) .EQ. 1  .OR.  IPSW(4) .EQ. 1  .or. ipsw(7) .eq. 1) THEN 
!        CALL PLOTT(0.,7.0,3)                                           
!        CALL PLOTT(10.,7.0,2)                                          
!IPK JAN98                                                              
        IERC=imz 
        if(ne .gt. 0) then
         DO 20  J=1,NE 
          XC(J)=VOID 
          YC(J)=VOID 
!          IF(MOD(J,10) .EQ. 0) THEN 
!            CALL CHINT(IFLAG) 
!            IF(IFLAG .EQ. 'i') GO TO 250 
!          ENDIF 
          IF(IESKP(J) .EQ. 0) THEN 
!IPK JAN98 ADD IERC                                                     
            IF (IMAT(J) .NE. 0)  CALL PLTELM(J,IERC) 
          ENDIF 
20       CONTINUE 
         IF(IERC .GT. 0) THEN 
!          call clscrn() 
!          WRITE(LIND,*)   ' Zero node corner nodes' 
!          call symbl                                                    &
!     &      (1.1,5.5,0.25,LIND,0.0,80)                                  
!          WRITE(LIND,*)   ' See MESSAGES.OUT file for details' 
!          call symbl                                                    &
!     &      (1.1,5.2,0.25,LIND,0.0,80)                                  
!          WRITE(LIND,*)   ' Press enter to terminate' 
!          call symbl                                                    &
!     &      (1.1,4.9,0.25,LIND,0.0,80)                                  
!          ndig=1 
!          CALL GTCHARX(IFLAG,NDIG,5.0,5.5) 
!          CALL QUIT_PGM() 
!          stop 
           CALL WMessageBox(0,0,0,'Error in element connnection'//&
                            CHAR(13)//'Zero corner node found'//&
                            CHAR(13)//'See Mesgen.out for details',&
                           'ERROR IN ELEMENT CONNECTIONS')

         ENDIF
        endif 
      ENDIF 
      if(IDDSW .EQ. 0) then
        call backc(2)
      endif
!ycw mar97 add for cross section                                        
      if(ICRS.ne.0) then 
         call plott(XPCS(1),YPCS(1),3) 
         call RRED 
         call plott(XPCS(2),YPCS(2),2) 
         do i=1,NCSNOD 
            xpl(1)=XCND(i)-0.04 
            ypl(1)=YCND(i)-0.04 
            xpl(2)=XCND(i)+0.04 
            ypl(2)=ypl(1) 
            xpl(3)=xpl(2) 
            ypl(3)=YCND(i)+0.04 
            xpl(4)=xpl(1) 
            ypl(4)=ypl(3) 
            xpl(5)=xpl(1) 
            ypl(5)=ypl(1) 
            call polyfl(xpl,ypl,5,1) 
         enddo 
         call RBLACK 
      endif 
!ycw                                                                    
250   continue 
      IF(NTRACT .GT. 0) THEN
        DO KK=1,NTRACT 
          XLIN(KK)=CORD(ITRAC(KK),1) 
          YLIN(KK)=CORD(ITRAC(KK),2) 
        ENDDO
        CALL RRED
!ipk jan01
        CALL THICKL 
        CALL DASHLN(XLIN,YLIN,NTRAC,0) 
!ipk jan01
        CALL RBLACK
        CALL THINL
          call pltnod(ITRAC(1),0) 
          call pltnod(ITRAC(NTRACT),0) 
      ENDIF
        
      IF (IPSW(8) .EQ. 1)  CALL PGRID 

!IPK JAN01
      IF(IPSW(10) .EQ. 1) CALL PLOTCC

!ipk oct02
      IF(IPSW(11) .EQ. 1) CALL PLOTCSTR

!ipk oct03
      IF(IPSW(12) .EQ. 1) CALL PLOTCRSS(0)

      if(ipsw(13) .eq. 1) call plotcrss(1)

      IF(INREORD .EQ. 1) THEN
        CALL PLOTORDS
      ENDIF

      IF(IMZ .NE. 1) THEN
        CALL DOPLOT(IMZ)
      ENDIF
      CALL CHEXIT
      RETURN 
      END                                           
!                                                                       
!****************************************************************       
!                                                                       
      SUBROUTINE PLTNOD(J,ICOL) 
!                                                                       
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 
!                                                                       
!  Plot nodes on screen                                                 
!                                                                       
      HT = .20 
      IF (CORD(J,1) .LT. VDX)  RETURN 
      X = CORD(J,1) 
      Y = CORD(J,2) 
      CALL PLOTT(X,Y,3) 
      CALL PLOTT(X,Y,2) 
      IF(ICOL .EQ. 0  .OR.  ICOL .EQ. 1) THEN 
        Y = Y+0.07 
        FPN = J
      ELSEIF(ICOL .EQ. 2) THEN
        Y = Y+0.07
        FPN = LAY(J)
        IF(LAY(J) .EQ. -9999) GO TO 500
      ELSE 
!ipk jul02        Y = Y-0.11 
        Y = Y+0.10 
!ipk jul02        FPN=WD(J)*10. 
        fpn=wd(j)
		if(icrin .eq. 23) fpn=wd1(j)
      ENDIF 
      IF(IJUN(J) .NE. 0) THEN 
        Y=Y-0.17*FLOAT(IJUN(J)-2) 
      ENDIF 
      IF(ICOL .LT. 1) THEN 
        CALL RRed 
        if(lock(j) .eq. 1) call rgreen
      ELSE 
        CALL RBlack 
      ENDIF 
      IF(X .GT. 0.  .AND.  X .LT. HSIZE) THEN 
        IF(Y .GT. 0.  .AND.  Y .LT. 7.5) THEN 
! ipk mar01
! ipk jul02
         if(icol .lt. 0) then
          call numbr(x,y,0.12,fpn,0.0,-icol)
         else
          CALL NUMBR(X,Y,0.15,FPN,0.0,-1) 
         endif
        ENDIF 
      ENDIF 
  500 CONTINUE
      CALL RBlue 
!                                                                       
      END                                           
!                                                                       
!****************************************************************       
!                                                                       
!IPK JAN98      SUBROUTINE PLTELM(J)                                    
      SUBROUTINE PLTELM(J,IERC) 
                                                                        
      USE BLK1MOD
!ipk jan99                                                              

       INCLUDE 'TXFRM.COM'
       INCLUDE 'BFILES.I90'
!IPK MAY02       COMMON  /TXFRM/  XS, YS, TXSCAL 
                                                                        
      DIMENSION XLIN(9),YLIN(9),BLVL(9) 
!                                                                       
!      INCLUDE 'BLK1.COM' 
      CHARACTER*1 IJNK 
      CHARACTER*80 LIND 
!                                                                       
!  Plot elements already formed                                         
!                          
      imz=ierc
      ierc=0                                             
      if(NBKFL .eq. 0) then
        call rblue 
      else
        call ryellow
        call rblack
      endif
      IF (IMAT(J) .EQ. 0 )  RETURN 
      NCN = NCORN(J) 
!                                                                       
      XXC = 0. 
      YYC = 0. 
      NLINP=0 
      IESKP(J)=1 
      DO 15  K=1,NCN 
         N = NOP(J,K) 
         IF (N .EQ. 0 .AND. MOD(K,2) .EQ. 1)  THEN 
            CALL SETD(23) 
!            CALL CLSCRN() 
!IPK JAN98            WRITE(*,*)   ' Zero node corner node'             
!IPK JAN98            WRITE(*,*)   ' ELEM, NOP(ELEM,K) '                
!IPK JAN98            WRITE(*,'(I5,I10,7I5)')  J,(NOP(J,KK),KK=1,NCN)   
            WRITE(90,*)   ' ELEM, NOP(ELEM,K) ' 
            WRITE(90,'(I5,I10,7I5)')  J,(NOP(J,KK),KK=1,NCN) 
!IPK JAN98            WRITE(*,*) 'Press enter to exit'                  
!IPK JAN98            READ(*,'(A)') IJNK                                
!IPK JAN98            CALL Quit_Pgm                                     
!IPK JAN98            STOP                                              
            IERC=IERC+1 
            do kk=1,8
              nop(j,kk)=0
            enddo
            imat(j)=0
            RETURN 
         ENDIF 
!                                                                       
!        IF (N .EQ. 0  .OR. CORD(N,1) .LT. VDX) GOTO 15                 
         IF (N .EQ. 0) GO TO 15 
         IF(MOD(K,2) .EQ. 1  .AND.  CORD(N,1) .LT. VDX) GOTO 15 
         IF(CORD(N,1) .LT. VDX) THEN 
           IF(K .EQ. NCN) THEN 
             X=(CORD(NOP(J,K-1),1)+CORD(NOP(J,1),1))/2. 
             Y=(CORD(NOP(J,K-1),2)+CORD(NOP(J,1),1))/2. 
           ELSE 
             X=(CORD(NOP(J,K-1),1)+CORD(NOP(J,K+1),1))/2. 
             Y=(CORD(NOP(J,K-1),2)+CORD(NOP(J,K+1),1))/2. 
           ENDIF 
         ELSE 
!                                                                       
           X = CORD(N,1) 
           Y = CORD(N,2) 
         ENDIF 
            IF(X .GT. 0.  .AND.  X .LT. HSIZE) THEN 
              IF(Y .GT. 0.  .AND.  Y .LT. 7.5) THEN 
                IESKP(J)=0 
                GO TO 16 
              ENDIF 
            ENDIF 
   15 END DO 
   16 CONTINUE 
!                                                                       
      IF(IESKP(J) .EQ. 1) GO TO 26 

      if(ipsw(7) .eq. 1  .and.  iqsw(2) .GT. 0) then
        IF(IQSW(2) .EQ. 1) ittmp=imat(j)
        IF(IQSW(2) .EQ. 2) ittmp=igrpser(j)
        IF(ITTMP .GT. 900 ) THEN
          ICCT=MOD(ITTMP+1,10)+4
        ELSE
            icct=MOD(ittmp,10)+4
        ENDIF
        if(imz .ne. 2) then
          call fillemc(j,icct)
        endif
      endif

      DO 25  K=1,NCN 
         N = NOP(J,K) 
!                                                                       
         IF (N .EQ. 0) go to 25
         IF (CORD(N,1) .LT. VDX) GOTO 25 
!                                                                       
         X = CORD(N,1) 
         Y = CORD(N,2) 
!                                                                       
         IF (NCN .NE. 5  .OR.  K .LT. 5) THEN 
           IF (MOD(K,2) .EQ. 1)  THEN 
              XXC = XXC + X 
              YYC = YYC + Y 
           ENDIF 
         ENDIF 
         NLINP=NLINP+1 
!                                                                       
         XLIN(NLINP)=X 
         YLIN(NLINP)=Y 
         BLVL(NLINP)=WD(N)
         IF (K .EQ. 1)  THEN 
            X1 = X 
            Y1 = Y 
         ENDIF 
   25 END DO 
      IF(NCN .GT. 5) THEN 
        NLINP=NLINP+1 
        XLIN(NLINP)=X1 
        YLIN(NLINP)=Y1 
        BLVL(NLINP)=WD(NOP(J,1))
      ENDIF 
      if(i3dview .eq. 1) then
        do k=1,nlinp
          YLIN(K)=YLIN(K)+(BLVL(K)-VRTORIG)*COS(VANG/57.29578)/VRTSCAL
        enddo
      endif
!ipkoct93                                                               
      if(ipsw(4) .eq. 1) then 
        if(ncn .eq. 8  .or.  imat(j) .lt. 901) then 
          CALL DASHLN(XLIN,YLIN,NLINP,0) 
!          write(155,'(2i6,24f12.3)') j,ncn,(xlin(k),ylin(k),blvl(k),k=1,ncn)
        endif 
      endif 
!      IF(IMAT(J) .LT. 901  .AND. IPSW(4) .EQ. 1)                       
!     +   CALL DASHLN(XLIN,YLIN,NLINP,0)                                
!ipkoct93                                                               
!                                                                       
!  Plot elem number at center if  IPSW(5) = 1                           
!                                                                       
      CALL RCyan 
      IF (NCN .EQ. 3  .OR.  NCN .EQ. 5)  NCN = 4 
      XC(J) = 2.*XXC/NCN 
      YC(J) = 2.*YYC/NCN 
!      IF(IMAT(J) .GT. 900 ) THEN                                       
      IF(IMAT(J) .GT. 900  .and. ncorn(j) .ne. 8) THEN 
        CALL RBlue 
        RETURN 
      ENDIF 
!ipk feb99 add element type option                                      
      IF(IPSW(5) .EQ. 1  .or.  ipsw(7) .eq. 1) THEN 
        HT = .20 
        if(ipsw(5) .eq. 1) then 
          FPN = J 
!ipk mar00 fix imat display bug
        elseif((iqsw(1) .gt. 0)  .or.  (iqsw(1) .eq. 0  .and.  iqsw(2) .eq. 0) ) then 
          CALL RBLACK
          if(iqsw(1) .eq. 1) fpn=imat(j) 
          if(iqsw(1) .eq. 2) fpn=igrpser(j) 
!        elseif(iqsw(2) .eq. 1) then
!          CALL RBLACK
!          fpn=imat(j)
        else
		  go to 30
		endif 
        IF(XC(J) .GT. 0.  .AND.  XC(J) .LT. HSIZE) THEN 
          IF(YC(J) .GT. 0.  .AND.  YC(J) .LT. 7.5) THEN 
!ipkoct93                                                               
!            IF(IMAT(J) .LT. 901) CALL NUMBR(XC(J),YC(J),HT,FPN,0.0,-1) 
! ipk mar01
!ipk jun02
             xxc=xc(j)
             yyc=yc(j)
             CALL NUMBR(XXC,YYC,0.15,FPN,0.0,-1) 
          ENDIF 
!        elseif(iqsw(2) .eq. 1) then
!          CALL RBLACK
!          fpn=imat(j)
        endif 
   30   continue
      ENDIF 
                                                                        
!ipk jan99   add plot of 1-d element widths                             
      if(ncorn(j) .eq. 3  .or.  ncorn(j) .eq. 5) then 
        ncn=3 
        n1=nop(j,1) 
        n2=nop(j,3) 
!                                                                       
!...... first for widths                                                
                                                                        
        IF(IPW1 .EQ. 1) THEN
          wd11=width(n1)/txscal 
          wd2=width(n2)/txscal
		ELSE
          IF(NRIVCR1(N1) .EQ. 0  .AND.  NRIVCR2(N1) .EQ. 0) RETURN 
          IF(NRIVCR1(N2) .EQ. 0  .AND.  NRIVCR2(N2) .EQ. 0) RETURN 
		  BT1=  &
            CRSDAT(NRIVCR1(N1),1,1)*WTRIVCR1(N1)+  &
            CRSDAT(NRIVCR2(N1),1,1)*WTRIVCR2(N1)
		  BT2=  &
            CRSDAT(NRIVCR1(N2),1,1)*WTRIVCR1(N2)+  &
            CRSDAT(NRIVCR2(N2),1,1)*WTRIVCR2(N2)
          H1=WIDEL-BT1
          H2=WIDEL-BT2
          CALL INTERPWLV(N1,H1,AR1,WR1,DWR1)
          CALL INTERPWLV(N2,H2,AR2,WR2,DWR2)
          WIDTH(N1)=WR1
          WIDTH(N2)=WR2
		  IF(IPW1 .EQ. 2) THEN
		    WD11=WR1*WIDSCL/TXSCAL
			WD2=WR2*WIDSCL/TXSCAL
		  ELSE
		    WD11=AR1*WIDSCL/TXSCAL
			WD2=AR2*WIDSCL/TXSCAL
		  ENDIF

		ENDIF
        if(wd11 .gt. 0.  .and.  wd2 .gt. 0.) then 
          x1= cord(n1,1) 
          x2= cord(n2,1) 
          y1= cord(n1,2) 
          y2= cord(n2,2) 
          eldir=atan2(y2-y1,x2-x1) 
          elnorm=eldir-1.5708 
          xlin(1)=x1+cos(elnorm)*wd11/2. 
          xlin(5)=xlin(1) 
          xlin(4)=x1-cos(elnorm)*wd11/2. 
          xlin(2)=x2+cos(elnorm)*wd2/2. 
          xlin(3)=x2-cos(elnorm)*wd2/2. 
          ylin(1)=y1+sin(elnorm)*wd11/2. 
          ylin(5)=ylin(1) 
          ylin(4)=y1-sin(elnorm)*wd11/2. 
          ylin(2)=y2+sin(elnorm)*wd2/2. 
          ylin(3)=y2-sin(elnorm)*wd2/2. 
          call dashln(xlin,ylin,5,0) 
        endif 
                                                                        
!...... then for storage widths                                         
                                                                        
        wd11=(wids(n1)+width(n1))/txscal 
        wd2=(wids(n2)+width(n2))/txscal 
        if(wids(n1) .gt. 0.  .and.  wids(n2) .gt. 0.) then 
          x1= cord(n1,1) 
          x2= cord(n2,1) 
          y1= cord(n1,2) 
          y2= cord(n2,2) 
          eldir=atan2(y2-y1,x2-x1) 
          elnorm=eldir-1.5708 
          xlin(1)=x1+cos(elnorm)*wd11/2. 
          xlin(5)=xlin(1) 
          xlin(4)=x1-cos(elnorm)*wd11/2. 
          xlin(2)=x2+cos(elnorm)*wd2/2. 
          xlin(3)=x2-cos(elnorm)*wd2/2. 
          ylin(1)=y1+sin(elnorm)*wd11/2. 
          ylin(5)=ylin(1) 
          ylin(4)=y1-sin(elnorm)*wd11/2. 
          ylin(2)=y2+sin(elnorm)*wd2/2. 
          ylin(3)=y2-sin(elnorm)*wd2/2. 
          call dashln(xlin,ylin,5,1) 
        endif 
      endif 
                                                                        
                                                                        
      CALL RBlue 
   26 CONTINUE 
!                                                                       
      RETURN 
      END                                           
!                                                                       
!****************************************************************       
!                                                                       
      SUBROUTINE PLTMAP 
!                                                                       
      USE BLKMAP
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 
!                                                                       
!  Plot map of input data                                               
!                                                                       
!  Determine how long each line is                                      
!                                                                       
      JS=1 
!                                                                       
       K=0 
        CALL RCyan 
        DO 20 J=1,MAXPTS 
          MLEN=J-JS 
!          write(90,*) 'j,mlen',j,mlen,cmap(j,1),k+1,lintyp(k+1),vdx      
!          write(123,*) 'j,mlen',j,mlen,cmap(j,1),k+1,lintyp(k+1),vdx      
          IF(XMAP(J) .LE. VDX  .or. j .eq. maxpts) THEN 
            if(j .eq. maxpts  .and. xmap(j) .gt. vdx) mlen=mlen+1
!                                                                       
!  Now draw it.                                                         
!                                                                       
            K=K+1 
            IF(MLEN .GT. 1) THEN 
              LTP=LINTYP(K) 
!ipk oct96                                                              
              if(icolon(ltp+1) .eq. 1) then 
                                                                        
                IF(LTP .NE. 2) THEN 
!ipk oct96              IF(LTP .LT. 2) THEN                             
                  CALL RRed
                    
!                  write(90,*) 'at nwpen ltp',ltp                       
                  IF(LTP .GT. 0) CALL NWPEN(2*LTP+1) 
                  IF(LTP .GT. 2) LTP=0 
                  CALL DBDASHLN(cmap(js,1),cmap(js,2),MLEN,LTP) 
                ENDIF 
              ENDIF 
            ENDIF 
            IF(MLEN .EQ. 0  .AND.  LINTYP(K) .EQ. -999) GO TO 30 
            JS=J+1 
          ENDIF 
   20   CONTINUE                                                        
   30 CONTINUE                                                          
      CALL RBlue                                                        
      RETURN                                                            
!                                                                       
      END                                           
!                                                                       
!***********************************************************************
!                                                                       
      SUBROUTINE SCLMAP 
!                                                                       
!  Scale map coordinates for plotting                                   
!  Keep track and update information for mapping                        
!   screen coordinates back to user coordinates                         
!                                                                       
      USE BLKMAP
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 
!                                                                       

      INCLUDE 'TXFRM.COM'
!IPK MAY02       COMMON  /TXFRM/  XS, YS, TXSCAL 
!                                                                       
!ipk may94  moved to blk1.com      DATA XREF,YREF  / 0.0, 0.0 /         
!                                                                       
        DO 10  J=1,MAXPTS 
         IF (CMAP(J,1) .LT. VDX)  GOTO 10 
         CMAP(J,1) =  (CMAP(J,1)-XMIN)/PSCALE 
         CMAP(J,2) =  (CMAP(J,2)-YMIN)/PSCALE 
   10 END DO 
!                                                                       
      XREF = (XREF-XMIN)/PSCALE 
      YREF = (YREF-YMIN)/PSCALE 
      IF(IASPCT .EQ. 1) THEN
        VRTSCAL=VRTSCAL*PSCALE
      ENDIF
      TXSCAL = TXSCAL*PSCALE 
      XS = XREF*TXSCAL 
      YS = YREF*TXSCAL 
      write(90,*) ' The line that follows gives the values used for a te&
     &mporary origin and scale'                                         
      write(90,6000) xs,ys,txscal 
 6000 format(3f15.4) 
!                                                                       
      RETURN 
      END                                           
!                                                                       
!***********************************************************************
!                                                                       
      SUBROUTINE SCLCRD 
!                                                                       
!  Scale coordinates for plotting                                       
!  Keep track and update information for mapping                        
!   screen coordinates back to user coordinates                         
!                                                                       
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 
!                                                                       
	  REAL*8 ANGPT,ANGNEW,DRAD,DVANG,DVANGOLD

	  DATA PI/3.14159265/,ITIME/0/,DRAD/57.29577957855/
	  IF(ITIME .EQ. 0) THEN
        VANGOLD=90.
		VANG=90.
		HANG=0.
		HANGOLD=0.
!  	    DRAD=180./PI
	    ITIME=1
	  ENDIF
	  DVANG=VANG
	  DVANGOLD=VANGOLD
!                                                                       

!    ROTATE BACK IF NEEDED


      IF((HANGOLD .EQ. HANG)  .AND.  (VANGOLD .EQ. VANG)) GO TO 5
      IF(HANGOLD .NE. 0.  .OR.  VANGOLD .NE. 90.) THEN
        IF(NP .GT. 0) THEN 
          DO  J=1,NP 
            IF (CORD(J,1) .GE. VDX)  THEN

              IF(VANGOLD .LT. 90.) THEN
                CORD(J,2)=4.+(CORD(J,2)-4.)/DSIN(DVANGOLD/DRAD)
              ENDIF

			  ANGPT=DATAN2D(CORD(J,2)-4,CORD(J,1)-5.)
              VLEN=SQRT((CORD(J,1)-5.)**2+(CORD(J,2)-4.)**2)			 
              ANGNEW=ANGPT+HANGOLD
!			  IF(J .EQ. 1) THEN 
!			    WRITE(90,*) 'ROTBACK',ANGPT,VLEN,ANGNEW,CORD(J,1),CORD(J,2)
!			  ENDIF
              CORD(J,1)=5.+VLEN*DCOS(ANGNEW/DRAD)
			  CORD(J,2)=4.+VLEN*DSIN(ANGNEW/DRAD)
!			  IF(J .EQ. 1) THEN 
!			    WRITE(90,*) CORD(J,1),CORD(J,2)
!			  ENDIF
            ENDIF
		  ENDDO 
	    ENDIF
	  ENDIF

    5 CONTINUE

      IF(NP .GT. 0) THEN 
        DO 10  J=1,NP 
          IF (CORD(J,1) .LT. VDX)  GOTO 10 
          CORD(J,1) =  (CORD(J,1)-XMIN)/PSCALE 
          CORD(J,2) =  (CORD(J,2)-YMIN)/PSCALE 
   10  CONTINUE 
      ENDIF 
!                                                                       
!    ROTATE IF NEEDED

      IF((HANGOLD .EQ. HANG)  .AND.  (VANGOLD .EQ. VANG)) GO TO 15

      IF(HANG .NE. 0  .OR. VANG .LT. 90.) THEN
        IF(NP .GT. 0) THEN 
          DO  J=1,NP 
            IF (CORD(J,1) .GE. VDX)  THEN
			  ANGPT=DATAN2D(CORD(J,2)-4,CORD(J,1)-5.)
              VLEN=SQRT((CORD(J,1)-5.)**2+(CORD(J,2)-4.)**2)			 
              ANGNEW=ANGPT-HANG 
!			  IF(J .EQ. 1) THEN 
!			    WRITE(90,*) 'ROT',ANGPT,VLEN,ANGNEW,CORD(J,1),CORD(J,2)
!			  ENDIF
              CORD(J,1)=5.+VLEN*DCOS(ANGNEW/DRAD)
			  CORD(J,2)=4.+VLEN*DSIN(ANGNEW/DRAD)
			  IF(VANG .LT. 90.) THEN
	  	  	    CORD(J,2)=4.+(CORD(J,2)-4.)*DSIN(DVANG/DRAD)
			  ENDIF
!			  IF(J .EQ. 1) THEN 
!			    WRITE(90,*) CORD(J,1),CORD(J,2)
!			  ENDIF
            ENDIF
		  ENDDO 
	    ENDIF
	  ENDIF
	  HANGOLD=HANG
	  VANGOLD=VANG

   15 CONTINUE       

      RETURN 
!                                                                       
      END                                           
      SUBROUTINE BOX(HEAD,NSIZ) 
!                                                                       
!  Routine to draw NSIZ header boxes at top of page with the HEAD label 
!                                                                       
      CHARACTER*8 HEAD(*) 
        XSY=0. 
        XLMT=FLOAT(NSIZ) 
        DO 200 N=1,NSIZ 
          CALL SYMBL(XSY,7.65,0.20,HEAD(N),0.0, 8) 
          XSY=XSY+1.0 
  200   CONTINUE 
!                                                                       
!  Draw box around selections                                           
!                                                                       
      CALL PLOTT(0.0,7.0,3) 
      CALL PLOTT(XLMT,7.0,2) 
      CALL PLOTT(XLMT,7.495,2) 
      CALL PLOTT(0.0,7.495,2) 
      CALL PLOTT(0.0,7.0,2) 
        XPT=0. 
        DO 205 I=1,NSIZ 
          XPT=XPT+1.0 
          CALL PLOTT(XPT,7.0,3) 
          CALL PLOTT(XPT,7.495,2) 
  205   CONTINUE 
      RETURN 
      END                                           
      SUBROUTINE BOXR(NBOX) 
      SAVE 
!                                                                       
!  Routine to draw header box at top right of page with the HEAD label  
!                                                                       
      CHARACTER*24 HEAD 
      CHARACTER*16 HEAD1 
      CHARACTER*24 HEAD2 
      DIMENSION X(5),Y(5) 
      DATA HEAD  /' (z)oom  r(d)raw (q)uit '/ 
      DATA HEAD1 /' r(d)raw (q)uit '/ 
      DATA HEAD2 /' (n)ext  (z)oom  (q)uit '/ 
!                                                                       
!  Draw box around selections                                           
!                                                                       
      NBX=IABS(NBOX) 
      XLEFT=10-NBX 
      Y(1)=7.5 
      Y(2)=7.5 
      Y(3)=7.995 
      Y(4)=7.995 
      Y(5)=7.5 
!     CALL PLOTT(XLEFT,7.0,3)                                           
!     CALL PLOTT(10.0,7.0,2)                                            
!     CALL PLOTT(10.0,7.495,2)                                          
!     CALL PLOTT(XLEFT,7.495,2)                                         
!     CALL PLOTT(XLEFT,7.0,2)                                           
!     IF(NBOX .GT. 1) THEN                                              
      DO 200 K=1,NBX 
        X(1)=XLEFT 
        X(4)=XLEFT 
        X(5)=XLEFT 
        XLEFT=XLEFT+1.0 
        X(2)=XLEFT 
        X(3)=XLEFT 
        IBLK=4 
        CALL POLYFL(X,Y,5,IBLK) 
        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) 
!       DO 200 K=1,NBOX-1                                               
!         XLEFT=XLEFT+1.                                                
!         CALL PLOTT(XLEFT,7.0,3)                                       
!         CALL PLOTT(XLEFT,7.495,2)                                     
  200 END DO 
!      ENDIF                                                            
!                                                                       
!  Establish label                                                      
!                                                                       
      IF(NBOX .EQ. 3) THEN 
        CALL SYMBL(7.0,7.65,0.20,HEAD,0.0,24) 
      ELSEIF(NBOX .EQ. -3) THEN 
        CALL SYMBL(7.0,7.65,0.20,HEAD2,0.0,24) 
      ELSEIF(NBOX .EQ. 2) THEN 
        CALL SYMBL(8.0,7.65,0.20,HEAD1,0.0,16) 
      ENDIF 
      RETURN 
      END                                           
!                                                                       
!                                                                       
      SUBROUTINE OUTLN 
!-                                                                      
!......OUTLN DRAWS BOUNDARIES FOR THE SYSTEM                            
!-                                                                      
       USE BLK1MOD
!     INCLUDE 'BLK1.COM' 
!                                                                       
!      INTEGER*2 MSN 
!      COMMON /MID/ MSN(MAXP) 
!                                                                       
      DATA  IFIRST  / 1 / 
!-                                                                      
!-                                                                      
!     DATA MAXB/MAXE/                                                   
      YMAXX = 7.50 
!-                                                                      
!-.....PLOT BOUNDARY OUTLINE.....                                       
!-                                                                      
! 100 DO 110 J=1,MAXB                                                   
!     NBP(J) = 0                                                        
! 110 CONTINUE                                                          
!                                                                       
      IF (IFIRST .EQ. 1)  GOTO  185 
      IFIRST = 0 
!                                                                       
       NPTS=-1 
!      READ(5,5020) NPTS                                                
! 5020 FORMAT( 16I5 )                                                   
      IF( NPTS .EQ. 0 ) RETURN 
  185 CONTINUE 
      DO 186  I=1,NP 
  186 MSN(I) = 0 
      DO 187 J=1,NE 
         IF(IESKP(J) .NE. 0) GO TO 187 
         IF (IMAT(J) .LE. 0)  GOTO 187 
         IF (IMAT(J) .GT. 900) GO TO 187 
         NCN = 6 
         IF (NOP(J,7) .NE. 0)  NCN = 8 
         IF (NOP(J,6) .EQ. 0) NCN=3 
         DO 188  K=2,NCN,2 
            N = NOP(J,K)
            if(n .gt. 0) then 
              MSN(N) = MSN(N) + 1 
            endif
  188    CONTINUE 
  187 END DO 
      DO 195 J = 1, NE 
            IF(IESKP(J) .NE. 0) GO TO 195 
            IF(IMAT(J) .LE. 0) GO TO 195 
!ipkoct93                                                               
!            IF(IMAT(J) .GT. 900) GO TO 195                             
            IF(IMAT(J) .GT. 900  .and. nop(j,7) .eq. 0) GO TO 195 
         NCN = 6 
         IF (NOP(J,7) .NE. 0)  NCN = 8 
         IF (NOP(J,6) .EQ. 0) NCN=3 
            DO 194 K = 2,NCN , 2 
               L=NOP(J,K) 
               IF(L .EQ. 0) GO TO 194 
               IF(MSN(L) .EQ. 1) THEN 
                 N1 = NOP(J,K-1) 
                 N2 = NOP(J,K) 
                 N3 = MOD(K+1,NCN) 
                 IF(N3 .EQ. 0) N3=NCN 
                 N3 = NOP(J,N3) 
                 X1 =  CORD(N1,1) 
                 Y1 =  CORD(N1,2) 
                 X2 =  CORD(N2,1) 
                 Y2 =  CORD(N2,2) 
                 X3 =  CORD(N3,1) 
                 Y3 =  CORD(N3,2) 
                 CALL FIT(X1,Y1,X2,Y2,X3,Y3) 
               ENDIF 
  194       CONTINUE 
  195 END DO 
      RETURN 
      END                                           
      SUBROUTINE AROHD(XPAGE,YPAGE,XTIP,YTIP,AHLEN,AHWID,ICODE) 
!*********************************** .....AROHD.....                    
      SAVE 
!                                                                       
      IF(AHWID.LE.0.001) AHWID=AHLEN 
      I1=ICODE/10+3 
      IF(I1.NE.3) I1=2 
      KK=MOD(ICODE,10) 
      I2=2 
      I3=2 
      I4=2 
      IF(KK.EQ.2) GO TO 10 
      IF(KK.NE.4) GO TO 20 
      I3=3 
      GO TO 10 
   20 IF(KK.NE.5) GO TO 30 
      I2=3 
      I3=3 
      GO TO 10 
   30 IF(KK.NE.8) GO TO 10 
      I2=3 
      I3=3 
      I4=4 
   10 CONTINUE 
      CALL PLOTT(XPAGE,YPAGE,3) 
      CALL PLOTT(XTIP,YTIP,I1) 
      TX=XTIP-XPAGE 
      TY=YTIP-YPAGE 
      XLEN=SQRT(TX**2+TY**2) 
      IF(XLEN .GT. 0.001) GO TO 200 
      XLEN=0.001 
      IF(ABS(TX) .LT. 0.001) TX=SIGN(0.001,TX) 
      IF(ABS(TY) .LT. 0.001) TY=SIGN(0.001,TY) 
  200 CONTINUE 
      TA=AHLEN/XLEN 
      XX=XTIP-TA*TX 
      YY=YTIP-TA*TY 
      AH=(AHWID/2.)**2 
      DY=SQRT(AH*TX**2/(TX**2+TY**2)) 
      DY = SIGN(DY,TX) 
      DX=SQRT(AH*TY**2/(TX**2+TY**2)) 
      DX = SIGN(DX,TY) 
      X1=XX+DX 
      X2=XX-DX 
      Y1=YY+DY 
      Y2=YY-DY 
      CALL PLOTT(X2,Y1,I2) 
      CALL PLOTT(X1,Y2,I3) 
      CALL PLOTT(XTIP,YTIP,I4) 
      RETURN 
      END                                           
!                                                                       
!$$$                                 AUG 1987                           
!     SUBROUTINE TEST(X,Y,IG)                                           
!                                                                       
!...... Routine to that plot is on paper                                
!                                                                       
!     SAVE                                                              
!                                                                       
!                                                                       
!     IG=0                                                              
!     IF(X .LT. 0. ) RETURN                                             
!     IF(X .GT. 10.) RETURN                                             
!     IF(Y .LT. 0. ) RETURN                                             
!     IF(Y .GT. 7.0) RETURN                                             
!     IG=1                                                              
!     RETURN                                                            
!     END                                                               
!                                                                       
      SUBROUTINE FIT(X1,Y1,X2,Y2,X3,Y3) 
      SAVE 
!                                                                       
      INTEGER   I2,I3,IG 
      common /tek/ itek 
                                                                        
      DATA I2/2/,I3/3/ 
      NPTS =  7 
      DS = 1.0/FLOAT(NPTS) 
      S = 0.0 
!      IG=0                                                             
!     CALL TEST(X1,Y1,IT)                                               
!     IF(IT .GT. 0) THEN                                                
      CALL PLOTT(X1,Y1,I3) 
      IG=I3 
!     ENDIF                                                             
                                                                        
        dx3 = x1-x3 
        dx2 = x1-x2 
        dy3 = y1-y3 
        dy2 = y1-y2 
        if (abs(dx2) .le. 1.E-8)  dx2 = 1.E-8 
        if (abs(dx3) .le. 2.E-8)  dx3 = 2.E-8 
!       call test(x3,y3,itt)                                            
        if (abs(dy3/dx3 - dy2/dx2) .le. abs(.01*dy2/dx2)) then 
!  .and.                                                                
!    +     itt .gt. 0  .and. it .gt. 0)  then                           
             call plott(x3,y3,i2) 
        else 
                                                                        
      DO 100 J = 1, NPTS 
      S = S + DS 
      XN1 = 1.0-3.0*S+2.0*S**2 
      XN2 = 4.0*S*(1.0-S) 
      XN3 = S*(2.0*S-1.0) 
      X= XN1*X1 + XN2*X2 + XN3*X3 
      Y = XN1*Y1 + XN2*Y2 + XN3*Y3 
!     CALL TEST(X,Y,IT)                                                 
!     IF(IT .GT. 0) THEN                                                
!       IF(IG .EQ. 0) THEN                                              
!         IG=I3                                                         
!       ELSE                                                            
          IG=I2 
!       ENDIF                                                           
        CALL PLOTT(X,Y,IG) 
!     ELSE                                                              
!       IG=0                                                            
!     ENDIF                                                             
  100 END DO 
         endif 
                                                                        
      RETURN 
      END                                           
!                                                                       
!****************************************************************       
!                                                                       
      SUBROUTINE PGRID 
!                                                                       
!  Form rectangular grid for guide lines by filling map arrays          
!                                                                       
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 
!                                                                       

       INCLUDE 'TXFRM.COM'

!IPK MAY02       COMMON  /TXFRM/  XS, YS, TXSCAL 
!                                                                       
      DIMENSION  XG(2),YG(2) 
!                                                                       
      DATA   IFIRST  / 1 / 
!                                                                       
      IF (IFIRST .EQ. 1)  THEN 
         DX = 10. 
         DY = 10. 
         X0 = -100. 
!ipk sep94 update to 7.5 size         Y0 =  -70.                        
         Y0 =  -75. 
         X9 =  HSIZE*10. 
!ipk sep94 update to 7.5 size         Y9 =   70.                        
         Y9 =   75. 
!                                                                       
         IF (XMIN .GT. -VDX)  THEN 
            XMIN = -100. 
            XMAX = -XMIN 
            IPSW(8) = 1 
         ENDIF 
         IF (YMIN .GT. -VDX)  THEN 
!ipk sep94 update to 7.5 size            YMIN = -70.                    
            YMIN = -75. 
            YMAX = -YMIN 
            IPSW(8) = 1 
         ENDIF 
!                                                                       
         IFIRST = 0 
         RETURN 
!                                                                       
      ELSE 
!         XDIF = TXSCAL * 10.5 
         XDIF = TXSCAL * HSIZE*1.05 
         IXDIF =  IFIX( LOG10(XDIF) ) 
         XRANGE = 10**IXDIF 
         XFAC = XDIF/XRANGE 
         DX = XRANGE/10. 
         IF ( XFAC .GE. 5.)  THEN 
            DX = 5.*DX 
         ELSEIF (XFAC .GE. 2.)  THEN 
            DX = 2.*DX 
         ENDIF 
!                                                                       
         X0 = -NINT(XS/DX - .5) * DX - DX 
         X9 = X0 + XDIF 
!                                                                       
         DY = DX 
!ipk sep94 update to 7.5 scale         YDIF = .70*XDIF                  
         YDIF = .75*XDIF 
         Y0 = -NINT(YS/DY -.5) * DY - DY 
         Y9 = Y0 + YDIF 
                                                                        
      ENDIF 
!                                                                       
! vertical-grid lines                                                   
      LTP = 0 
      MLEN = 2 
      HT = .18 
!                                                                       
      DO 10 CX = X0,X9, DX 
         XG(1) = (CX + XS)/TXSCAL 
         YG(1) = (Y0 + YS)/TXSCAL 
         XG(2) = XG(1) 
         YG(2) = (Y9 + YS)/TXSCAL 
         CALL NWPEN(8) 
         CALL DASHLN(XG,YG,MLEN,LTP) 
!                                                                       
         FPN = CX 
         IF (AMOD(FPN,1.) .EQ. 0.  .OR.  ABS(FPN) .LT. 0.01)  THEN 
            IPLC = -1 
         ELSE 
            IPLC = 1 
         ENDIF 
         X = XG(1) 
!         Y = YG(1) + .02                                               
!ipk oct98 change y location                                            
         Y = .20 
         IF ( (X .GT. 0.  .AND.  X .LT. HSIZE)  .AND.                    &
     &        (Y .GT. 0.  .AND.  Y .LT. 7.5) ) THEN                     
!ipk sep94 change colour            CALL NWPEN(12)                      
             CALL NWPEN(8) 
! ipk mar01
             CALL NUMBR(X,Y,0.15,FPN,0.0,IPLC) 
         ENDIF 
   10 END DO 
!                                                                       
! horizontal-grid lines                                                 
      DO 20 CY = Y0,Y9, DY 
         XG(1) = (X0 + XS)/TXSCAL 
         YG(1) = (CY + YS)/TXSCAL 
         XG(2) = (X9 + XS)/TXSCAL 
         YG(2) = YG(1) 
         CALL NWPEN(8) 
         CALL DASHLN(XG,YG,MLEN,LTP) 
!                                                                       
         FPN = CY 
         IF (AMOD(FPN,1.) .EQ. 0.  .OR.  ABS(FPN) .LT. 0.01)  THEN 
            IPLC = -1 
         ELSE 
            IPLC = 1 
         ENDIF 
!         X = XG(1)                                                     
         X = .02 
         Y = YG(1) 
         IF ( (X .GT. 0.  .AND.  X .LT. HSIZE)  .AND.                    &
     &        (Y .GT. 0.  .AND.  Y .LT. 7.5) ) THEN                     
!ipk sep94  change color           CALL NWPEN(12)                       
             CALL NWPEN(8) 
! ipk mar01
             CALL NUMBR(X,Y,0.15,FPN,0.0,IPLC) 
         ENDIF 
   20 END DO 
!                                                                       
      CALL RBlue 
!                                                                       
      END                                           
                                                                        
      SUBROUTINE RESCAL 
!                                                                       
!  Scale for plotting                                                   
!                                                                       
!                                                                       
      USE BLKMAP
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 

      INCLUDE 'TXFRM.COM'
    
      INCLUDE 'BFILES.I90'
!IPK MAY02       COMMON  /TXFRM/  XS, YS, TXSCAL 
!                                                                       
      VDX  = - 1.0E+10 
      XREF=0. 
      YREF=0. 
!                                                                       
!     Reset map coordinates to original scale                           
!                                                                       
      IF(MAXPTS .GT. 0) THEN 
        DO J=1,MAXPTS 
          IF(CMAP(J,1) .GE. VDX) THEN 
            CMAP(J,1)=TXSCAL*CMAP(J,1) - XS 
            CMAP(J,2)=TXSCAL*CMAP(J,2) - YS 
          ENDIF 
        ENDDO 
      ENDIF 
!                                                                       
!     Reset nodal coordinates                                           
!                                                                       
      IF(NP .GT. 0) THEN 
        DO J=1,NP 
          CORD(J,1) = XUSR(J) 
          CORD(J,2) = YUSR(J) 
        ENDDO 
      ENDIF 
!ycw mar97 add for cross section                                        
      if(ICRS.ne.0) then 
         do i=1,2 
            XPCS(i)=XPCS(i)*TXSCAL - XS 
            YPCS(i)=YPCS(i)*TXSCAL - YS 
         enddo 
         do i=1,NCSNOD 
            XCND(i)=XCND(i)*TXSCAL - XS 
            YCND(i)=YCND(i)*TXSCAL - YS 
         enddo 
      endif 
!ycw                                                                    
!                                                                       
!     Reset controlling scales                                          
!                                                                       
      TXSCAL = 1. 
      XS=0. 
      YS=0. 
      XMIN = 1.E+20 
      XMAX = -XMIN 
      YMIN = 1.E+20 
      YMAX = -YMIN 
      IF(IMP .GT. 0) THEN 
!                                                                       
!  Find max and min                                                     
!                                                                       
!                                                                       
        DO J=1,MAXPTS 
          IF (CMAP(J,1) .GT. VDX)  THEN 
            IF (CMAP(J,1) .LT. XMIN)  XMIN = CMAP(J,1) 
            IF (CMAP(J,1) .GT. XMAX)  XMAX = CMAP(J,1) 
            IF (CMAP(J,2) .LT. YMIN)  YMIN = CMAP(J,2) 
            IF (CMAP(J,2) .GT. YMAX)  YMAX = CMAP(J,2) 
          ENDIF 
        ENDDO 
      ENDIF 
!                                                                       
      IF(NP .GT. 0) THEN 
        DO J=1,NP 
          IF (CORD(J,1) .GT. VDX)  THEN 
            INSKP(J)=0 
            IF (CORD(J,1) .LT. XMIN)  XMIN = CORD(J,1) 
            IF (CORD(J,1) .GT. XMAX)  XMAX = CORD(J,1) 
            IF (CORD(J,2) .LT. YMIN)  YMIN = CORD(J,2) 
            IF (CORD(J,2) .GT. YMAX)  YMAX = CORD(J,2) 
          ENDIF 
        ENDDO 
      ENDIF 
      IF(NE .GT. 0) THEN 
        DO J=1,NE 
          IF(NOP(J,1) .NE. 0) THEN
            IESKP(J)=0 
          ENDIF
        ENDDO 
      ENDIF 
!                                                                       
! 
      DO J=1,NBKFL
        XMAX=MAX(XMAX,BFMINMAX(J,1),BFMINMAX(J,3))
        XMIN=MIN(XMIN,BFMINMAX(J,1),BFMINMAX(J,3))                                                                            
        YMAX=MAX(YMAX,BFMINMAX(J,2),BFMINMAX(J,4))
        YMIN=MIN(YMIN,BFMINMAX(J,2),BFMINMAX(J,4))                                                                            
      ENDDO
      AMAP=(XMAX-XMIN)*(YMAX-YMIN) 
      XSCALE = (XMAX-XMIN)/(hsize-0.5) 
      YSCALE = (YMAX-YMIN)/6.5 
      PSCALE = MAX(XSCALE,YSCALE) 
!                                                                       
      XAVE = (XMIN + XMAX) /2.0 
      YAVE = (YMIN + YMAX) /2.0 
      XMIN = XAVE - hsize/2.*PSCALE 
      YMIN = YAVE - 3.5*PSCALE 
      XMAX = XAVE + (hsize-0.5)/2.*PSCALE 
      YMAX = YAVE + 3.25*PSCALE 
!                                                                       
!  Plot all data                                                        
!                                                                       
      CALL PLOTSV(0) 
!ipk nov97 add (0)                                                      
      CALL PLOTOT(0) 
    RETURN 
      END                                           

!IPK JAN01  NEW ROUTINE

      SUBROUTINE PLOTCC

      USE BLK1MOD
      use blk2mod
!      INCLUDE 'BLK1.COM'
      DIMENSION XLIN(350),YLIN(350)

      IF(NCLM .GT. 0) THEN
                         
!Process each line
        CALL RBLUE

        DO NCLL=1,NCLM 
          WRITE(90,*) 'PLOTR1-1130 NCLL,NCLM',NCLL,NCLM
          DO KK=1,350 
            IF(ICCLN(NCLL,KK) .NE. 0) THEN
              IF(KK .EQ. 1) THEN
                X=CORD(ICCLN(NCLL,KK),1)+0.1
                Y=CORD(ICCLN(NCLL,KK),2)+0.1
                IF(X .GT. 0.  .AND.  X .LT. HSIZE) THEN 
                  IF(Y .GT. 0.  .AND.  Y .LT. 7.5) THEN 
                    FPN=NCLL
! ipk mar01
                    CALL NUMBR(X,Y,0.2,FPN,0.0,-1) 
                  ENDIF 
                ENDIF
              ENDIF
              XLIN(KK)=CORD(ICCLN(NCLL,KK),1) 
              YLIN(KK)=CORD(ICCLN(NCLL,KK),2) 
            ELSE
              if(kk .eq. 1) GO TO 510
              NTRAC=KK-1
              X=CORD(ICCLN(NCLL,KK-1),1)+0.1
              Y=CORD(ICCLN(NCLL,KK-1),2)+0.1
              IF(X .GT. 0.  .AND.  X .LT. HSIZE) THEN 
                IF(Y .GT. 0.  .AND.  Y .LT. 7.5) THEN 
                  FPN=NCLL
! ipk mar01
                  CALL NUMBR(X,Y,0.2,FPN,0.0,-1) 
                ENDIF 
              ENDIF
              if(ntrac .eq. 1) then
                call IGrCharSize(0.5,0.5)
                call IGrMarker(x-0.1,y-0.1,14)
                call IGrCharSize(1.0,1.0)
              endif
!                                                                       
!  Draw along line                                                     
!
              IF(NTRAC .GT. 1) THEN
                CALL THICKL 
                CALL DASHLN(XLIN,YLIN,NTRAC,0) 
                CALL THINL
              ENDIF
              GO TO 400
            ENDIF
  359       CONTINUE            
          ENDDO 
  400     CONTINUE
          IF(NTRAC .EQ. 1) THEN
            NODL=ICCLN(NCLL,1)
            DO N=1,NE
              IF(IMAT(N) .LT. 900  .AND.  IMAT(N) .GT. 0) THEN
                IF(NCORN(N) .EQ. 5  .OR.  NCORN(N) .EQ. 3) THEN
                  IF(NOP(N,1) .EQ. NODL) THEN
                    DIRX=CORD(NOP(N,3),1)-CORD(NOP(N,1),1)
                    DIRY=CORD(NOP(N,3),2)-CORD(NOP(N,1),2)
                    GO TO 420
                  ELSEIF(NOP(N,3) .EQ. NODL) THEN
                    DIRX=CORD(NOP(N,1),1)-CORD(NOP(N,3),1)
                    DIRY=CORD(NOP(N,1),2)-CORD(NOP(N,3),2)
                    GO TO 420
                  ENDIF
                ENDIF
              ENDIF
            ENDDO
  420       DIR=ATAN2(DIRX,-DIRY)
            D1=CORD(NODL,1)
            D2=CORD(NODL,2)
          ELSE

!     Plot arrows on continuity line

  	        DIRX=CORD(ICCLN(NCLL,1),1)-CORD(ICCLN(NCLL,NTRAC),1)
	        DIRY=CORD(ICCLN(NCLL,1),2)-CORD(ICCLN(NCLL,NTRAC),2)
		    IF(DIRX .EQ. 0.  .AND. DIRY .EQ. 0.) THEN
		      DIR=0.
  	  	    ELSE
		      DIR=ATAN2(DIRX,-DIRY)
		      D1=(CORD(ICCLN(NCLL,1),1)+CORD(ICCLN(NCLL,NTRAC),1))/2.
	          D2=(CORD(ICCLN(NCLL,1),2)+CORD(ICCLN(NCLL,NTRAC),2))/2.
  	        ENDIF
          ENDIF
          DIR1=DIR+2.35619
          DIR2=DIR-2.35619
          DE1=D1+0.4*COS(DIR)
          DE2=D2+0.4*SIN(DIR)
          DEA1=DE1+0.1*COS(DIR1)
          DEA2=DE2+0.1*SIN(DIR1)
          DEB1=DE1+0.1*COS(DIR2)
          DEB2=DE2+0.1*SIN(DIR2)
          CALL RBLUE
          CALL PLOTT(D1,D2,3)
          CALL PLOTT(DE1,DE2,2)
          CALL PLOTT(DEA1,DEA2,2)
          CALL PLOTT(DE1,DE2,3)
          CALL PLOTT(DEB1,DEB2,2)
          CALL RBLUE
510       CONTINUE            
        ENDDO
      ENDIF
        
      RETURN
      END

      SUBROUTINE PLOTCSTR

      USE BLK1MOD
!      INCLUDE 'BLK1.COM'

!     Plot arrows on control structures

      DO N=1,NE
	   IF(IMAT(N) .GT. 903) THEN

	    DIRX=CORD(NOP(N,3),1)-CORD(NOP(N,1),1)
	    DIRY=CORD(NOP(N,3),2)-CORD(NOP(N,1),2)
		IF(DIRX .EQ. 0.  .AND. DIRY .EQ. 0.) THEN
		  DIR=0.
        ELSEIF(NCORN(N) .LT. 6) THEN
		  DIR=ATAN2(DIRY,DIRX)
		  D1=CORD(NOP(N,1),1)
		  D2=CORD(NOP(N,1),2)
		ELSE
		  DIR=ATAN2(DIRX,-DIRY)
          IF(NOP(N,2) .NE. 0) THEN
  		    D1=CORD(NOP(N,2),1)
		    D2=CORD(NOP(N,2),2)
          ELSE
            D1=(CORD(NOP(N,1),1)+CORD(NOP(N,3),1))/2.
            D2=(CORD(NOP(N,1),2)+CORD(NOP(N,3),2))/2.
          ENDIF
		ENDIF
        DIR1=DIR+2.35619
		DIR2=DIR-2.35619
        IF(IESKP(N) .EQ. 0) THEN
          IF(NOP(N,2) .NE. 0) THEN
  	 	    D1=CORD(NOP(N,2),1)
		    D2=CORD(NOP(N,2),2)
          ELSE
            D1=(CORD(NOP(N,1),1)+CORD(NOP(N,3),1))/2.
            D2=(CORD(NOP(N,1),2)+CORD(NOP(N,3),2))/2.
          ENDIF
		  DE1=D1+0.4*COS(DIR)
		  DE2=D2+0.4*SIN(DIR)
		  DEA1=DE1+0.1*COS(DIR1)
		  DEA2=DE2+0.1*SIN(DIR1)
		  DEB1=DE1+0.1*COS(DIR2)
		  DEB2=DE2+0.1*SIN(DIR2)
		  CALL RRED
          CALL PLOTT(D1,D2,3)
          CALL PLOTT(DE1,DE2,2)
		  CALL PLOTT(DEA1,DEA2,2)
          CALL PLOTT(DE1,DE2,3)
		  CALL PLOTT(DEB1,DEB2,2)
		  CALL RBLUE
		ENDIF
	   ENDIF
	  ENDDO
      RETURN
	  END

      SUBROUTINE PLOTCRSS(isw)

      USE BLK1MOD
!      INCLUDE 'BLK1.COM'
      INCLUDE 'TXFRM.COM'
!      COMMON/ICN1/ ICN(MAXP) 
   
      CHARACTER*11 PART1,PART2

      if(isw .eq. 0) then
        CALL RGREEN
      
        DO NN=1,NCRSEC
          N=IVMIL(NN)
          IF(N .EQ. 0) CYCLE
          xpt=(xcrs(n)+xs)/txscal
          ypt=(ycrs(n)+ys)/txscal
          a=NOREACH(N)/1000.
          fpn=n+a                
          IF(XPT .GT. 0.  .AND.  XPT .LT. HSIZE) THEN 
            IF(YPT .GT. 0.  .AND.  YPT .LT. 7.5) THEN 
              call plotcr(xpt,ypt,0.05)
              CALL NUMBR(xpt,ypt-0.1,0.13,FPN,0.0,3) 
            ENDIF
          ENDIF
        ENDDO      
      ENDIF

      IF(ISW .EQ. 1) THEN

        DO J=1,MAXP 
          ICN(J)=0 
        END DO 
!     First sort out the potential midsides                             
!     Note that transition elements caues a problem                     
!     Find these first                                                  
        DO 200 N=1,NE 
          if(NCORN(N) .GT. 5) GO TO 200
          IF(NCORN(N) .EQ. 5  .AND.  IMAT(N) .LT. 901) THEN 
!                                                                       
!     We have a transition  mark node number as if it were corner       
!                                                                       
            ICN(NOP(N,3))=1 
            ICN(NOP(N,1))=2 
            ICN(NOP(N,4))=2 
            ICN(NOP(N,5))=2 
          ELSE 
!                                                                       
!     Store ICN = 2 for corner nodes                                    
!                                                                       
            NCN=NCORN(N) 
!IPKOCT93          IF(IMAT(N) .GT. 900) THEN                            
            IF(IMAT(N) .GT. 900  .AND.  IMAT(N) .LT. 904) THEN 
              MST=1 
            ELSE 
              MST=2 
            ENDIF 
            DO 180 M=1,NCN,MST 
              ICN(NOP(N,M))=2 
  180       CONTINUE 
          ENDIF 
  200   END DO

        DO J=1,NP

          IF(ICN(J) .EQ. 2) THEN
            WRITE(PART1,'(I5,F6.3)') &
            ,NRIVCR1(J),WTRIVCR1(J)

            WRITE(PART2,'(I5,F6.3)') &
            ,NRIVCR2(J),WTRIVCR2(J)

            IF (CORD(J,1) .LT. VDX)  GO TO 300 
            X = CORD(J,1) 
            Y = CORD(J,2) 

            CALL RBlack 
            IF(X .GT. 0.  .AND.  X .LT. HSIZE) THEN 
              IF(Y .GT. 0.  .AND.  Y .LT. 7.5) THEN 
                CALL SYMBL(X-0.25,Y+.24,0.10,PART1,0.0,11) 
                CALL SYMBL(X-0.25,Y+.12,0.10,PART2,0.0,11) 
              endif
            ENDIF 
  300      CONTINUE           
          ENDIF
        ENDDO
      ENDIF
      CALL RBlue 
      RETURN
      END
