RMAGEN84/SRC84/EVENT.F90

!IPK  LAST UPDATE SEP 23 2015  ADD TESTING FOR status
    SUBROUTINE gim_an_event(ix,iy,iflag)

      USE WINTERACTER

      
      include 'd.inc'
      
	  COMMON /TMPLIST/ ilisttmp(100),INREORD
	  
!  THIS BLOCK IS IN BLK1.F90

   	  COMMON /VIEWS/ HANG,VANG,VRTSCAL,HANGOLD,VANGOLD,VRTORIG,IASPCT,IGUNIT


      INTEGER   :: NP,NE,NHTP,NMESS,NBRR,IPSW,IRMAIN,ISCRN,icolon,nhtpsv,nmessv,nbrrsv,ntempin,IPW2


!ipk jan01  Expand IPSW to 10
      CHARACTER*6 DESCR
  COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
      COMMON /HEDS1/  NWINDWS,IWNDWS(10),ISCRNS(10),DESCR(10),ICRSR(10)

      REAL HSIZE
	  COMMON /SSIZE/  HSIZE

  REAL               :: RSCLX,RSCLY,HRAD,VRAD

  real*8 xms,yms
  INTEGER            :: MOUSEX, MOUSEY, MBUTTON, ITIME, IWINDOW,MENUS
  INTEGER            :: IMP,IIN,IOT,IOT1,impf,IBAKON,N,NDM,IDRAG,IYES,ITRIAN,INFO(3)

  LOGICAL            :: OPENED,EXISTS
  CHARACTER(LEN=255)  :: FNAME,FNAMGE,FNAMRM,FNAMEB
  CHARACTER(LEN=3)    :: SUB,SUB1
  CHARACTER(LEN=4)    :: SUB2
  character(len=43)   :: zoomh
  CHARACTER(LEN=50)   :: STBAR
  character(len=1000) :: header
  CHARACTER(len=10)   :: DATEC,TIMEC,ZONEC
  INTEGER             :: DTI(8)
  CHARACTER(LEN=256)  :: FILTER
  CHARACTER(LEN=72)   :: CRSTIT
  REAL                ::  XX1,XX2,XX3,XX4,XX5,XX6
  
  COMMON /UNITS/IOT,IOT1

  INCLUDE 'TXFRM.COM'
!IPK MAY02       COMMON  /TXFRM/  XS, YS, TXSCAL 
  

!
! Declare window-type and message variables
!
  TYPE(WIN_STYLE)    :: WINDOW
  TYPE(WIN_MESSAGE)  :: MESSAGE
  TYPE (WIN_FONT) :: FONT

! Define a common block with background file names

  INCLUDE 'BFILES.I90'

  DATA IBAKON/1/
  DATA rsclx,rscly/100.0,100./,IDOWN/0/

!
!  Interacter graphics input routine
!  Shows the mouse, collects mouse location and character
!  on the mouse-click or on a keystroke
 

        character*1  iflag

      CALL WMenuSetState(ID_ITEM11,ItemEnabled,0)
      CALL WMenuSetState(ID_ITEM12,ItemEnabled,0)

      nhtpsv=nhtp
      nmessv=nmess
      nbrrsv=nbrr
 100  continue
    DO I=1,255
      FNAME(I:I)=' '
    ENDDO
    MENUS=0
	idrag=0
 101  continue
    CALL WMessage(ITYPE, MESSAGE)
    SELECT CASE (ITYPE)
      CASE (KeyDown)                 ! Key pressed
        KEY    = MESSAGE%VALUE1
        MOUSEX = MESSAGE%X
        MOUSEY = MESSAGE%Y
        XM=MESSAGE%GX
        YM=MESSAGE%GY
        IFLAG=CHAR(KEY)
!        WRITE(90,*) 'KEY PRESSED',KEY
!        WRITE(90,'(A)') 'KEY PRESSED',IFLAG,menus
      CASE (MenuSelect)              ! Menu item selected
        INREORD=0
        DO J=1,100
          ilisttmp (j)=0
        ENDDO
        SELECT CASE (MESSAGE%VALUE1)
          CASE (ID_ITEM11)       ! New option
            IMP=0
            IIN=0
          CASE (ID_ITEM12)       ! Open option
            IMP=0
            IIN=0
            CALL IgrUnits(0.,0.,HSIZE,8.0)

            CALL WSelectFile(ID_STRING1,PromptOn+DirChange,FNAME,'Load Map File')

            IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

              CALL IlowerCase(FNAME)
              CALL GETSUB(FNAME,SUB)

              IF(SUB .EQ. 'map') then
                IMP=9
                OPEN(9,FILE=FNAME,STATUS='OLD')
              ELSEIF(SUB .EQ. 'asc'  .or.  SUB .EQ. 'grd') then
                IMP=94
                OPEN(94,FILE=FNAME,STATUS='OLD')
              ELSEIF(SUB .EQ. 'mpb') then
                imp=92
                OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='unformatted',action='read')
              ELSEIF(SUB .EQ. 'mbb') then
                imp=92
                OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='binary',action='read')
              ENDIF
            ENDIF

            FILTER ="Network Files|*.rm1;*.geo;*.gfg;*.bin;*.ele|Rm1 file -- *.rm1|*.rm1|Geo file  -- *.geo|*.geo|GFGEN file  -- *.gfg|*.gfg|GFGEN bin file  -- *.bin|*.bin|Rst file  -- *.rst|*.rst|TRIANG file  -- *.ele|*.ele|MESH2D file  -- *.2dm|*.2dm|All files|*.*|"
            CALL WSelectFile(FILTER,PromptOn+DirChange,FNAME,'Load Network File')

            IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

              CALL IlowerCase(FNAME)
              CALL GETSUB(FNAME,SUB)
              CALL SHORTNAME(FNAME,FNAMEDISP)

              ITRIAN=0
              IF(SUB .EQ. 'rm1') then
                IIN = 10
                OPEN(10,FILE=FNAME,STATUS='OLD')
              ELSEIF(SUB .EQ. 'ele') then
                IIN=10
                OPEN(IIN ,FILE=FNAME,STATUS='OLD',ACTION='READ')
	  	        ITRIAN=1
		        IGFG=0
			    FNAMKEP=FNAME
              ELSEIF(SUB .EQ. 'rst') then
                IIN=11
!                OPEN(IIN ,FILE=FNAME,STATUS='OLD',access='transparent')
                OPEN(IIN ,FILE=FNAME,STATUS='OLD',FORM='UNFORMATTED')
!                OPEN(IIN ,FILE=FNAME,STATUS='OLD',FORM='BINARY')
              ELSE
                IIN=12
                OPEN(IIN ,FILE=FNAME,STATUS='OLD',form='binary')
              ENDIF
            ENDIF

          CASE (ID_NMAP)
            CALL WSelectFile(ID_STRING1,PromptOn,FNAME,'Load Map File')

            IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

              CALL IlowerCase(FNAME)
              CALL GETSUB(FNAME,SUB)

              IF(SUB .EQ. 'map') then
                IMP=9
                OPEN(9,FILE=FNAME,STATUS='OLD')
              ELSEIF(SUB .EQ. 'shp') then
                IMP=113
                OPEN(113,FILE=FNAME,STATUS='OLD',FORM ='BINARY',action='read')
                SUB='DBF'
                CALL ADDSUB(FNAME,SUB)
                OPEN(114,FILE=FNAME,STATUS='OLD',FORM ='BINARY',action='read')
              ELSEIF(SUB .EQ. 'asc'  .or.  SUB .EQ. 'grd') then
                IMP=94
                OPEN(94,FILE=FNAME,STATUS='OLD')
              ELSEIF(SUB .EQ. 'mpb') then
                imp=92
                OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='unformatted',action='read')
              ELSEIF(SUB .EQ. 'mbb') then
                imp=92
                OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='binary',action='read')
              ENDIF
            ENDIF
            IF(IGUNIT .EQ. 203) THEN
              CLOSE (IGUNIT)
              IGUNIT=0
            ENDIF
            CALL RDMAP(2,IMP,0,0)
            CALL PLOTOT(0)
            nhtp=nhtpsv
            nmess=nmessv
            nbrr=nbrrsv
            call hedr          
            GO TO 100

!IPK MAY03    LOAD ADDITIONAL FILES

          CASE (ID_LOADRM1)

