!     last update feb 10 2002 add lock/unlock
!     Last change:  IPK   2 Mar 1999   12:05 pm
      SUBROUTINE SELNODE(ISW)

      USE WINTERACTER
      USE BLKMAP
      USE BLK1MOD
      USE BLK2MOD 

      include 'd.inc'
                                                                        
      dimension xot(100),yot(100)
!      INCLUDE 'BLK1.COM'
!      INCLUDE 'BLK2.COM'
!
      dimension nodlist(maxp),RLAY(9)
!      DIMENSION ICN(MAXP) 
      character*1 iflag
      CHARACTER*1 ANS,ANSW(10)
	  CHARACTER*63  STRELS 
      DATA ANSW/'m','a','f','s','k','u','t','w','h','q'/
	  DATA STRELS/' You have tried set to set elevation with no mapfile"'/ 
      DATA ISWBAK,ISWBAKAG/0,0/
                                                                        
                                                                        
!
!   save nhtp etc

      nhtps=nhtp
      nbrs=nbrr
      nmessv=nmess
      if(isw .eq. 0  .or.  isw  .eq. 4) then

        CALL GETPOLY(XOT,YOT,NPTS) 

!     look for points inside polygon                                    
                                                                        
        ndlist=0 
        do j=1,np 
          if(inskp(j) .eq. 0) then 
            inswt=0 
            call cpoly(xot,yot,npts,cord(j,1),cord(j,2),inswt) 
            if(inswt .eq. 1) then 
              call rred 
              fpn=j 
              x = cord(j,1) 
              y = cord(j,2) - .11 
              call numbr(x,y,ht,fpn,0.0,-1) 
              ndlist=ndlist+1 
              nodlist(ndlist)=j 
            endif 
          endif 
        enddo 
        call rblue
      elseif(isw .eq. 1) then
!                                                                       
!  Add all nodes to list                                                         
!                                                                       
        NDLIST=0 
        DO J=1,NP 
          IF(INEW(J) .EQ. 1) THEN 
            NDLIST=NDLIST+1
            NODLIST(NDLIST)=J
          ENDIF 
        END DO 

      elseif(isw .eq. 2) then

!     Get inactive nodes

        DO  I=1,NP 
          ICN(I) = 0 
        ENDDO
        DO J = 1, NE 
          IF( IMAT(J) .NE. 0 ) THEN
            DO K = 1, 8 
              IF( NOP(J,K) .GT. 0)  THEN
                ICN(NOP(J,K))=999 
              ENDIF
            ENDDO 
          ENDIF
        END DO 
!                                                                       
!  Add nodes to list                                                         
!                                                                       
        NDLIST=0 
        DO J=1,NP 
          IF(ICN(J) .EQ. 0  .AND. INEW(J) .EQ. 1) THEN 
            NDLIST=NDLIST+1
            NODLIST(NDLIST)=J
          ENDIF 
        END DO 

      elseif(isw .eq. 3) then
        NS=1
        call wdialogload(IDD_SELELTYP)
        ierr=infoerror(1)

        CALL WDialogPutInteger(IDF_INTEGER1,NS)

        CALL WDialogSelect(IDD_SELELTYP)
        ierr=infoerror(1)

        CALL WDialogShow(-1,-1,0,ModaL)
        ierr=infoerror(1)

        do  
          IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
            CALL WDialogGetInteger(IDF_INTEGER1,NS)
            go to 80
          ENDIF
        enddo
   80   CONTINUE
        DO  I=1,NP 
          ICN(I) = 0 
        ENDDO
        NDLIST=0
        DO K=1,NE
          IF(IMAT(K) .EQ. NS) THEN
            DO L=1,8
              NST=NOP(K,L)
              IF(NST .GT. 0) THEN
                IF(ICN(NST) .EQ. 0) THEN
                  NDLIST=NDLIST+1
                  NODLIST(NDLIST)=NST
                  ICN(NST)=1
                ENDIF
              ENDIF
            ENDDO
          ENDIF
        ENDDO
   
      endif 
!     NEW MOVE OPERATION
      
      IF(ISW .EQ. 4) THEN
        CALL MVGRP(NDLIST,NODLIST)
        nhtp=nhtps
        nbrr=nbrs
        nmess=nmessv
        call hedr
        RETURN
      ENDIF
      nbrr=0 
      nhtp=14
      call hedr
      CALL XYLOC(xscrn1,yscrn1,iflag,ibox) 
      if(ibox .eq. 1  .or.  iflag .eq. 'd') then
        do n=1,ndlist
          j=nodlist(n)
          call deletn(j) 
        enddo
      elseif(ibox .eq. 2  .or. iflag .eq. 'e') then
        do n=1,ndlist
          j=nodlist(n)
          wd(j)=-9999.
        enddo
      elseif(ibox .eq. 3  .or. iflag .eq. 't') then
