SUBROUTINE GOUTLIN

	  USE WINTERACTER 
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 
      INCLUDE 'TXFRM.COM'

      CHARACTER(LEN=255)  :: FNAME,FILTER
      CHARACTER(LEN=4)    :: SUB
	  LOGICAL OPENED
      CHARACTER*1  IFLAG,ANS(10)
!	  DIMENSION XOUT(1000),YOUT(1000)  
      DATA ANS/' ',' ',' ',' ',' ',' ','n','z','r','q'/ 

      IF(.NOT. ALLOCATED(XOUT)) THEN
        ALLOCATE (XOUT(5000,10),YOUT(5000,10))
      ENDIF
      N=0
      IOUTOUT=25
      INQUIRE(25, OPENED=OPENED)
      if(.not. opened) then
        Filter='OUTLINE file  -- *.dat|*.dat|POLY file  -- *.poly|*.poly|'

        CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Outline File')
 
        IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

   	      CALL IlowerCase(FNAME)
	      CALL GETSUB(FNAME,SUB)
          OPEN(IOUTOUT,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
        ELSE
          GO TO 1
        ENDIF
      ENDIF

    1 CONTINUE

      IF(SUB(1:3) .EQ. 'dat') THEN
	    IOUTSW=0
	  ELSE
	    IOUTSW=1
	  ENDIF

!IPK   GET STRING OF MAP COORDINATES

!                                                                       
!  Draw box around selections                                           
!                                                                       
    2 CONTINUE 
      
      NHTPSV=NHTP
      NMESSV=NMESS
      NBRRSV=NBRR

	  NHTP=0 
      NBRR=1 
      NMESS=45 
      CALL HEDR 
!                                                                       
!  Get answer                                                           
!                                                                       
!    3 call xyloc(XPT,YPT,ANS,IBOX) 
    3 call xyloc(XPT,YPT,IFLAG,IBOX) 
!                                                                       
      IF(IRMAIN .NE. 1  .and.  ibox .ne. 10) THEN
 	   
        N=N+1
        XTMP = XPT*TXSCAL - XS 
        YTMP = YPT*TXSCAL - YS 
        IF(IOUTSW .EQ. 0) THEN
          WRITE(IOUTOUT,*) XTMP,YTMP
		ELSE
		  XOUT(N,1)=XTMP
		  YOUT(N,1)=YTMP
		ENDIF
        GO TO 3

      ENDIF
	  IF(IOUTSW .EQ. 1) THEN
	    NDIM=2
		NZERO=0
		NONE=1
	    WRITE(IOUTOUT,*)N,NDIM,NZERO,NZERO
		DO I=1,N
          WRITE(IOUTOUT,*) I,XOUT(I,1),YOUT(I,1)
		ENDDO 
		WRITE(IOUTOUT,*) N,NZERO
		DO I=1,N-1
		  WRITE(IOUTOUT,*) I,I,I+1
        ENDDO
   		WRITE(IOUTOUT,*) N,N,NONE
		
		WRITE(IOUTOUT,*) NZERO
	  ENDIF
      NHTP=NHTPSV
      NMESS=NMESSV
      NBRR=NBRRSV
	  CALL HEDR


      RETURN
	  END

  SUBROUTINE GETSUB4(FNAME,SUB)
  CHARACTER(LEN=255)  :: FNAME
  CHARACTER(LEN=4)    :: SUB
  INTEGER ,EXTERNAL    :: LENSTR
  INTEGER            :: LNNAM,K

  LNNAM=LENSTR(FNAME)
  SUB='   '
  DO  K=LNNAM,1,-1
    IF(FNAME(K:K) .EQ. '.') THEN
      IF(LNNAM .GT. K+3) THEN
        SUB=FNAME(K+1:K+4)
      ELSEIF(LNNAM .GT. K+2) THEN
	    SUB(1:3)=FNAME(K+1:K+3)
        SUB(4:4)=' '
	  ELSE
	    SUB='    '
      ENDIF
      GO TO 110
    ENDIF
  ENDDO
110       CONTINUE
  RETURN
  END