!        Load additional RM1 files

            FILTER ="Network Files|*.rm1;*.geo;*.gfg;*.bin;*.ele|Rm1 file -- *.rm1|*.rm1|Geo file  -- *.geo|*.geo|Gfgen file  -- *.gfg|*.gfg|GFGEN bin file  -- *.bin|*.bin|Rst file  -- *.rst|*.rst|TRIANG file  -- *.ele|*.ele|All files|*.*|"
            CALL WSelectFile(FILTER,PromptOn+DirChange,FNAME,'Load Network File')

            IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
              GO TO 200
            ELSE
			  GO TO 250
            ENDIF
  200       CONTINUE
            CALL IlowerCase(FNAME)
            CALL GETSUB(FNAME,SUB)
            CALL SHORTNAME(FNAME,FNAMEDISP)

            ITRIAN=0
            IF(SUB .EQ. 'geo') then
              IIN=12
              OPEN(IIN ,FILE=FNAME,STATUS='OLD',form='binary',ACTION='READ')
			  FNAMKEP=FNAME
              IGFG=0
            ELSEIF(SUB .EQ. 'gfg') then
              IIN = 10
              IGFG=1
              OPEN(10,FILE=FNAME,STATUS='OLD',ACTION='READ')
            ELSEIF(SUB .EQ. '2dm') then
              IIN = 10
              IGFG=3
              OPEN(10,FILE=FNAME,STATUS='OLD',ACTION='READ')
            ELSEIF(SUB .EQ. 'bin') then
              IIN=12
              OPEN(IIN ,FILE=FNAME,STATUS='OLD',FORM='UNFORMATTED')
              IGFG=2
            ELSEIF(SUB .EQ. 'rst') then
              IIN=11
              OPEN(IIN ,FILE=FNAME,STATUS='OLD',FORM='UNFORMATTED')
              IGFG=0
            ELSEIF(SUB .EQ. 'ele') then
              IIN=10
              OPEN(IIN ,FILE=FNAME,STATUS='OLD',ACTION='READ')
	  	      ITRIAN=1
		      IGFG=0
			  FNAMKEP=FNAME
            ELSE
              IIN = 10
              IGFG=0
              OPEN(10,FILE=FNAME,STATUS='OLD',ACTION='READ')
            ENDIF
            ITOTFIL=ITOTFIL+1
            FNAMEOUT(ITOTFIL)=FNAME
            CALL GETNEWFIL(IIN,IGFG,ITRIAN,0)

            fname='                          '
            GO TO 100

          CASE (ID_CRSF)   

!        Load cross-section files

            ICRIN=0
            FILTER ="Cross-Section files -- *.crs|*.crs|All files -- |*.*|"
            CALL WSelectFile(FILTER,PromptOn+DirChange,FNAME,'Load Cross-Section File')

            IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
              GO TO 210
            ELSE
			  GO TO 250
            ENDIF
  210       CONTINUE
            CALL IlowerCase(FNAME)
            CALL GETSUB(FNAME,SUB)
            ICRIN = 23
            OPEN(ICRIN,FILE=FNAME,STATUS='OLD',ACTION='READ')
            CALL GETCRS(CRSTIT)

            fname='                          '
            GO TO 100


!        Load group number files

            IGRPIN=0
            FILTER ="Group number files -- *.txt|*.txt|All files -- |*.*|"
            CALL WSelectFile(FILTER,PromptOn+DirChange,FNAME,'Load Group Number File')

            IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
              GO TO 215
            ELSE
			  GO TO 250
            ENDIF
  215       CONTINUE
            CALL IlowerCase(FNAME)
            CALL GETSUB(FNAME,SUB)
            IGRP = 28
            OPEN(IGRP,FILE=FNAME,STATUS='OLD',ACTION='READ')
            CALL GETGRP

            fname='                          '
            GO TO 100

          CASE (ID_SAVCRS)
            ICROUT=24
            INQUIRE(24, OPENED=OPENED)
            if(.not. opened) then
              Filter='CRS file  -- *.crs|*.crs|'

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

   	            CALL IlowerCase(FNAME)
	            CALL GETSUB(FNAME,SUB)
                OPEN(ICROUT,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
              ELSE
                GO TO 250
              ENDIF
            ENDIF
            REWIND ICROUT
            CALL WRTCRS(ICROUT,CRSTIT)
            fname='                          '
            GO TO 100

          CASE (ID_SAVGP)
            IGRPOUT=29
            INQUIRE(29, OPENED=OPENED)
            if(.not. opened) then
              Filter='TXT file  -- *.txt|*.txt|'

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

   	            CALL IlowerCase(FNAME)
	            CALL GETSUB(FNAME,SUB)
                OPEN(IGRPOUT,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
              ELSE
                GO TO 250
              ENDIF
            ENDIF
            REWIND IGRP
            CALL WRTGP
            fname='                          '
            GO TO 100

          CASE (ID_ITEM13)       ! Save option
!            WRITE(90,*) 'WINTER AT ITEM13'
            INQUIRE(20, OPENED=OPENED)
            if(.not. opened) then
              Filter='Network Files|*.rm1;*.gfg;*.ele;*.2dm|Rm1 file  -- *.rm1|*.rm1|gfg file  -- *.gfg|*.gfg|TRIANG file  -- *.ele|*.ele|2dm file  -- *.2dm|*.2dm|'

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

   	            CALL IlowerCase(FNAME)
	            CALL GETSUB(FNAME,SUB)
                CALL SHORTNAME(FNAME,FNAMEDISP)
!              SUB='rm1'
!              CALL ADDSUB(FNAME,SUB)

!                WRITE(90,*) 'IN ITEM13',IOT
!                WRITE(90,'(A)') FNAME,SUB
                IOT = 20
                FNAMRM=FNAME
				ITRIANOUT=0
				if(sub .eq. 'rm1') then
				  igfgsw=0
                  OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
!
!   Check if file cords format to be short or long
!
!
                  CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to save'//&
                            CHAR(13)//'coordinates in long format?' ,&
                           'Coordinate save format')
!
!   If answer 'No', use short format
!
                  IF (WInfoDialog(4) .EQ. 2) then
                    ntempin=0
                  else
                    ntempin=2
                  END IF
!
                  call wrtout(1)
                  CLOSE (IOT)
                  OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')                 
				elseif(sub .eq. 'ele') then
				  igfgsw=0
                  OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
				  itrianout=1
				  call wrtout(1)
        		  DO L=255,1,-1
		            IF(FNAME(L:L) .EQ. '.') THEN
			          FNAME(L+1:L+1)='n'
			          FNAME(L+2:L+2)='o'
			          FNAME(L+3:L+3)='d'
			          FNAME(L+4:L+4)='e'
		              OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
					  itrianout=2
                      call wrtout(1)
		              GO TO 220 
			        ENDIF
		          ENDDO
  220             continue
                  CLOSE (IOT)
                  OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')                 
				elseif(sub .eq. '2dm') then
				  igfgsw=0
                  OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
				  itrianout=0
				  call wrtout(3)
                  CLOSE (IOT)
                  OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')                 
				else
				  igfgsw=1
                  OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
                  call wrtout(1)
                  CLOSE (IOT)
                  OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')                 
				endif
              ENDIF
              if(iactvfil .le. 0) iactvfil=1
              FNAMEOUT(IACTVFIL)=FNAMRM

            else

              CALL GETSUB(FNAMRM,SUB)

              if(sub .eq. 'ele') then
			    FNAME=FNAMRM
				igfgsw=0
  	  	  	    itrianout=1
			    call wrtout(1)
        	    DO L=255,1,-1
		          IF(FNAME(L:L) .EQ. '.') THEN
			        FNAME(L+1:L+1)='n'
			        FNAME(L+2:L+2)='o'
			        FNAME(L+3:L+3)='d'
			        FNAME(L+4:L+4)='e'
		            OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
				    itrianout=2
                    call wrtout(1)
		            GO TO 221 
			      ENDIF
		        ENDDO
  221           continue     
              ELSE
                call wrtout(1)
			  ENDIF
              CLOSE (IOT)
			  fnamrm=FNAMEOUT(IACTVFIL)
              OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')                 
            endif
            GO TO 100

          CASE (ID_ITEM14)       ! Save option for binary

!            WRITE(90,*) 'WINTER AT ITEM14'
            INQUIRE(22, OPENED=OPENED)
!            WRITE(90,'(L2)') OPENED
            if(.not. opened) then
              Filter='Geo file  -- *.geo|*.geo|GFGEN file  -- *.bin|*.bin|'

              CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Network File')
!              WRITE(90,'(A)') FNAME
              IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

                CALL IlowerCase(FNAME)
	            CALL GETSUB(FNAME,SUB)
                CALL SHORTNAME(FNAME,FNAMEDISP)
!                SUB='geo'
!                CALL ADDSUB(FNAME,SUB)

!                WRITE(90,*) 'IN ITEM14',IOT1
!                WRITE(90,'(A)') FNAME,SUB
                IOT1=22
                FNAMGE=FNAME
				if(sub .eq. 'geo') then
                  OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='binary')
				  igfgswb=0

!  add header to binary file

                  DO J=11,1000
                    HEADER(J:J)=' '
                  ENDDO
                  HEADER(1:10)='RMAGEN    '
                  CALL DATE_AND_TIME(DATEC,TIMEC,ZONEC,DTI)
                  HEADER(11:20)=DATEC
                  HEADER(21:30)=TIMEC
                  HEADER(31:40)=ZONEC      
                  WRITE(IOT1) HEADER
                  call wrtout(2)

                  CLOSE (IOT1)
                  OPEN(IOT1 ,FILE=FNAMGE,STATUS='UNKNOWN',form='binary')
				else
                  OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='unformatted')
                  igfgswb=1
                  call wrtout(2)
                  CLOSE (IOT1)
                  OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='unformatted')
                endif
              ENDIF
            else