!                                                                       
!  Establish size for range                                             
!                                                                       
!        IF(IMP .EQ. 0) THEN
!          CALL SYMBL(0.,7.25,0.20,STRELS,0.,63) 
!          nhtp=nhtps
!          nbrr=nbrs
!          nmess=nmessv
!          call hedr
!          RETURN 
!        endif

  100 CONTINUE 
      NHTP = 16 
      NMESS = 0 
      NBRR = 0 
      CALL HEDR 
!                                                                       
!  Get answer                                                           
!                                                                       
  110 call xyloc(XPT,YPT,ANS,IBOX) 
      IF(IRMAIN .EQ. 1) RETURN 
      IF(ANS .EQ. 'c') THEN
        if(ibox .eq. 0) go to 110 
        ANS=ANSW(IBOX) 
      ENDIF 
      IF(ANS .EQ. 'm') THEN 
!                                                                       
!  This option allows changes to bottom elevations                      
!  
        IF(ISWBAKAG .EQ. 0) CALL SETBACK(ISWBAK,ISWBAKAG)
        CALL ADDPTH2(NODLIST,NDLIST,ISWBAK)
		GO TO 220
                                                                        
      ELSEIF (ANS .EQ. 'a')  THEN 
!                                                                       
!  All nodes                                                            
!                                                                       
        ISWT = -1 
      ELSEIF(ANS .EQ. 'f') THEN 
!                                                                       
!  Fill nodes                                                           
!                                                                       
        ISWT = 0 
!      ELSEIF(ANS .EQ. 's') THEN 
!                                                                       
!  Single node at a time                                                
!                                                                       
!        ISWT = 1 

!ipk feb02 add lock/unlock and remove cdata
                                                                        
!      ELSEIF(ANS .EQ. 'w') THEN 
!                                                                       
!  This option allows changes to nodal widths                           
!                                                                       
!        CALL ADDWID 
!        IF(IRMAIN .EQ. 1) RETURN 
!        GO TO 100 
!                                                                       
!  Call to help screen                                                  
!                                                                       
      ELSEIF(ANS .EQ. 'h') THEN 
        CALL HELPS(4) 
        IF(IRMAIN .EQ. 1) RETURN 
        GO TO 100 
!                                                                       
      ELSEIF(ANS .EQ. 'q') THEN 
!                                                                       
!  Writeout and return                                                  
!                                                                       
        CALL WRTOUT(0) 
        RETURN 
      ENDIF 

      IF(IMP .EQ. 0) THEN
        CALL SYMBL(0.,7.25,0.20,STRELS,0.,63) 
        go to 100
      endif
!                                                                       
!  Establish size for range                                             
!                                                                       
!!!!!!!!!!!!!!!!!!!!!!!!!

      IF(ISWTAGN .EQ. 0) THEN

!        IF(IRECD .EQ. 2) THEN
!	      iswtintp=0
!	      iswtagn=0
!          go to 210		    
! 	     ENDIF
        CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to interpolate '//&
        CHAR(13)//'from the triangulated map file?' ,&
                 'Select Interpolation method?')
!   If answer 'Yes'  set interpolate switch to 1
!
        IF (WInfoDialog(4) .EQ. 2) then
	      iswtintp=0
	    ELSE
	      iswtintp=1
        ENDIF    

        CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Ask this question again?'//&
        CHAR(13)//'  ' ,&
                 'Ask again?')
!   If answer 'Yes'  set again switch to 0
!
        IF (WInfoDialog(4) .EQ. 2) then
	      iswtagn=1
        ELSE
	      iswtagn=0
        ENDIF    
	  ENDIF

  210   CONTINUE

!!!!!!!!!!!!!!!!!!!!!!!!!!!!

        IF(ISWTINTP .EQ. 0) THEN

          call setrng(xnears,nmap)
          iswt=0
          do n=1,ndlist
            m=nodlist(n)
