SUBROUTINE ADDMESHT

      USE BLK1MOD 
      USE WINTERACTER
      USE BLKOUT
      USE IFPORT
      INCLUDE 'BFILES.I90'
      INCLUDE 'TXFRM.COM'
      
      INTEGER OUTPOL,TWO,ZERO,IFILOUT,ONE
      INTEGER   NTRIAN(5000,2),ICT
      REAL XMAP1(5000),YMAP1(5000)
      
      CHARACTER*1 ANSW(10),ANS
      CHARACTER(LEN=80)   :: DATAIN,OPTIONS
      CHARACTER(LEN=96)   :: LOCDIR,SAVDIR,SAVDIR1
      LOGICAL EXISTS
      INTEGER*2 RESULT
      DATA ANSW/' ',' ',' ',' ',' ','b','n','z','r','q'/ 
      do k=1,80
        options(k:k)=' '
      enddo
      ONE=1
      TWO=2
      ZERO=0
      OUTPOL=23
      ICT=0
      isw=1
      NMESS=2
      NHTPSV=NHTP 
      NMESSSV=NMESS 
      NBRRSV=NBRR 
!      call GETINT(ISW)
      CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to read outline data from a file'//&
                           CHAR(13)//' ','READ OUTLINE DATA FROM FILE?')

!   If answer 'No', go to get data from screen
!
      IF (WInfoDialog(4).EQ.2) GO TO 180
        
      CALL RDOUTLIN
      IF(NOUTLIN .EQ. 0) GO TO 180

      DO N=1,NOUTLIN
        XMAP1(N)=XOUTL(N)  
        YMAP1(N)=YOUTL(N)  
        NTRIAN(N,1)=N
        IF(N .LT. NOUTLIN) THEN
          NTRIAN(N,2)=N+1
        ELSE
          NTRIAN(N,2)=1
        ENDIF
      ENDDO
      ICT=NOUTLIN
      GO TO 500
!   add headers
  180 NHTPSV=NHTP 
      NMESSSV=NMESS 
      NBRRSV=NBRR 
      NHTP=0 
      NMESS=48 
      NBRR=5 
      call hedr
!   go and get points to form outline 
  200 CALL xyloc(XTEMP,YTEMP,ans,IBOX)
      siz=0.1
      call drawcr(xtemp,ytemp,siz)
      IF(IRMAIN .EQ. 1) RETURN 
!         
      IF(ANS .EQ. 'c') THEN 
        if(ibox .eq. 0) go to 400
        I=IBOX 
        ANS=ANSW(I) 
      ENDIF 
      IF(ANS .EQ. 'b') THEN
        ICT=ICT-1
        GO TO 200
      ELSEIF(ANS .EQ. 'n') THEN
        GO TO 500
      ELSEIF(ANS .EQ. 'q') THEN
        RETURN
      ENDIF
400   ICT=ICT+1
      XMAP1(ICT) = XTEMP*TXSCAL - XS
      YMAP1(ICT) = YTEMP*TXSCAL - YS
      IF(ICT .GT. 1) THEN
        NTRIAN(ICT-1,1)=ICT-1
        NTRIAN(ICT-1,2)=ICT
      ENDIF
      GO TO 200
  500 CONTINUE
      NTRIAN(ICT,1)=ICT
      NTRIAN(ICT,2)=1

!   write current data to a scratch file for later addition
        IFILOUT=IACTVFIL+50
        CALL WRTFIL(IFILOUT)
!
!      IF(IACTVFIL .GT. 0) THEN 
!        CALL WRTFIL(50)          
!        IFILOUT=IACTVFIL+50
!        CALL WRTFIL(IFILOUT)
!        CALL ZEROOUT
!        IACTVFIL=ITOTFIL
!      ELSE
!        IACTVFIL=1
!      ENDIF
!
!!   clear screen
!      CALL clscrn
      
!   form TRIANG file

     OPEN(OUTPOL,FILE='TEST.POLY', STATUS='UNKNOWN')
     WRITE(OUTPOL,*) ICT,TWO,ZERO,ZERO
     DO K=1,ICT
       WRITE(OUTPOL,*) K,XMAP1(K),YMAP1(K)
     ENDDO