!  add header to binary file

              DO J=11,1000
                HEADER(J:J)=' '
              ENDDO
              HEADER(1:10)='RMAGEN    '
              CALL DATE_AND_TIME(DATEC,TIMEC,ZONEC,DTI)
              HEADER(11:20)=DATEC
              HEADER(21:30)=TIMEC
              HEADER(31:40)=ZONEC      
              WRITE(IOT1) HEADER
              call wrtout(2)
              CLOSE (IOT1)
              OPEN(IOT1 ,FILE=FNAMGE,STATUS='UNKNOWN',form='binary')
            endif
            FNAMEOUT(IACTVFIL)=FNAMRM
            GO TO 100

          CASE (ID_ITEM18)       ! Save As option
            FILTER ="Bin Map file  -- *.mpb|*.mpb|Bin Map file (no head) -- *.mbb|*.mbb|"
            CALL WSelectFile(filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Map File')

            IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

              CALL IlowerCase(FNAME)
              CALL GETSUB(FNAME,SUB)
  
              if(SUB .eq. 'mpb') then
                CALL ADDSUB(FNAME,SUB)
                impf=93
                OPEN(IMPF ,FILE=fname,STATUS='unknown',form='unformatted')
 
                call wrtmap(1)
              elseif(Sub .eq. 'map') then
                impf=94
                OPEN(IMPF ,FILE=fname,STATUS='unknown',form='formatted')
                call wrtmap(2)
              endif
            ENDIF

            go to 100

          CASE (ID_LAYFL)       ! input layer data

            CALL WSelectFile(ID_STRING9,PromptOn+DirChange,FNAME,'Load Layer File')

            IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

              SUB='lay'
              CALL ADDSUB(FNAME,SUB)
              impf=103
              OPEN(103,FILE=FNAME,STATUS='OLD')
              call rdlayer
            ENDIF

            go to 100

          CASE (ID_OUTLAY)       ! Save layer data

            call wrtlayer
            GO TO 100

          CASE (ID_ITEM15)       ! Save As option

            Filter='Network Files|*.rm1;*.gfg;*.ele;*.2dm|Rm1 file  -- *.rm1|*.rm1|GFGEN file  -- *.gfg|*.gfg|TRIANG file  -- *.ele|*.ele|2dm file  -- *.2dm|*.2dm|'

            CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Network File')

            IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

  	          CALL IlowerCase(FNAME)
	          CALL GETSUB(FNAME,SUB)
              CALL SHORTNAME(FNAME,FNAMEDISP)
!              SUB='rm1'
!              CALL ADDSUB(FNAME,SUB)
              FNAMRM=FNAME
              IOT = 20

              if(sub .eq. 'rm1') then
			    igfgsw=0
				itrianout=0
                OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')

!
!   Check if file cords format to be short or long
!

                CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to save'//&
                            CHAR(13)//'coordinates in long format?' ,&
                           'Coordinate save format')

!   If answer 'No', use short format

                IF (WInfoDialog(4).EQ.2) then
                  ntempin=0
                else
                  ntempin=2
                END IF
!
                call wrtout(1)
                CLOSE (IOT)
                OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')

			 elseif(sub .eq. 'ele') then
			   igfgsw=0
               OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
			   itrianout=1
			   call wrtout(1)
        	   DO L=255,1,-1
		          IF(FNAME(L:L) .EQ. '.') THEN
			        FNAME(L+1:L+1)='n'
			        FNAME(L+2:L+2)='o'
			        FNAME(L+3:L+3)='d'
			        FNAME(L+4:L+4)='e'
		            OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
			        itrianout=2
                    call wrtout(1)
		            GO TO 225
			      ENDIF
		        ENDDO
  225           continue
                CLOSE (IOT)
                OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')                 

              elseif(sub .eq. '2dm') then
				igfgsw=0
                OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
				itrianout=0
				call wrtout(3)
                CLOSE (IOT)
                OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')                 
			  elseif(sub .eq. 'gfg') then
			    igfgsw=1
                OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
                call wrtout(1)
                CLOSE (IOT)
                OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')
              endif
              IF(IACTVFIL .LE. 0) IACTVFIL=1
              FNAMEOUT(IACTVFIL)=FNAMRM
			ENDIF

            go to 100

          CASE (ID_ITEM16)       ! Save As option

            Filter='Geo file  -- *.geo|*.geo|GFGEN file  -- *.bin|*.bin|'

            CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Network File')

            IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

  	          CALL IlowerCase(FNAME)
	          CALL GETSUB(FNAME,SUB)
              CALL SHORTNAME(FNAME,FNAMEDISP)
!              SUB='geo'
!              CALL ADDSUB(FNAME,SUB)
              FNAMGE=FNAME
              IOT1 = 22
              if(SUB .EQ. 'geo') then
                OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='binary')
                igfgswb=0
!  add header to binary file

                DO J=11,1000
                  HEADER(J:J)=' '
                ENDDO
                HEADER(1:10)='RMAGEN    '
                CALL DATE_AND_TIME(DATEC,TIMEC,ZONEC,DTI)
                HEADER(11:20)=DATEC
                HEADER(21:30)=TIMEC
                HEADER(31:40)=ZONEC      
                WRITE(IOT1) HEADER
                call wrtout(2)
                CLOSE (IOT1)
                OPEN(IOT1 ,FILE=FNAMGE,STATUS='UNKNOWN',form='binary')
			  else
                OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='unformatted')
                igfgswb=1
                call wrtout(2)
                CLOSE (IOT1)
                OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='unformatted')
              endif
              FNAMEOUT(IACTVFIL)=FNAMRM
            ENDIF

            go to 100

          CASE (ID_SBIN)       ! Save As special binary format

            CALL GETHDRTYP(IHDSWT)

            Filter='Geo file  -- *.geo|*.geo|'

            CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Network File')

            IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

  	          CALL IlowerCase(FNAME)
	          CALL GETSUB(FNAME,SUB)
              CALL SHORTNAME(FNAME,FNAMEDISP)
!              SUB='geo'
!              CALL ADDSUB(FNAME,SUB)
              FNAMGE=FNAME
              IOT1 = 22
              if(SUB .EQ. 'geo') then
			    if(ihdswt .eq. 1) then
                  OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='UNFORMATTED', CONVERT='LITTLE_ENDIAN')
                else
                  OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='UNFORMATTED', CONVERT='BIG_ENDIAN')
				endif
                igfgswb=0
!  add header to binary file

                DO J=11,1000
                  HEADER(J:J)=' '
                ENDDO
                HEADER(1:10)='RMAGEN    '
                CALL DATE_AND_TIME(DATEC,TIMEC,ZONEC,DTI)
                HEADER(11:20)=DATEC
                HEADER(21:30)=TIMEC
                HEADER(31:40)=ZONEC      
                WRITE(IOT1) HEADER
                call wrtout(2)
                CLOSE (IOT1)
			    if(ihdswt .eq. 1) then
                  OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='UNFORMATTED', CONVERT='LITTLE_ENDIAN')
                else
                  OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='UNFORMATTED', CONVERT='BIG_ENDIAN')
				endif
              endif
            ENDIF

            go to 100
          CASE (ID_BKF)       !   Read background option

            fname='                          '
!!!            CALL WSelectFile(FILTER,PromptOn+DirChange,FNAME,'Load Background file')
            FILTER ="Background Files|*.wmf;*.bmp;*.pcx;*.png;*.cgm;*.pic;*.jpg|wmf file  -- *.wmf|*.wmf|bmp file  -- *.bmp|*.bmp|pcx file  -- *.pcx|*.pcx|png file  -- *.png|*.png|jpeg file  -- *.jpg|*.jpg|cgm file  -- *.cgm|*.cgm|pic file  -- *.pic|*.pic|"
            CALL WSelectFile(FILTER,PromptOn+DirChange+Appendext,FNAME,'Load Background file')

            IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

              CALL IlowerCase(FNAME)
              CALL GETSUB(FNAME,SUB)
              NBKFL=NBKFL+1
              BFNAME(NBKFL)=FNAME
              IF(SUB .EQ. 'bmp') then
                ISWBKFL(NBKFL) = 2
              ELSEIF(SUB .EQ. 'pcx') then
                ISWBKFL(NBKFL) = 2
              ELSEIF(SUB .EQ. 'png'  .or.  sub .eq. 'jpg') then
                ISWBKFL(NBKFL) = 2
              ELSE
                ISWBKFL(NBKFL)=1
              ENDIF
              write(90,*) 'nbkfl in winnew',nbkfl
              write(90,*) ' iswbkfl',iswbkfl(nbkfl)
              SUB1=SUB
              SUB='ORG'
              CALL ADDSUB(FNAME,SUB)
              BFNAMR(NBKFL)=FNAME
 	          INQUIRE (FILE = fname, EXIST = exists)
              IF (.NOT. exists) THEN
                IF(SUB1 .EQ. 'PNG'  .or.  SUB1 .EQ. 'png') SUB2='PNGW'
                IF(SUB1 .EQ. 'JPG'  .or.  SUB1 .EQ. 'jpg') SUB2='JPGW'
                CALL ADDSUB(FNAME,SUB2)
                BFNAMR(NBKFL)=FNAME
 	            INQUIRE (FILE = fname, EXIST = exists)
                IF (.NOT. exists) THEN
                 IF(SUB2 .EQ. 'JPGW') THEN
                  SUB1='JGW'
                  CALL ADDSUB(FNAME,SUB1)
                  BFNAMR(NBKFL)=FNAME
                 ENDIF
                ENDIF
 	            INQUIRE (FILE = fname, EXIST = exists)
                IF (.NOT. exists) THEN
                  
                  CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Location file does not exist!!'//CHAR(13)// &
                  'Do you wish to create file and view image','Looking for location file') 