!ipk feb02
!ipk jan08 chnage subscript
            if(lock(m) .eq. 0) CALL SETELV(XNEARS,NMAP,M,ISWT)
          enddo
		ELSE
          if(nelts .eq. 0) then
            CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'No triangulated exists'//&
            CHAR(13)//'Do you wish to triangulate now?' ,&
                 'NO TRIANGULATION AVAILABLE?')
!   If answer 'Yes'  set triangulate now
!
            IF (WInfoDialog(4) .EQ. 2) then
	          return
	        ELSE
	          call triang
            ENDIF    

		  endif
          do n=1,ndlist
            m=nodlist(n)
            write(155,*) 'selt',m
!ipk mar20            
            if(iswt .eq. 0  .and.  wd(m) .gt. -4400.) cycle
            if(lock(m) .eq. 0) CALL TRIANINT(NMAP,M,ISWT,ITIME)
		  enddo
		ENDIF
  220   CONTINUE

      elseif(ibox .eq. 4  .or. iflag .eq. 'l') then

!   Define layers

        call openlay

        NHTP=0 
        NBRR=0
        NMESS=45 
        CALL HEDR 
        NMESS=4 
        xprt=3.2 
!                                                                       
!        call getint(nlay) 

        call GETLAYDAT(NLAY,ipos,RLAY)
        ILAYTP=IPOS
  
        do n=1,ndlist
          j=nodlist(n)
          lay(j)=nlay
          DO I=1,NLAY
            WTLAY(J,I)=RLAY(I)
          ENDDO
        enddo
        REWIND 102
        DO J=1,NP
          IF(LAY(J) .GT. -9998) THEN
            if(ILAYTP .eq. 1) then
              write(102,6000) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
  6000        format('LD2     ',2i8,9F8.2)
            else
              write(102,6001) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
  6001        format('LD3     ',2i8,9F8.2)
            endif
          ENDIF
        ENDDO
        nlayd=1
!ipk feb02 add lcok/unlock
      elseif(ibox .eq. 5  .or. iflag .eq. 'k') then
        do n=1,ndlist
          j=nodlist(n)
          lock(j)=1
        enddo
      elseif(ibox .eq. 6  .or. iflag .eq. 'u') then
        do n=1,ndlist
          j=nodlist(n)
          lock(j)=0
        enddo
      elseif(ibox .eq. 7  .or. iflag .eq. 'f') then
        do n=1,np
          list(n)=0
        enddo
        do n=1,ndlist
          list(nodlist(n))=1
        enddo
        call deln2(np,0)
      endif
 
!      CALL PLOTOT(1) 

      nhtp=nhtps
      nbrr=nbrs
      nmess=nmessv
      call hedr
      RETURN 
      END                                           

      SUBROUTINE SELELT(ISW) 
                                                                        
      USE BLK1MOD
      save fracd
      dimension xot(100),yot(100)

!      INCLUDE 'BLK1.COM' 
!
      dimension nodlist(maxp)
      character*1 iflag
      
      data itime/0/
      
      if(itime .eq. 0) then
      mat=0
      itime=1
      endif

      IF(ISW .EQ. 2) GO TO 200
      
      CALL GETPOLY(XOT,YOT,NPTS) 
                                                                        
                                                                        
!
!   save nhtp etc

      nhtps=nhtp
      nbrs=nbrr
      nmessv=nmess

!     look for points inside polygon                                    
                                                                        
      ndlist=0 
      nefl=0 
      do n=1,ne 
        ieswt=0 
        if(ieskp(n) .eq. 0) then 
         ieswt=1 
          do m=1,ncorn(n) 
            j=nop(n,m) 
            if(j .gt. 0) then 
              inswt=0 
              call cpoly(xot,yot,npts,cord(j,1),cord(j,2),inswt) 
              if(inswt .eq. 1) then 
!                call rred 
!                fpn=j 
!                x = cord(j,1) 
!                y = cord(j,2) - .11 
!                call numbr(x,y,ht,fpn,0.0,-1) 
                ndlist=ndlist+1 
                nodlist(ndlist)=j 
              else 
                ieswt=0 
              endif 
            endif 
          enddo 
        endif 
        if(ieswt .eq. 1) then 
          nefl=nefl+1 
          neflag(nefl)=n 
!          call rcyan 
!          fpn = n 
!          x = xc(n) 
!          y = yc(n) + .01 
!          call numbr(x,y,0.20,fpn,0.0,-1) 
          call fillem(n)
        endif 
      enddo 
      call rblue 

      GO TO 300