!     WRITE(OUTPOL,*) ICT,ZERO
     WRITE(OUTPOL,*) ICT,ONE
     DO J=1, ICT
       WRITE(OUTPOL,*) J,ntrian(J,1),ntrian(J,2),ISW
     ENDDO
     WRITE(OUTPOL,*) ZERO
     FLUSH (OUTPOL)
     REWIND (OUTPOL)
     CLOSE (OUTPOL)

!       OPTIONS = ' -pqa5000V TEST'
       OPTIONS(1:3) = ' -p'
       nct=3
       iswq=1
       iswy=0
       id1=100
       CALL PANELFILLT(ISWQ,ISWY,ID1)

       IF(ISWQ .EQ. 1) THEN
         NCT=NCT+1
         OPTIONS(NCT:NCT)='q'
       ENDIF
       IF(ISWY .EQ. 1) THEN
         NCT=NCT+1
         OPTIONS(NCT:NCT)='q'
       ENDIF
       ID1=ID1**2/2
       WRITE(OPTIONS(NCT+1:NCT+12),'(''a'',I6.6,'' TEST'')') ID1
!      go to TRIANGLE
        INQUIRE (FILE = 'test.1.ele', EXIST = exists)
        if(exists) then
          open(77,file= 'test.1.ele')
          close(77,status='DELETE')
        ENDIF
       
        INQUIRE (FILE = 'test.1.node', EXIST = exists)
        if(exists) then
          open(77,file= 'test.1.node')
          close(77,status='DELETE')
        ENDIF
       
        INQUIRE (FILE = 'test.1.poly', EXIST = exists)
        if(exists) then
          open(77,file= 'test.1.poly')
          close(77,status='DELETE')
        ENDIF
       IDCH=0 
       INQUIRE (FILE = "C:\Program Files\RMA\TRIANGLE.EXE", EXIST = exists) 
        if(.not. exists) then
          INQUIRE (FILE = "TRIANGLE.EXE", EXIST = exists) 
          if(.not. exists) then
            CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'TRIANGLE is not available in '//CHAR(13)//&
                           'C:\Program Files\RMA\ directory'//CHAR(13)//'Do you wish to define directory?'&
            ,'WARNING TRIANGLE IS NOT AVAILABLE')

!   If answer 'No', return
!
            IF (WInfoDialog(4).EQ.2) return
!            CALL GETDIR(LOCDIR)
             istat=getcwd(savdir)
             CALL WSelectDir(IFLAGS,LOCDIR, 'Select TRIANG Directory')
!             WRITE(155,*) LOCDIR            
             do n=96,1,-1
               if(LOCDIR(n:n) .ne. ' ') then
                 lnnam=n
                 EXIT
               endif
             enddo
             LTOP=LNNAM+9
             LOCDIR(LNNAM+1:LTOP)='\TRIANGLE'
             RESULT= RUNQQ(LOCDIR(1:LTOP), OPTIONS)
             IDCH=1
             GO TO 600
          else
            LOCDIR(1:8)='TRIANGLE'
!            WRITE(155,*) LOCDIR
            RESULT= RUNQQ(LOCDIR, OPTIONS)
            GO TO 600
          endif
        endif
       RESULT= RUNQQ("C:\Program Files\RMA\TRIANGLE", OPTIONS)
!       RESULT= RUNQQ("TRIANGLE", OPTIONS)

600    IIN=10
       OPEN(IIN,FILE='TEST.1.ELE', STATUS='OLD')
       
!       write(155,*) 'going to get newfile'
       CALL GETNEWFIL(IIN,0,-1,-1)
       IF(IDCH .EQ. 1) THEN
         istat=chdir(savdir)
         istat=getcwd(locdir)
       ENDIF
      !IADD=50+iactvfil+1
      !CALL RDTOCLIP(IADD)
      !
      !IF(IADD .EQ. 51) THEN
      !write(90,*) 'finished addmesh'
      !
      !NHTP=NHTPSV 
      !NMESS=NMESSSV
      !NBRR=NBRRSV 
      !call hedr
      !ELSE
      !  CALL ADDMESH(0)
        NHTP=NHTPSV 
        NMESS=NMESSSV
        NBRR=NBRRSV 
        call hedr
        CALL PLOTOT(0) 