!   If answer 'Yes'  set ifrmel to 0
!
                  IF (WInfoDialog(4) .ne. 2) then
                    OPEN(104,FILE=FNAME,STATUS ='NEW', FORM ='FORMATTED')
                    BFNAMR(NBKFL)=FNAME
                    BFMINMAX(NBKFL,1) =  - XS 
                    BFMINMAX(NBKFL,2) =  - YS 
                    BFMINMAX(NBKFL,3) = HSIZE*TXSCAL - XS 
                    BFMINMAX(NBKFL,4) = 7.50*TXSCAL - YS 
                    WRITE(104,'(4G16.8)') (BFMINMAX(NBKFL,I),I=1,4)
                    CLOSE(104)
				    GO TO 100
                  ELSE
				    NBKFL=NBKFL-1
				    GO TO 100
                  ENDIF
                ENDIF
                OPEN(104,FILE=FNAME,STATUS ='OLD', FORM ='FORMATTED')
                READ(104,'(G16.8)') XX1
                READ(104,'(G16.8)') XX2
                READ(104,'(G16.8)') XX3
                READ(104,'(G16.8)') XX4
                READ(104,'(G16.8)') XX5
                READ(104,'(G16.8)') XX6
                call IGrFileInfo(BFNAME(NBKFL),INFO,3)
                
                BFMINMAX(NBKFL,1) =  XX5
                BFMINMAX(NBKFL,2) =  XX6+INFO(3)*XX4
                BFMINMAX(NBKFL,3) =  XX5+INFO(2)*XX1
                BFMINMAX(NBKFL,4) =  XX6    
                
                CLOSE(104)
                GO TO 100
! yes

              ENDIF

              OPEN(104,FILE=FNAME,STATUS ='OLD', FORM ='FORMATTED')
              READ(104,'(4G16.8)') (BFMINMAX(NBKFL,J),J=1,4)
              CLOSE(104)
                            
            ENDIF
            