200   CONTINUE
!
!   save nhtp etc

      nhtps=nhtp
      nbrs=nbrr
      nmessv=nmess
      NEFL=0
      CALL GETFRAC(FRACD)
      call plotot(0)
      DO N=1,NE
        IF(EDIF(N) .GT. (1.-FRACD)*EDIF(0)) THEN
          nefl=nefl+1 
          neflag(nefl)=n 
          call fillem(n)
        ENDIF
      ENDDO      
300   CONTINUE
      if(isw .eq. 0  .OR.  ISW .EQ. 2) then
        nbrr=0 
        nhtp=15
        call hedr
        CALL XYLOC(xscrn1,yscrn1,iflag,ibox) 
        if(ibox .eq. 1  .or.  iflag .eq. 'd') then
          do n=1,nefl
            j=neflag(n)
            call deltel(j) 
          enddo
      	  nefl=0
        elseif(ibox .eq. 2  .or. iflag .eq. 'e') then
          call refb
        elseif(ibox .eq. 3  .or. iflag .eq. 't') then
          nhtp=0 
          nbrr=4 
          NMESS=45
          call hedr 
          nmess=2 
          call getint(mat) 
          ipsw(7)=1
          ipsw(5)=0
          do n=1,nefl
            j=neflag(n)
            imat(j) = mat 
          enddo
          nefl=0
        elseif(ibox .eq. 4  .or. iflag .eq. 'm') then
!                                                                       
!  simplify layout                                  
!                                                                       
          IECHG=0 
!IPK MAY03
          ICHG=0
          CALL SMFY 

!ipk dec11
        elseif(ibox .eq. 5  .or. iflag .eq. 'g') then
!                                                                       
!  form group       
!                   
          CALL FORMGP
          
        endif
 

 
        CALL PLOTOT(1) 

        nhtp=nhtps
        nbrr=nbrs
        nmess=nmessv
        call clrbox
        call hedr
	  else
	    call extract(NODLIST,NDLIST)

!     display extracted file

 
        CALL PLOTOT(1) 
  
        nhtp=nhtps
        nbrr=nbrs
        nmess=nmessv
        call clrbox
        call hedr
	  endif

                                                                        
      RETURN 
      END                                           
                                                                        
      SUBROUTINE CPOLY(XOT,YOT,NPTS,X,Y,INSWT) 
      DIMENSION XOT(*),YOT(*) 
      REAL*8 X,Y
      DATA PI/3.14159/ 
      SUMA=0 
      DO N=1,NPTS-1 
        ANG1=ATAN2(YOT(N+1)-Y,XOT(N+1)-X) 
        ANG2=ATAN2(YOT(N)-Y,XOT(N)-X) 
        DIFA=ANG2-ANG1 
        IF(ABS(DIFA) .GT. PI) THEN 
          IF(DIFA .LT. -PI) DIFA=DIFA+2.*PI 
          IF(DIFA .GT.  PI) DIFA=DIFA-2.*PI 
        ENDIF 
        SUMA=SUMA+DIFA 
      ENDDO 
      IF(ABS(SUMA) .GT. PI) THEN 
        INSWT=1 
      ELSE 
        INSWT=0 
      ENDIF 
      RETURN 
      END                                           
                                                                        
      SUBROUTINE GETPOLY(XOT,YOT,NPTS) 
                                                                        
      USE BLK1MOD
      dimension xot(*),yot(*)
!      INCLUDE 'BLK1.COM'
!
      CHARACTER*23 SELN3 
      CHARACTER*32 SELN 
      CHARACTER*24 SELN2 
      CHARACTER*1  IFLAG 
      data SELN/' Click at points to form polygon'/ 
      data SELN2/' Click next point       '/ 
      data SELN3/' Click last point again'/ 

   80 CALL CLRBOX 
      nhtp=0
      nbrr=5
      nmess=0
      call hedr
      CALL SYMBL(0.,7.70,0.20,SELN,0.,32) 
!                                                                       
  100 continue 
!                                                                       
!  Get cursor location                                                  
!                                                                       
      CALL XYLOC(xscrn,yscrn,iflag,ibox) 
      IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
      if (iflag .eq. 'q')  return 
!                                                                       
      if(iflag .eq. 'c') then 
        xot(1)=xscrn 
        yot(1)=yscrn 
        npts=1 
!                                                                       
!  This option is creating an inset locations                           
!                                                                       
  120   continue 
        CALL XYLOC(xscrn1,yscrn1,iflag,ibox) 
        IF(IRMAIN .EQ. 1) RETURN 
        if(ibox .eq. 6  .or.  iflag .eq. 'b') then 
          npts=npts-1 
          go to 120
        endif
         if(iflag .eq. 'c') then 