!        CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to delete unused nodes?'//&
!                           CHAR(13)//' ','Delete unused nodes?')
!        !
!!   If answer 'No', return
!!
!        IF (WInfoDialog(4).EQ.2) return
!!                                                                       
!!     Delete all unused nodes                                           
!!                                                                       
!        CALL DELETM(2) 
!
!      ENDIF

!   get new mesh
!   add meshes together    
      RETURN
      END
    
      SUBROUTINE UNDOGEN
        USE BLK1MOD 
        INCLUDE 'BFILES.I90'
        ALLOCATABLE NODETRAN(:)
        DATA VDX9/-9.E9/

!       Loop through nodes assigning new number and adding to list

        IF(.NOT. ALLOCATED(NODETRAN)) ALLOCATE (NODETRAN(maxp))

        CALL ZEROOUT
      IADD=50+IACTVFIL
      CALL RDTOCLIP(IADD)

          DO N=1,NPSTO(1)
            IF(XUSRSTO(N,1) .GT. VDX9) THEN
              CALL GETNOD(J)
              NODETRAN(N)=J
              XUSR(J)=XUSRSTO(N,1)
              YUSR(J)=YUSRSTO(N,1)
              WD(J)=WDSTO(N,1)
              WIDTH(J)=WIDTHSTO(N,1)
              SS1(J)=SS1STO(N,1)
              SS2(J)=SS2STO(N,1)
              WIDS(J)=WIDSSTO(N,1)
              WIDBS(J)=WIDBSSTO(N,1)
              SSO(J)=SSOSTO(N,1)
              BS1(J)=BS1STO(N,1)
              INSKP(J) = 0
              INEW(J) = 1
            ENDIF                                         
          ENDDO 
      
!       Loop through elements assigning new number and adding to list

        DO N=1,NESTO(1)
          IF(IMATSTO(N,1) .GT. 0) THEN
            CALL GETELM(M)
            DO K=1,8
              IF(NOPSTO(N,K,1) .GT. 0) THEN
                J=NODETRAN(NOPSTO(N,K,1))
                NOP(M,K)=J
              ELSE
                NOP(M,K)=0
              ENDIF
            ENDDO
            IMAT(M)=IMATSTO(N,1)
            THTA(M)=THTASTO(N,1)
            IESKP(M)=0
            NCN = 2 
            IF (NOP(M,3) .NE. 0) NCN = 3 
            IF (NOP(M,4) .NE. 0) NCN = 4 
            IF (NOP(M,5) .NE. 0  .AND.  NOP(M,4) .NE. 0)  NCN = 5 
            IF (NOP(M,5) .NE. 0  .AND.  NOP(M,4) .EQ. 0)  NCN = 6 
            IF (NOP(M,6) .NE. 0) NCN = 6 
            IF (NOP(M,7) .NE. 0) NCN = 8 
            NCORN(M) = NCN 

          ENDIF
        ENDDO

!        if(iswt .eq. 0) CALL RESCAL
        CALL RESCAL
  	    CALL HEDR

      RETURN
      END
      SUBROUTINE GETDIR(LOCDIR)
      use winteracter

      implicit none

      include 'D.inc'
      INCLUDE 'BFILES.I90'

!
! Declare window-type and message variables
!
      TYPE(WIN_STYLE)    :: WINDOW

      TYPE(WIN_MESSAGE) :: MESSAGE

      CHARACTER*96 LOCDIR
      integer ierr,K,KL

      call wdialogload(IDD_GETFL)
      ierr=infoerror(1)
      
      CALL WDialogPutString(idf_string1,locdir)
!      LOCDIR='C:\Users\RMA5440\TRIANGLE\TRIANGLE'

      CALL WDialogSelect(IDD_GETFL)
      ierr=infoerror(1)

      CALL WDialogShow(-1,-1,0,Modal)
      ierr=infoerror(1)
      do
        IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
          CALL WDialogGetString(idf_string1,locdir)
          DO K=96,1,-1
            KL=K
            IF(LOCDIR(K:K) .NE. ' ') GO TO 200 
          ENDDO
          LOCDIR(1:8)='TRIANGLE'
          RETURN
200       CONTINUE
          LOCDIR(KL+1:KL+9)='\TRIANGLE'
          WRITE(90,*) LOCDIR
          RETURN
        endif
      enddo
      END