! ipk jan10
            go to 100
            
          CASE (ID_ICOPY)
            CALL WSelectFile(ID_STRING6,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Copy File Name')

            IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

              CALL IlowerCase(FNAME)
              CALL GETSUB(FNAME,SUB)
              FNAMEB=FNAME
              SUB1='ORG'
              CALL ADDSUB(FNAMEB,SUB1)
              CALL OUTORG(FNAMEB)
          if(sub .eq. 'jpg'  .or.  sub .eq. 'png'  .or. sub .eq. 'pcx'  .or.   sub .eq. 'bmp') then
!  	        call doplot(0)
            CALL WGrSaveImageOptions(31,100)
            CALL WGrSaveImageOptions(32,150)
            call igrsaveimage(fname)
  	        call doplot(0)
            call IGrFileInfo(FNAME,INFO,3)
            IF(SUB .EQ. 'jpg') THEN
              SUB2='jpgw'
	          CALL ADDSUB(FNAMEB,SUB2)
   	          CALL OUTJPGW(FNAMEB,INFO)
            ENDIF
	        CALL HEDR
            go to 100
          endif

              CALL IGrInit('HP')         ! hardcopy only output
!ipk may10
    	 	  IYPIX=HSIZE/7.5*540
              IXPIX=540

              IF(SUB .EQ. 'wmf') then
                CALL IGrHardCopySelect(1,11)
                CALL IGrHardCopyOptions(27,1)
!ipk may10
        		CALL IGrHardCopyOptions(1,IYPIX)
               
              ELSEIF(SUB .EQ. 'emf') then
                CALL IGrHardCopySelect(1,11)
                CALL IGrHardCopyOptions(27,2)
!ipk may10
                CALL IGrHardCopyOptions(1,IYPIX)
              ELSEIF(SUB .EQ. 'dxf') then
                CALL IGrHardCopySelect(1,8)
              ELSEIF(SUB .EQ. 'pcx') then
                CALL IGrHardCopySelect(1,6)
                CALL IGrHardCopyOptions(26,0)
!ipk may10
                CALL IGrHardCopyOptions(1,IYPIX)
		        CALL IGrHardCopyOptions(2,540)
              ELSEIF(SUB .EQ. 'bmp') then
                CALL IGrHardCopySelect(1,6)
                CALL IGrHardCopyOptions(26,1)
!ipk may10
                IYPIX=IYPIX*1.5
                IXPIX=810
                CALL IGrHardCopyOptions(1,IYPIX)
!IPK MAY10		        CALL IGrHardCopyOptions(2,540)
		        CALL IGrHardCopyOptions(2,IXPIX)
              ELSEIF(SUB .EQ. 'png') then
                CALL IGrHardCopySelect(1,6)
                CALL IGrHardCopyOptions(26,3)
                CALL IGrHardCopyOptions(23,24)
!ipk may10
                CALL IGrHardCopyOptions(1,IYPIX)
		        CALL IGrHardCopyOptions(2,540)
              ELSEIF(SUB .EQ. 'jpg') then
                CALL IGrHardCopySelect(1,6)
                CALL IGrHardCopyOptions(23,24)
                CALL IGrHardCopyOptions(26,4)
!ipk may10
                CALL IGrHardCopyOptions(1,IYPIX)
		        CALL IGrHardCopyOptions(2,540)
              ELSEIF(SUB .EQ. 'cgm') then
                CALL IGrHardCopySelect(1,9)
!ipk may10
                CALL IGrHardCopyOptions(1,IYPIX)
              ELSEIF(SUB .EQ. 'pic') then
                CALL IGrHardCopySelect(1,7)
!ipk may10
                CALL IGrHardCopyOptions(1,IYPIX)
		        CALL IGrHardCopyOptions(2,540)
              ENDIF
              CALL IGrHardcopy(fname)      ! Start print manager
              CALL IGrFillPattern(Solid)

              CALL IgrUnits(0.,0.,HSIZE,7.5)
              if(menus .eq. 12  .or.  menus .eq. 13) then
                call conout(menus)
              else
                CALL CLSCRN
                CALL PLOTOT(-1)             ! plot graph
              endif
              call rblack
              call frame(0.,0.,HSIZE,7.5)
              CALL IGrHardcopy('S')      ! Send data to the printer
              CALL IGrInit('P')          ! Turn graphics back on
              CALL IGrFillPattern(Solid)

              CALL IgrUnits(0.,0.,HSIZE,8.0)
              if(menus .eq. 12  .or.  menus .eq. 13) then
                call conout(menus)
              else
                CALL CLSCRN
                CALL PLOTOT(0)             ! plot graph
              endif
              CALL HEDR
              call rblack
              CALL IGrHardCopySelect(1,10)
              GO TO 100
            ENDIF
            
! ipk jan10
            go to 100
            
          CASE (ID_CLIP)

           call igrsaveimage( )
  	        call doplot(0)
	        CALL HEDR
            go to 100
              
!      Clipboard save
!ipk may10
!  	 	IYPIX=HSIZE/7.5*540
!        IXPIX=540
!              CALL IGrHardCopySelect(1,11)
!              CALL IGrHardCopyOptions(27,2)
!ipk may10
!   	  	      CALL IGrHardCopyOptions(1,IYPIX)
!              CALL IGrHardcopy()      ! Start print manager
!              CALL IGrFillPattern(Solid)

!              CALL IgrUnits(0.,0.,HSIZE,7.5)
!              if(menus .eq. 12  .or.  menus .eq. 13) then
!                call conout(menus)
!              else
!                CALL CLSCRN
!                CALL PLOTOT(-1)             ! plot graph
!              endif
!              call rblack
!              CALL IGrHardcopy('S')      ! Send data to the printer
!              CALL IGrInit('P')          ! Turn graphics back on
!              CALL IGrFillPattern(Solid)
!
!              CALL IgrUnits(0.,0.,HSIZE,8.0)
!              if(menus .eq. 12  .or.  menus .eq. 13) then
!                call conout(menus)
!              else
!                CALL CLSCRN
!                CALL PLOTOT(0)             ! plot graph
!              endif
!              CALL HEDR
!              call rblack
!              CALL IGrHardCopySelect(1,10)
!              GO TO 100

          CASE (ID_SAVSHP)              ! Copy to shape file selected is selected
            call saveshp1
            go to 100

          CASE (ID_ITEM24)              ! Print option is selected
            CALL WHardcopyOptions(3)
!
!  If the user clicked OK on page setup dialog then output the contents
!  to the selected printer
!
            IF (WinfoDialog(ExitButtonCommon).EQ.CommonOK) THEN
               CALL IGrInit('HP')         ! hardcopy only output
               CALL IGrFillPattern(Solid)

               CALL IgrUnits(0.,0.,HSIZE,7.5)
               CALL IGrHardcopy(' ')      ! Start print manager
               if(menus .eq. 12  .or.  menus .eq. 13) then
                 call conout(menus)
               else
                 CALL CLSCRN
                 CALL PLOTOT(-1)             ! plot graph
               endif
               call rblack
               CALL IGrFillPattern(0,0,0)
               CALL IGrRectangle(0.,0.,HSIZE,7.5)
               CALL IGrHardcopy('S')      ! Send data to the printer
               CALL IGrInit('P')          ! Turn graphics back on
               CALL IGrFillPattern(Solid)

               CALL IgrUnits(0.,0.,HSIZE,8.0)
               if(menus .eq. 12  .or.  menus .eq. 13) then
                 call conout(menus)
               else
                 CALL CLSCRN
                 CALL PLOTOT(0)             ! plot graph
               endif
               CALL HEDR
               call rblack
               CALL IGrFillPattern(0,0,0)
               CALL IGrRectangle(0.,0.,HSIZE,7.5)
               GO TO 100
            END IF
            
! ipk jan10
            go to 100
            
          CASE (ID_ITEM19)       ! Demo option
            SUB='DEM'
            CALL RBLUE
            CALL SYMBL(1.,5.,0.25,SUB,0.0,3)
            CALL DEMOS
            
! ipk jan10
            go to 100
            
          CASE (ID_MMAP)
            call mmap
            go to 100
         
!IPK MAY03
          CASE (ID_SELRM1)        !  Select different mesh file
            IOLDACT=IACTVFIL
            CALL PANELFIL
            IF (IOLDACT .NE. IACTVFIL) THEN
!     Resave current file

              IFILOUT=IOLDACT+50
              CALL WRTFIL(IFILOUT)
              CALL LOADFIL
            ENDIF
            GO TO 100
!IPK MAY03
          CASE (ID_ADDMESH)        !  Select  file FOR MESH ADDITION
            IOLDACT=IACTVFIL
            CALL PANELFIL
            IF( IOLDACT .EQ. IACTVFIL) THEN
              CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Same file selected for addition'//&
                            CHAR(13)//'Process ended','SAME FILE')
              GO TO 100
            ENDIF
            IFILADD=IACTVFIL
            IACTVFIL=IOLDACT
            CALL ADDTOMESH(IFILADD,0)
            GO TO 100
!IPK MAY03
          CASE (ID_MRGMESH)        !  Select  file FOR MESH MERGING
            IOLDACT=IACTVFIL
            CALL PANELFIL
            IF( IOLDACT .EQ. IACTVFIL) THEN
              CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Same file selected for merging'//&
                            CHAR(13)//'Process ended','SAME FILE')
              GO TO 100
            ENDIF
            IFILADD=IACTVFIL
            IACTVFIL=IOLDACT
            CALL ADDTOMESH(IFILADD,1)
            GO TO 100
            
!ipk sep16   ADD MESH FROM POINTS
          CASE (ID_ADDMESHTR)
            CALL ADDMESHT
            GO TO 100
            
!ipk sep16   ADD MESH FROM POINTS
          CASE (ID_ADDBEDLEV)
            CALL ADDBEDLV
            GO TO 100
!ipk may03   
          CASE (ID_TRIANG)         !  add a triangle of elements
            CALL ADDTRIANG
            GO TO 100

          CASE (ID_ADDMAP)         !  add a triangle of elements
            CALL ADDMAP
            GO TO 100

          CASE (ID_3DVIEW)
            CALL SETANGLE
            I3DVIEW=1
            if(menus .eq. 12  .or.  menus .eq. 13) then
              CALL CLSCRN
              call conout(menus)
            else
              call plotot(0)
            endif
		    call hedr
		    GO TO 100

          CASE (ID_VIEWANGLE)

            I3DVIEW=1
            CALL SETANGLE
		    CALL PLOTOT(0)
		    call hedr
            GO TO 100



!ipk may03   
          CASE (ID_QUAD)         !  add a quad of elements
            CALL ADDQUAD
            GO TO 100

!ipk may03   
          CASE (ID_SETUPLEV)         !  setup levees
            CALL  RESETWHGT
            GO TO 100
           
          CASE (ID_SETTYPLEV)         !  setup levees
            CALL  LEVSETTYP
            GO TO 100
           

          CASE (ID_G1D)
		    CALL FORM1DEL
			GO TO 100
!ipk apr04   
          CASE (ID_CREATM)         !  create mesh from contours
            CALL CREATM
            GO TO 100
            
          CASE (ID_OUTLINFL)         !  read outline file
            CALL RDOUTLIN
            GO TO 100

          CASE (ID_TESTOUT)         !  read outline file
            CALL CHECKPOLY
            GO TO 100

          CASE (ID_CGEN)         !  generate contours
            CALL CGEN
            GO TO 100

          CASE (ID_SPLITN)
		    CALL SPLITN
			GO TO 100

          CASE (ID_FORM999)
		    CALL FORM999(0,0,1)
			GO TO 100

          CASE (ID_FORM2D)
		    CALL FORM999(1,0,1)
			GO TO 100
!IPK FEB03

          CASE (ID_TRIAN)
		    CALL TRIANG
		    GO TO 100

          CASE (ID_SWMAP)
		    CALL SWMAP
		    GO TO 100

          CASE (ID_SWRM1)
		    CALL SWRM1
		    GO TO 100

          CASE (ID_MAP)
		    CALL GRELV
			GO TO 100

          CASE (ID_SELPR)
		    CALL GETALLANGS
			GO TO 100

          CASE (ID_RVSDIAG)
		    CALL RVSDIAG
			GO TO 100

          CASE (ID_LOADELTLD)
		    CALL GETEQ
			GO TO 100
            
          CASE (ID_SHOWELTLD)
		    CALL SHOWEQ(0)
			GO TO 100

          CASE (ID_RESHOWELTLD)
		    CALL SHOWEQ(1)
			GO TO 100

          CASE (ID_ASSIGNELTLD)
		    CALL ASSIGNEQ
			GO TO 100

          CASE (ID_SAVELTLD)
		    CALL SAVEEQ
			GO TO 100

          CASE (ID_ADDSLOT)
		    CALL ADDSLOT
			GO TO 100
            
            
          CASE (ID_ITEM17)       ! Exit option
!IPK SEP02
            call rquit(iyes)
            if(iyes .ne. 1) go to 100
            MENUS=0
            CALL QUIT_PGM
          CASE (ID_EXIT)             ! Exit program (menu option)
            call rquit(iyes)
            if(iyes .ne. 1) go to 100
            MENUS=0
            CALL QUIT_PGM

          CASE (ID_NODEDATA)
            CALL NODEDISP(0)
            GO TO 101

          CASE (ID_ELTDATA)
            CALL ELTDISP(0)
            GO TO 101

          CASE (ID_EDLAY)
            CALL LAYDISP
            GO TO 101

          CASE (ID_RESETRG)
            CALL RESETREG
            GO TO 101

          CASE (ID_MOVMESH)
            CALL MOVMESH
            GO TO 101

          CASE (ID_TRANSFORM)
            CALL TRANSMESH
            GO TO 101
            
!IPK SEP02
          CASE (ID_GETELM)
            CALL GETELMNO
            GO TO 101

          CASE (ID_ATTACH)
            CALL REATTACH
            GO TO 101
        
          CASE (ID_DDRAW)
            IDDSW=MOD(IDDSW+1,2)
            IF(IDDSW .EQ. 1) CALL WMenuSetState(ID_DDRAW,ItemChecked,1)
            
            GO TO 101

          CASE (ID_COMPLEX)
            CALL GNODE(2)
            GO TO 101

          CASE (ID_fillagap)
            CALL JOINEL
            GO TO 101

          CASE (ID_GETSTRESSFIL)
            CALL GETSTRESSFIL
            GO TO 101

          CASE (ID_NODE)
            MENUS=2
          CASE (ID_DELM)
            CALL DELETM(0) 
            go to 100
          CASE (ID_DELETELM)
            CALL DELETEM 
            go to 100
          CASE (ID_ELTS)
            MENUS=1
          CASE (ID_FILL)
            CALL FILM(1)
			call hedr
			go to 100
          CASE (ID_FILLTR)
            CALL FILLTR
			call hedr
			go to 100
          CASE (ID_JOIN)
            CALL JOIN(1)
            nhtp=nhtpsv
            nmess=nmessv
            nbrr=nbrrsv
			call hedr
			go to 100
          CASE (ID_JOINALL)
            CALL JOINALL
            nhtp=nhtpsv
            nmess=nmessv
            nbrr=nbrrsv
			call hedr
			go to 100
          CASE (ID_CRGRID)
            CALL CRGRID
            GO TO 100
          CASE (ID_CRSECT)
            CALL CRSECT
            GO TO 101
          CASE (ID_CRSCAL)
            CALL COMPWGT(0)
            GO TO 101
          CASE (ID_UPDTWGHT)
            CALL COMPWGT(1)
            GO TO 101
          CASE (ID_CSLOC)
            CALL GETCSLOC
            GO TO 101
          CASE (ID_ORDR)
            MENUS=3
          CASE (ID_ORDR1)
		    CALL ORDALL
			GO TO 101
          CASE (ID_ORDR2)
		    CALL ORDDIR
			GO TO 101
          CASE (ID_DCONTR)
            MENUS=12
            CALL CONOUT(MENUS)
            GO TO 101
          CASE (ID_CONTOPT)
            MENUS=13
            CALL CONOUT(MENUS)
            GO TO 101
!ipk feb02
          CASE (ID_cdata)
!                                                                       
!  Create data for message file and display                             
!                                                                       
            CALL ELDAT
            go to 101
          CASE (ID_CCLN)
            MENUS=6
          CASE (ID_CHKCCLN)
            CALL CHKLIN
			GO TO 101
          CASE (ID_CSEC)
            MENUS=7
          CASE (ID_ZIN)
            MENUS=8
            iflag='z'
            zoomh=' Zooming, click and drag to form rectangle'
            CALL CLRBOX 
            CALL SYMBL(0.,7.70,0.20,zoomh,0.,43) 
            go to 101
          CASE (ID_OUT2)
            MENUS=8
            iflag='y'
          CASE (ID_OUT4)
            MENUS=8
            iflag='x'
          CASE (ID_CHCK)
		    CALL CHKAREA
            GO TO 101
          CASE (ID_FINDNODE)
		    CALL FINDNOD
            GO TO 101
          CASE (ID_FINDELEM)
		    CALL FINDEL
            GO TO 101
          CASE (ID_MCHCK)
		    CALL CHKAREA
            GO TO 101
          CASE (ID_SMOOTHMAP)
!!		    CALL SMOOTHMP
            GO TO 101
            
          CASE (ID_DRAG)
            MENUS=8
            iflag='d'
			idrag=1
            zoomh=' drag/pan , click right to end'
            CALL CLRBOX 
            CALL SYMBL(0.,7.70,0.20,zoomh,0.,30) 
			call WCursorShape(CurCrossHair)
            go to 101
          CASE (ID_ROTATE)
            MENUS=8
            iflag='d'
			idrag=2
            zoomh=' rotate view , click right to end'
            CALL CLRBOX 
            CALL SYMBL(0.,7.70,0.20,zoomh,0.,30) 
			call WCursorShape(CurCrossHair)
            go to 101
          CASE (ID_VROTATE)
            MENUS=8
            iflag='d'
			idrag=2
            zoomh=' rotate view , click right to end'
            CALL CLRBOX 
            CALL SYMBL(0.,7.70,0.20,zoomh,0.,30) 
			call WCursorShape(CurCrossHair)
            go to 101
          CASE (ID_RSET)
            MENUS=8
            iflag='w'
          CASE (ID_PLEFT)
            MENUS=8
            iflag='v'
          CASE (ID_PRIGHT)
            MENUS=8
            iflag='u'
          CASE (ID_PUP)
            MENUS=8
            iflag='t'
          CASE (ID_PDOWN)
            MENUS=8
            iflag='s'
          CASE (ID_IDRWT)

            DO
              call wdialogload(IDD_DIALOG06)

                call wdialogputcheckbox(IDF_RADIO1,IPSW(1))
                call wdialogputcheckbox(IDF_RADIO2,IPSW(2))
                call wdialogputcheckbox(IDF_RADIO3,IPSW(4))
!                call wdialogputcheckbox(IDF_RADIO4,IPSW(3))
!                call wdialogputcheckbox(IDF_RADIO5,IPSW(9))
                call wdialogputcheckbox(IDF_RADIO6,IPSW(5))
                call wdialogputcheckbox(IDF_RADIO7,IPSW(7))
                call wdialogputcheckbox(IDF_RADIO8,IPSW(6))
                call wdialogputcheckbox(IDF_RADIO19,IPSW(15))
                call wdialogputcheckbox(IDF_RADIO9,IPSW(8))
!ipk jan01
                call wdialogputcheckbox(IDF_RADIO10,IPSW(10))
!ipk oct02
                call wdialogputcheckbox(IDF_RADIO11,IPSW(11))
                call wdialogputcheckbox(IDF_RADIO12,IPSW(12))
                call wdialogputcheckbox(IDF_RADIO13,IPSW(13))
!                call wdialogputcheckbox(IDF_RADIO17,IPSW(14))
                IF(IPSW(3) .EQ. 1) THEN
				  call wdialogputradiobutton(IDF_RADIO4)
                ELSEIF(IPSW(9) .EQ. 1) THEN
				  call wdialogputradiobutton(IDF_RADIO5)
                ELSEIF(IPSW(14).EQ. 1) THEN
				  call wdialogputradiobutton(IDF_RADIO17)
                ELSE
				  call wdialogputradiobutton(IDF_RADIO18)
                ENDIF
                IF(IPW1 .EQ. 1) THEN
				  call wdialogputradiobutton(IDF_RADIO14)
				ELSEIF(IPW1 .EQ. 2) THEN
				  call wdialogputradiobutton(IDF_RADIO15)
				ELSEIF(IPW1 .EQ. 3) THEN
				  call wdialogputradiobutton(IDF_RADIO16)
				ENDIF
			    call wdialogputreal(IDF_REAL1,WIDEL)
			    call wdialogputreal(IDF_REAL2,WIDSCL)
 
 				CALL WDialogSelect(IDD_DIALOG06)
              CALL WDialogShow(-1,-1,0,Modal)
 
              IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
                call wdialoggetcheckbox(IDF_RADIO1,IPSW(1))
                call wdialoggetcheckbox(IDF_RADIO2,IPSW(2))
                call wdialoggetcheckbox(IDF_RADIO3,IPSW(4))
                call wdialoggetcheckbox(IDF_RADIO4,IPSW(3))
                call wdialoggetcheckbox(IDF_RADIO5,IPSW(9))
                call wdialoggetcheckbox(IDF_RADIO6,IPSW(5))
                call wdialoggetcheckbox(IDF_RADIO7,IPSW(7))
                call wdialoggetcheckbox(IDF_RADIO8,IPSW(6))
                call wdialoggetcheckbox(IDF_RADIO8,IPSW(15))
                call wdialoggetcheckbox(IDF_RADIO9,IPSW(8))
!ipk jan01
                call wdialoggetcheckbox(IDF_RADIO10,IPSW(10))
!ipk oct02
                call wdialoggetcheckbox(IDF_RADIO11,IPSW(11))
                call wdialogGetcheckbox(IDF_RADIO12,IPSW(12))
                call wdialogGetcheckbox(IDF_RADIO13,IPSW(13))
!                call wdialoggetcheckbox(IDF_RADIO4,IPSW(3))
!                call wdialoggetcheckbox(IDF_RADIO5,IPSW(9))
!                call wdialogGetcheckbox(IDF_RADIO17,IPSW(14))
  	 		    call wdialoggetradiobutton(IDF_RADIO4,ipw2)
                IPSW(3)=0
                IPSW(9)=0
                IPSW(14)=0
                IF(IPW2 .EQ. 1) THEN
                  IPSW(3)=1
                ELSEIF(IPW2 .EQ. 2) THEN
                  IPSW(9)=1
                ELSEIF(IPW2 .EQ. 3) THEN
                  IPSW(14)=1
                ENDIF
!               IF(IPSW(3) .EQ. 1) THEN
!                 IPSW(9)=0
!                 call wdialogputcheckbox(IDF_RADIO5,0)
!                 IPSW(14)=0
!                 call wdialogputcheckbox(IDF_RADIO17,0)
!               ENDIF
!               IF(IPSW(9) .EQ. 1) THEN
!                 IPSW(3)=0
!                 call wdialogputcheckbox(IDF_RADIO4,0)
!                 IPSW(14)=0
!                call wdialogputcheckbox(IDF_RADIO17,0)
!               ENDIF
!               IF(IPSW(14) .EQ. 1) THEN
!                 IPSW(9)=0
!                 call wdialogputcheckbox(IDF_RADIO5,0)
!                 IPSW(3)=0
!                 call wdialogputcheckbox(IDF_RADIO4,0)
!               ENDIF

                IF(IPSW(5) .EQ. 1) THEN
                  IPSW(7)=0
                  call wdialogputcheckbox(IDF_RADIO7,0)
                ENDIF
   	 		    call wdialoggetradiobutton(IDF_RADIO14,ipw1)
			    call wdialoggetreal(IDF_REAL1,WIDEL)
			    call wdialoggetreal(IDF_REAL2,WIDSCL)
                MENUS=9
              endif
              CALL PLOTOT(0)
              nhtp=nhtpsv
              nmess=nmessv
              nbrr=nbrrsv
              call hedr          

              GO TO 100
            ENDDO
            GO TO 100

          CASE (ID_ITYPN)
            MENUS=9
!            IQSW(1)=1-IQSW(1)
!            IF(IQSW(1) .EQ. 1) THEN
!              IQSW(2)=0
!            ENDIF
            IQSW(1)=1
            IQSW(2)=0
            CALL WMenuSetState(ID_ITYPN,ItemChecked,1)
            CALL WMenuSetState(ID_ITYPC,ItemChecked,0)
            CALL WMenuSetState(ID_IGPC,ItemChecked,0)
            CALL WMenuSetState(ID_IGPN,ItemChecked,0)
            go to 100
          CASE (ID_ITYPC)
            MENUS=9
!            IQSW(2)=1-IQSW(2)
!            IF(IQSW(2) .EQ. 1) THEN
!              IQSW(1)=0
!            ENDIF
            IQSW(2)=1
            IQSW(1)=0
            CALL WMenuSetState(ID_ITYPC,ItemChecked,1)
            CALL WMenuSetState(ID_ITYPN,ItemChecked,0)
            CALL WMenuSetState(ID_IGPC,ItemChecked,0)
            CALL WMenuSetState(ID_IGPN,ItemChecked,0)
            go to 100
          CASE (ID_IGPN)
            MENUS=9
            IQSW(1)=2
            IQSW(2)=0
            CALL WMenuSetState(ID_ITYPN,ItemChecked,0)
            CALL WMenuSetState(ID_ITYPC,ItemChecked,0)
            CALL WMenuSetState(ID_IGPN,ItemChecked,1)
            CALL WMenuSetState(ID_IGPC,ItemChecked,0)
            go to 100
          CASE (ID_IGPC)
            MENUS=9
            IQSW(1)=0
            IQSW(2)=2
            CALL WMenuSetState(ID_ITYPC,ItemChecked,0)
            CALL WMenuSetState(ID_ITYPN,ItemChecked,0)
            CALL WMenuSetState(ID_IGPN,ItemChecked,0)
            CALL WMenuSetState(ID_IGPC,ItemChecked,1)
            go to 100
          CASE (ID_MAPOPD)
            DO
              call wdialogload(IDD_DIALOG05)

                call wdialogputcheckbox(IDF_CMAP0,ICOLON(1))
                call wdialogputcheckbox(IDF_CMAP1,ICOLON(2))
                call wdialogputcheckbox(IDF_CMAP2,ICOLON(3))
                call wdialogputcheckbox(IDF_CMAP3,ICOLON(4))
                call wdialogputcheckbox(IDF_CMAP4,ICOLON(5))
                call wdialogputcheckbox(IDF_CMAP5,ICOLON(6))
                call wdialogputcheckbox(IDF_CMAP6,ICOLON(7))
                call wdialogputcheckbox(IDF_CMAP7,ICOLON(8))
                call wdialogputcheckbox(IDF_CMAP8,ICOLON(9))
                call wdialogputcheckbox(IDF_CMAP9,ICOLON(10))
                call wdialogputcheckbox(IDF_CMAP10,ICOLON(11))
                call wdialogputcheckbox(IDF_CMAP11,ICOLON(12))

              CALL WDialogSelect(IDD_DIALOG05)
              CALL WDialogShow(-1,-1,0,Modal)
 
              IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN

                call wdialoggetcheckbox(IDF_CMAP0,ICOLON(1))
                call wdialoggetcheckbox(IDF_CMAP1,ICOLON(2))
                call wdialoggetcheckbox(IDF_CMAP2,ICOLON(3))
                call wdialoggetcheckbox(IDF_CMAP3,ICOLON(4))
                call wdialoggetcheckbox(IDF_CMAP4,ICOLON(5))
                call wdialoggetcheckbox(IDF_CMAP5,ICOLON(6))
                call wdialoggetcheckbox(IDF_CMAP6,ICOLON(7))
                call wdialoggetcheckbox(IDF_CMAP7,ICOLON(8))
                call wdialoggetcheckbox(IDF_CMAP8,ICOLON(9))
                call wdialoggetcheckbox(IDF_CMAP9,ICOLON(10))
                call wdialoggetcheckbox(IDF_CMAP10,ICOLON(11))
                call wdialoggetcheckbox(IDF_CMAP11,ICOLON(12))

              ENDIF
              CALL PLOTOT(0)
              nhtp=nhtpsv
              nmess=nmessv
              nbrr=nbrrsv
              call hedr          
              GO TO 100

            ENDDO
            GO TO 100

          CASE (ID_DRAWD)
            CALL PLOTOT(0)
            nhtp=nhtpsv
            nmess=nmessv
            nbrr=nbrrsv
            call hedr          

            GO TO 100

          CASE (ID_BSEL)
            CALL PANEL012(IBAKON)
            IF(IBAKON .EQ. 1) THEN
!              FONT%IBCOL = TextWhite
!              call WindowFontColour(0,7)
               IRGB = WRGB(220,220,220) 

            ELSE 
!              FONT%IBCOL = TextWhiteBold
!              call WindowFontColour(0,15)
               IRGB = WRGB(255,255,255) 
            ENDIF
!            CALL WindowFont(FONT)
            call clear_screen
            call plotot(0)
            nhtp=nhtpsv
            nmess=nmessv
            nbrr=nbrrsv
            call hedr          

            GO TO 100

           CASE (ID_REGST)
             DO N=1,NBKFL
               IF(ISWBKFL(N) .NE. 0) THEN
                 CALL REGISTR(N)
               ENDIF
             ENDDO
             GO TO 100

!          CASE (ID_BACGDG)
!            call clear_screen
!            call plotot(0)
!            nhtp=nhtpsv
!            nmess=nmessv
!            nbrr=nbrrsv
!            call hedr          

!            GO TO 100


          CASE (ID_HELP1)
            call helps(0)
!            call WHelpfile('rmagenv5.htm')
            go to 100
!            MENUS=4
          CASE (ID_HELP2)
            call RMINFO
            go to 100

          CASE (ID_ITEM20)
            CALL GDIST
            GO TO 100

          CASE (ID_ITEM22)
            CALL SELNODE(0)
            menus=2
            GO TO 100

          CASE (ID_ALLNODES)
            CALL SELNODE(1)
            menus=2
            GO TO 100

          CASE (ID_UNUSNODES)
            CALL SELNODE(2)
            menus=2
            GO TO 100

          CASE (ID_SELELTYP)
            CALL SELNODE(3)
            menus=2
            GO TO 100

          CASE (ID_MOVGRP)
            CALL SELNODE(4)
            menus=2
            GO TO 100

          CASE (ID_ITEM23)
            CALL SELELT(0)
            menus=0
            GO TO 100
          CASE (ID_SECGRP)
            CALL SELELT(2)
            menus=0
            GO TO 100
!            CALL HEDR
          CASE (ID_SELAREA)
            CALL SELELT(1)
            menus=2
            GO TO 100
          CASE (ID_DISPTYP)
            CALL FINDTYP
            menus=2
            GO TO 100

          CASE (ID_UNDO)
            CALL UNDOACT
            GO TO 100
          CASE (ID_UNDOS)
            IFLAG='U'
          CASE (ID_UNDOGEN)
!            IF(ITOTFIL .EQ. 1) THEN
!              CALL ZEROOUT
!              IACTVFIL=0
!              CALL PLOTOT(0) 
!            ELSE  
              CALL UNDOGEN
!            ENDIF
            GO TO 100
          CASE (ID_RESTORELEV)
            CALL RESTORELV
            GO TO 100  
          CASE (ID_GOUTLIN)
            CALL GOUTLIN
			GO TO 100
          CASE (ID_XOUTLIN)
            CALL OUTLINES(0)
			GO TO 100
          CASE (ID_3DMODEL)
            CALL BuildModel(np,ne)
            GO TO 100
         END SELECT

!
!  Mouse button down - only process mouse button 1 events
!
      CASE (MouseButDown)
       if(menus .eq. 8) then
        call rred
        IF (MESSAGE%VALUE1.EQ.1) THEN
!
!  Enable button up and mouse movement events
!
          CALL WMessageEnable(MouseButUp, Enabled)
!          CALL WMessageEnable(MouseMove , Enabled)
          IDOWN = 1
!
!  Save the current cursor position
!
          XPOS  = MESSAGE%GX
          YPOS  = MESSAGE%GY
!  For box plotting we must initialise Exclusive-OR plotting,
!  set the fill type, draw the initial box and save the corner
!  co-ordinates
!
          CALL IGrPlotMode('E')
!DEC09          CALL IGrPlotMode(0)
          if(idrag .eq. 0) then
            CALL IGrFillPattern(0,0,0)
            CALL IGrRectangle(XPOS, YPOS, MESSAGE%GX, MESSAGE%GY)
		  else
		    call Rgreen
            CALL IGrJoin(XPOS, YPOS, MESSAGE%GX, MESSAGE%GY)
			iflag='d'
		  endif
          XOLD  = MESSAGE%GX
          YOLD  = MESSAGE%GY
		ELSE
	      call WCursorShape(CurArrow)
		  idrag=0
          nhtp=nhtpsv
          nmess=nmessv
          nbrr=nbrrsv
          call hedr          
          menus=0
        ENDIF
        GO TO 101
       ELSE
        MBUTTON = MESSAGE%VALUE1
        ITIME   = MESSAGE%VALUE2
        MOUSEX  = MESSAGE%X
        MOUSEY  = MESSAGE%Y
        XM=MESSAGE%GX
        YM=MESSAGE%GY
        IF(MBUTTON .EQ. 1) THEN
          IFLAG='c'
        ELSE
		  if(idrag .eq. 0) then
            IFLAG='r'
		  else
		    idrag=0
			menus=0
			go to 101
		  endif
        ENDIF
       ENDIF
!
!  Mouse Movement
!
      CASE (MouseMove)
       IF (IDOWN.EQ.1) THEN
!
!  For rectangle plotting we must redraw the last box to erase it from the
!  screen. We then update the co-ordinates and draw the new rectangle
!
         IF(IDRAG .EQ. 0) THEN
          CALL IGrRectangle(XPOS, YPOS, XOLD, YOLD)
          XOLD = MESSAGE%GX
          YOLD = MESSAGE%GY
            XSCRN= XOLD
          YSCRN= YOLD
          XMS = XSCRN*TXSCAL - XS 
          YMS = YSCRN*TXSCAL - YS 
          WRITE(STBAR,'(2g19.10)') XMS,YMS
          CALL WindowOutStatusBar(2,STBAR)
          WRITE(STBAR,'(''  NP = ''i6,''  NE = ''i6)') NP,NE
          CALL WindowOutStatusBar(3,STBAR)
          WRITE(STBAR,'(2x,A48)') FNAMEDISP
          CALL WindowOutStatusBar(5,STBAR)
          xsiz=abs(xold-xpos)
          ysiz=abs(yold-ypos)
          slen=sqrt(xsiz**2+ysiz**2)

		  shapef=hsize/8.

!jan09          if(xsiz .lt. 1.25*ysiz) then
!jan09            xsiz=1.25*ysiz
          if(xsiz .lt. shapef*ysiz) then
            xsiz=shapef*ysiz
!            xsiz=16./25.*slen
            if(xold .lt. xpos) then
              xold=xpos-xsiz
            else
              xold=xpos+xsiz
            endif
!jan09          elseif(ysiz .lt. 0.80*xsiz) then
!jan09            ysiz=0.80*xsiz
          elseif(ysiz .lt. xsiz/shapef) then
            ysiz=xsiz/shapef
!            ysiz=9./25.*slen
            if(yold .lt. ypos) then
              yold=ypos-ysiz
            else
              yold=ypos+ysiz
            endif
          endif
          CALL IGrRectangle(XPOS, YPOS, xold,yold)
          go to 101
         ELSE
          CALL IGrJoin(XPOS, YPOS, XOLD, YOLD)
          XOLD = MESSAGE%GX
          YOLD = MESSAGE%GY
            XSCRN= XOLD
          YSCRN= YOLD
          XMS = XSCRN*TXSCAL - XS 
          YMS = YSCRN*TXSCAL - YS 
          WRITE(STBAR,'(2g19.10)') XMS,YMS
          CALL WindowOutStatusBar(2,STBAR)
          WRITE(STBAR,'(''  NP = ''i6,''  NE = ''i6)') NP,NE
          CALL WindowOutStatusBar(3,STBAR)
          WRITE(STBAR,'(2x,A48)') FNAMEDISP
          CALL WindowOutStatusBar(5,STBAR)
          CALL IGrJoin(XPOS, YPOS, XOLD, YOLD)
          go to 101
		 ENDIF
       ELSE
         XOLD = MESSAGE%GX
         YOLD = MESSAGE%GY
         XSCRN= XOLD
         YSCRN= YOLD
         XMS = XSCRN*TXSCAL - XS 
         YMS = YSCRN*TXSCAL - YS 
         WRITE(STBAR,'(2g19.10)') XMS,YMS
         CALL WindowOutStatusBar(2,STBAR)
          WRITE(STBAR,'(''  NP = ''i6,''  NE = ''i6)') NP,NE
          CALL WindowOutStatusBar(3,STBAR)
          WRITE(STBAR,'(2x,A48)') FNAMEDISP
          CALL WindowOutStatusBar(5,STBAR)
         GO TO 101
       ENDIF

!      CASE (PushButton)              ! Dialog button pressed
!        IDBUTN  = MESSAGE%VALUE1
!        IDFIELD = MESSAGE%VALUE2

      CASE (MouseButUp) ! Mouse button up
        IF(MENUS .NE. 8) THEN
          MBUTTON = MESSAGE%VALUE1
          ITIME   = MESSAGE%VALUE2
          MOUSEX  = MESSAGE%X
          MOUSEY  = MESSAGE%Y
          XM=MESSAGE%GX
          YM=MESSAGE%GY
          IF(MBUTTON .EQ. 1) THEN
            IFLAG='c'
          ELSE
            IFLAG='r'
          ENDIF
        ELSE
!
!  We disable movement and button up events
!
          IDOWN = 0
          CALL WMessageEnable(MouseButUp, Disabled)
!          CALL WMessageEnable(MouseMove , Disabled)
          IF(IDRAG .EQ. 0) THEN
            CALL IGrRectangle(XPOS, YPOS, XOLD, YOLD)
            CALL IGrPlotMode('N')
            CALL IGrRectangle(XPOS, YPOS, xold,yold)
            XPOS1=MESSAGE%GX
            YPOS1=MESSAGE%GY
            menus=-8
            zoomh=' Click right if size OK' 
!                                                                       
            CALL CLRBOX 
            CALL SYMBL(0.,7.70,0.20,zoomh,0.,23) 
            GO TO 101
		  ELSEIF(IDRAG .EQ. 1) THEN
            menus=8
            CALL IGrJoin(XPOS, YPOS, XOLD, YOLD)
            CALL IGrPlotMode('N')
            CALL IGrJoin(XPOS, YPOS, xold,yold)

            XPOS1=MESSAGE%GX
            YPOS1=MESSAGE%GY
            xpos=xpos1-xpos
			ypos=ypos1-ypos
			xpos1=xpos+HSIZE
            ypos1=ypos+8.
			iflag='d'
            call zoomnew(xpos,ypos,xpos1,ypos1,iflag)      
            zoomh=' Click right to end ' 
!                                                                       
            CALL CLRBOX 
            CALL SYMBL(0.,7.70,0.20,zoomh,0.,20) 
			iflag='r'
 			GO TO 101
 		  ELSE
            menus=8
            CALL IGrJoin(XPOS, YPOS, XOLD, YOLD)
            CALL IGrPlotMode('N')
            CALL IGrJoin(XPOS, YPOS, xold,yold)

            XPOS1=MESSAGE%GX
            YPOS1=MESSAGE%GY
            xpos=xpos1-xpos
			ypos=ypos1-ypos
            zoomh=' Click right to end ' 
            
            IF(ABS(XPOS) .GT. ABS(YPOS)) THEN
              hrad=xpos/(YPOS1-4)
              VRAD=0.
            ELSE
              vrad=-ypos/10.
              HRAD=0.
            ENDIF
            call adjustang(hrad,vrad)
!                                                                       
            CALL CLRBOX 
            CALL SYMBL(0.,7.70,0.20,zoomh,0.,20) 
			iflag='r'
 			GO TO 101
		  ENDIF
        ENDIF
!        WRITE(90,*) 'MOUSE BUT',MOUSEX,MOUSEY,XM,YM
!        WRITE(90,'(A)') 'MOUSE BUT',IFLAG
      CASE (Expose)                  ! Window partly/wholly exposed
        iflag='P'
        IX      = MESSAGE%X
        IY      = MESSAGE%Y
        IWIDTH  = MESSAGE%VALUE1
        IHEIGHT = MESSAGE%VALUE2
        call hedr
        if(menus .eq. 12  .or.  menus .eq. 13) then
          call conout(menus)
        else
          call plotot(0)
        endif
        call hedr
!IPK MAY01
        IRDISP=1
        if(nmess .eq. 11) CALL PLTPT

        if(menus .eq. 13) CALL CONOUT(MENUS)

        go to 100
      CASE (Resize)                  ! Window resized
        CALL IGrUnits(0.,0.,HSIZE,8.0)
        iflag='P'
        IWIDTH  = MESSAGE%VALUE1
        IHEIGHT = MESSAGE%VALUE2
        call hedr

        if(menus .eq. 12  .or.  menus .eq. 13) then
          call conout(menus)
        else
          call plotot(0)
        endif
        call hedr
!IPK MAY01
        IRDISP=1        
        if(nmess .eq. 11) CALL PLTPT

        if(menus .eq. 13) CALL CONOUT(MENUS)

        go to 100
       CASE (CloseRequest)            ! Close window (e.g. Alt/F4)
        IWINDOW = MESSAGE%WIN
		if(iwindow .eq. 0) then
!IPK SEP02
          call rquit(iyes)
          if(iyes .ne. 1) go to 100
          CALL QUIT_PGM       ! Root window : exit program
		else
  	      CALL WindowCloseChild(iwindow)
  	  	  DO I=1,NWINDWS
		    IF(IWINDOW .EQ. IWNDWS(I)) THEN
              IWNDWS(i)=0
              ISCRNS(i)=0 
!          This call removes the bitmap
              CALL BACKP(3,I)
			ENDIF
		  ENDDO
	  	  go to 100
		endif
!      CASE (FieldChanged)            ! Field change in modeless dialog
!        IDFIELDOLD = MESSAGE%VALUE1
!        IDFIELDNEW = MESSAGE%VALUE2
    END SELECT
!    WRITE(90,'(A)') 'endselect',IFLAG
!    write(90,*) 'endselect',menus
    menus =abs(menus)
    IF(MENUS .GT. 0 .and. menus .lt. 8) THEN
      CALL RMAGEN(MENUS,IMP,IIN,1,IOT,IOT1,NDM,ITRIAN,N2,M2)
    ENDIF
      if(menus .eq. 8) then
        IF(IFLAG .EQ. 'w') THEN
          HANG=0.
          VANG=90
          VRTSCAL=100.
          VRTORIG=0.
          i3dview=0
        endif
        if( IFLAG .EQ. 'r'  .or.&
            iflag .eq. 'y'  .or.&
            iflag .eq. 'x'  .or.&
            iflag .eq. 'w'  .or.&
            iflag .eq. 'v'  .or.&
            iflag .eq. 'u'  .or.&
            iflag .eq. 't'  .or.&
            iflag .eq. 's'   ) then
          call zoomnew(xpos,ypos,xpos1,ypos1,iflag)      
          nhtp=nhtpsv
          nmess=nmessv
          nbrr=nbrrsv
          call hedr          
        endif
!IPK MAY01
        IRDISP=1
        if(nmess .eq. 11) CALL PLTPT
        go to 100
      endif
      IF(MENUS .EQ. 9) GO TO 101
    

      ix=xm*100.
      iy=ym*100.
!      call IMouseCursorHide()
  250 continue
      nhtp=nhtpsv
      nmess=nmessv
      nbrr=nbrrsv
!    WRITE(90,'(A)') 'end',IFLAG
!    write(90,*) 'end',menus,nhtp,nhtpsv
!      call clscrn
!      call hedr
      END SUBROUTINE