!                                                                       
!  Look for a screen size                                               
!                                                                       
  122     continue 
          xsiz=abs(xscrn1-xscrn) 
          ysiz=abs(yscrn1-yscrn) 
!ipk jun96  test for zero sizes                                         
          if(xsiz .lt. 0.001  .or.  ysiz .lt. 0.001) then 
            CALL CLRBOX 
            call hedr
            CALL SYMBL(0.,7.70,0.20,seln3,0.,23) 
            go to 120 
          endif 
          npts=npts+1 
          xot(npts)=xscrn1 
          yot(npts)=yscrn1 
          call DASHLN(xot,yot,npts,1) 
          CALL CLRBOX 
          call hedr

          CALL SYMBL(0.,7.70,0.20,seln2,0.,24) 
          CALL XYLOC(xscrn1,yscrn1,iflag,ibox) 
          IF(IRMAIN .EQ. 1) RETURN
 
          if(ibox .eq. 6  .or.  iflag .eq. 'b') then 
            npts=npts-1 
            go to 120
          elseif(ibox .eq. 7  .or.  iflag .eq. 'n') then 
            npts=npts+1 
            xot(npts)=xot(1) 
            yot(npts)=yot(1) 
            call DASHLN(xot,yot,npts,1) 
            go to 280 
          else 
            go to 122 
          endif 
        endif 
      ENDIF 
  280 continue                                                          
      RETURN                                                            
      END                                           

      subroutine extract(NODLIST,NDLIST)

      USE WINTERACTER
      USE BLK1MOD
      INCLUDE 'BFILES.I90'
!	  include 'blk1.com'


      include 'd.inc'

      DIMENSION NODLIST(*)
      CHARACTER(LEN=256)  :: FILTER
      CHARACTER(LEN=255)  :: FNAME,FNAMRM

!     select filename for new file

      FILTER ="Rm1 file -- *.rm1|*.rm1|"
      CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Filename for extracted file')

      IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
        GO TO 200
      ELSE
        GO TO 500
      ENDIF
  200 CONTINUE
      CALL IlowerCase(FNAME)

      ITOTFIL=ITOTFIL+1
      FNAMEOUT(ITOTFIL)=FNAME

!     save current file

      IFILOUT=IACTVFIL+50
      CALL WRTFIL(IFILOUT)

!     create network structure

      CALL ZERORELM(NODLIST,NDLIST)

      IACTVFIL=ITOTFIL



!     save new structure

      IOT = 20
      FNAMRM=FNAME
      igfgsw=0
      close(iot)
      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')                 

  500 continue
	  return
	  end

      SUBROUTINE ZERORELM(NODLIST,NDLIST)

      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 
!
      dimension nodlist(*)

	  DO N=1,NP

!     search nodlist

        do k=1,ndlist
          if(n .eq. nodlist(K)) go to 300
		enddo
		call deletn(n)
  300   continue
	  ENDDO

!    reset NP
	 
	  do k=np,1,-1
	    if(inew(k) .gt. 0) then
		  np=k
		  go to 350
		endif
	  enddo
  350 continue

!    reset NE

     do k=ne,1,-1
	    if(imat(k) .gt. 0) then
		  ne=k
		  go to 400
		endif
	  enddo
  400 continue

      RETURN
	  END

      SUBROUTINE GETFRAC(FRACD)
!                                                                       
!  Generate continuity lines                                            
!                      

	  USE WINTERACTER
	  save 
      include 'd.inc'
                                                 
!
! Declare window-type and message variables
!
      TYPE(WIN_STYLE)    :: WINDOW

      TYPE(WIN_MESSAGE) :: MESSAGE

      integer  :: I1,I2,I3,ITIME,IPOS
      
      REAL   ::  FRACD

      data itime/0/
      
      IF(ITIME .EQ. 0) THEN
        FRACD=0.1
        itime=1
      ENDIF

      call wdialogload(IDD_SETSEL)
      ierr=infoerror(1)

      CALL WDialogSelect(IDD_SETSEL)
      ierr=infoerror(1)
  
      CALL WDialogPutReal(IDF_REAL1,FRACD)

      CALL WDialogShow(-1,-1,0,Modal)
      ierr=infoerror(1)

      do
!
          IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN

            CALL WDialoggetReal(IDF_REAL1,FRACD)
            GO TO 100
          
		  ENDIF

      enddo

  100 CONTINUE
      return
      end

      SUBROUTINE FINDTYP
      
      USE WINTERACTER
      USE BLKMAP
      USE BLK1MOD
      USE BLK2MOD 
      character*1 iflag

      include 'd.inc'
      
      DATA NS/1/

     
      call wdialogload(IDD_SELELTYP)
      ierr=infoerror(1)

      CALL WDialogPutInteger(IDF_INTEGER1,NS)

      CALL WDialogSelect(IDD_SELELTYP)
      ierr=infoerror(1)

      CALL WDialogShow(-1,-1,0,ModaL)
      ierr=infoerror(1)

      do  
        IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
          CALL WDialogGetInteger(IDF_INTEGER1,NS)
          go to 80
        ENDIF
      enddo
80    CONTINUE
      ICLL=4
      call clscrn
      call plotot(0)
      nefl=0
      DO N=1,NE
        IF(IMAT(N) .EQ. NS) THEN
          CALL FILLEMC(N,ICLL)
          nefl=nefl+1
          neflag(nefl)=n

        ENDIF  
      ENDDO
        nbrr=0 
        nhtp=15
        call hedr
        CALL XYLOC(xscrn1,yscrn1,iflag,ibox) 
        if(ibox .eq. 1  .or.  iflag .eq. 'd') then
          do n=1,nefl
            j=neflag(n)
            call deltel(j) 
          enddo
      	  nefl=0
        elseif(ibox .eq. 2  .or. iflag .eq. 'e') then
          call refb
        elseif(ibox .eq. 3  .or. iflag .eq. 't') then
          nhtp=0 
          nbrr=4 
          NMESS=45
          call hedr 
          nmess=2 
          call getint(mat) 
          ipsw(7)=1
          ipsw(5)=0
          do n=1,nefl
            j=neflag(n)
            imat(j) = mat 
          enddo
          nefl=0
        elseif(ibox .eq. 4  .or. iflag .eq. 'm') then
!                                                                       
!  simplify layout                                  
!                                                                       
          IECHG=0 
!IPK MAY03
          ICHG=0
          CALL SMFY 

!ipk dec11
        elseif(ibox .eq. 5  .or. iflag .eq. 'g') then
!                                                                       
!  form group       
!                   
          CALL FORMGP
          
        elseif(ibox .eq. 6) then
          do n=1,nefl
            j=neflag(n)
            do jj=1,8
              if(nop(j,jj) .ne. 0) then
                wd(nop(j,jj))=-9999.
              endif
            enddo
          enddo
        endif
      
      RETURN
      END
      
      SUBROUTINE MVGRP(NDLIST,NODLIST)
    
      USE WINTERACTER
      USE BLK1MOD
      INCLUDE  'TXFRM.COM' 
      dimension nodlist(maxp),RLAY(9)
      character*1 iflag
!     GET AMOUNT OF SHIFT IN PAGE UNITS
 200  continue
      NHTP = 16 
      NMESS = 47
      NBRR = 0 
      CALL HEDR 
      CALL xyloc(xscrn1,yscrn1,iflag,ibox)
      CALL XYLOC(XSCRN2,YSCRN2,IFLAG,IBOX)
      XSHIFT=XSCRN2-XSCRN1
      YSHIFT=YSCRN2-YSCRN1
!     APPLY SHIFT TO NODES IN THE LIST    
      DO N=1,NDLIST
        CORD(NODLIST(N),1)=CORD(NODLIST(N),1)+XSHIFT
        CORD(NODLIST(N),2)=CORD(NODLIST(N),2)+YSHIFT
      ENDDO
      CALL PLOTOT(0)
      CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to save'//&
                CHAR(13)//'new coordinate location?' ,&
               'COORDINATE MOVE')
      IF (WInfoDialog(4) .EQ. 2) then
!     revert to old
        DO N=1,NDLIST
          CORD(NODLIST(N),1)=(XUSR(NODLIST(N))+XS)/TXSCAL
          CORD(NODLIST(N),2)=(YUSR(NODLIST(N))+YS)/TXSCAL
        ENDDO
        CALL PLOTOT(0)
        CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to '//&
                CHAR(13)//'try again?' ,&
               'COORDINATE MOVE')
        IF (WInfoDialog(4) .EQ. 2) then
          return
        else
          go to 200
        endif
      else
!     accept
      END IF
    RETURN
    END