SUBROUTINE MOVMESH
      
	  USE WINTERACTER
      USE BLK1MOD
	  
	  SAVE
	   
!      implicit none

      include 'd.inc'

      INCLUDE 'TXFRM.COM'

      INCLUDE 'BFILES.I90'
      
      CHARACTER*1 IFLAG
      REAL xlocorg,ylocorg,xlocscl,ylocscl,XREFPT,YREFPT,xlocs,ylocs,xlocf,ylocf,stscalx,stscaly,xtest,ytest
      INTEGER NTYPR,ITIMETHRU  
      
      allocatable xusrt(:),yusrt(:),xcrst(:),ycrst(:)
                         

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

      TYPE(WIN_MESSAGE) :: MESSAGE

      DATA ITIMTHRU/0/,NTYPR/1/,xlocorg/0./,ylocorg/0./,xlocscl/0./,ylocscl/0./

      call wdialogload(IDD_DIALOG048)
      ierr=infoerror(1)

      CALL WDialogSelect(IDD_DIALOG048)
      ierr=infoerror(1)

      IF(NTYPR .EQ. 1) THEN
        call wdialogputRadioButton(idf_radio1)
	  ELSE
        call wdialogputRadioButton(idf_radio2)
      ENDIF
      CALL WDialogShow(-1,-1,0,Modal)
      ierr=infoerror(1)

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

          call wdialoggetradiobutton(idf_radio1,ntypr)
          go to 100

        elseif(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN  
          return
   	    ENDIF

      enddo
 
 100  continue     
      
      IF(NTYPR .EQ. 1) THEN

        call wdialogload(IDD_DIALOG047)
        ierr=infoerror(1)

        CALL WDialogSelect(IDD_DIALOG047)
        ierr=infoerror(1)

        CALL WDialogPutReal(IDF_REAL1,xlocorg)
        CALL WDialogPutReal(IDF_REAL2,ylocorg)
        CALL WDialogPutReal(IDF_REAL3,xlocscl)
        CALL WDialogPutReal(IDF_REAL4,ylocscl)

        CALL WDialogShow(-1,-1,0,Modal)
        ierr=infoerror(1)
      
        do
          IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN

            CALL WDialogGetReal(IDF_REAL1,xlocorg)
            CALL WDialogGetReal(IDF_REAL2,ylocorg)
            CALL WDialogGetReal(IDF_REAL3,xlocscl)
            CALL WDialoggetReal(IDF_REAL4,ylocscl)
            
            allocate (xusrt(np),yusrt(np))

            if(xlocscl .eq. 0.) then
              do j=1,np
                xusrt(j)=xusr(j)
                yusrt(j)=yusr(j)
                xusr(j)=xusr(j)+xlocorg
                yusr(j)=yusr(j)+ylocorg
                CORD(J,1)=(XUSR(J)+XS)/TXSCAL
                CORD(J,2)=(YUSR(J)+YS)/TXSCAL
              enddo
              if(ncrsec .gt. 0) then
                allocate (xcrst(nrsec),ycrst(nrsec))
                do j=1,ncrsec
                  xcrst(j)=xcrs(j)
                  ycrst(j)=ycrs(j)
                  xcrs(j)=xcrs(j)+xlocorg
                  ycrs(j)=ycrs(j)+ylocorg
                enddo
              endif
            else
              do j=1,np
                xusr(j)=(xusr(j)-xlocorg)*xlocscl
                yusr(j)=(yusr(j)-ylocorg)*ylocscl
                CORD(J,1)=(XUSR(J)+XS)/TXSCAL
                CORD(J,2)=(YUSR(J)+YS)/TXSCAL
              enddo
              if(ncrsec .gt. 0) then
                allocate (xcrst(nrsec),ycrst(nrsec))
                do j=1,ncrsec
                  xcrst(j)=xcrs(j)
                  ycrst(j)=ycrs(j)
                  xcrs(j)=(xcrs(j)-xlocorg)*xlocscl
                  ycrs(j)=(ycrs(j)-ylocorg)*ylocscl
                enddo
              endif
            endif
                    
            go to 300
          
          elseif(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN  
            return
          endif
        enddo
      
      else

!    get reference point
!       xrefpt
!       yrefpt

        CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select Fixed Reference point','CHOOSE REFERENCE')
        CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)        
        XREFPT = XTEMP*TXSCAL - XS 
        YREFPT = YTEMP*TXSCAL - YS 

!    get start move point
!       xlocs
!       ylocs

        CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select Starting point','CHOOSE START')
        CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)        
        XLOCS = XTEMP*TXSCAL - XS 
        YLOCS = YTEMP*TXSCAL - YS 

!    get finish move point
!       xlocf
!       ylocf

        CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select Finishing point','CHOOSE FINISH')
        CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)        
        XLOCF = XTEMP*TXSCAL - XS 
        YLOCF = YTEMP*TXSCAL - YS 

!    establish x moves
      stscalx=(xlocf-xrefpt)/(xlocs-xrefpt)

!    establish y moves
      stscaly=(ylocf-yrefpt)/(ylocs-yrefpt)

        allocate (xusrt(np),yusrt(np))
        do j=1,np
          xusrt(j)=xusr(j)
          yusrt(j)=yusr(j)
          xusr(j)=xrefpt-(xrefpt-xusr(j))*stscalx
          yusr(j)=yrefpt-(yrefpt-yusr(j))*stscaly
          CORD(J,1)=(XUSR(J)+XS)/TXSCAL
          CORD(J,2)=(YUSR(J)+YS)/TXSCAL       
        enddo  
        if(ncrsec .gt. 0) then
          allocate (xcrst(nrsec),ycrst(nrsec))
          do j=1,ncrsec
            xcrst(j)=xcrs(j)
            ycrst(j)=ycrs(j)
            xcrs(j)=xrefpt-(xrefpt-xcrs(j))*stscalx
            ycrs(j)=yrefpt-(yrefpt-ycrs(j))*stscaly
          enddo
        endif

      endif

  300 continue
      CALL CLSCRN
      CALL PLOTOT(1)
      
      CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to keep '//&
                           CHAR(13)//' ','new locations?')
        !
!   If answer 'No', reset
!
      IF (WInfoDialog(4).EQ.2) then
        do j=1,np
          xusr(j)=xusrt(j)
          yusr(j)=yusrt(j)
          CORD(J,1)=(XUSR(J)+XS)/TXSCAL
          CORD(J,2)=(YUSR(J)+YS)/TXSCAL  
        enddo 
        if(ncrsec .gt. 0) then
          do j=1,ncrsec
            xcrs(j)=xcrst(j)
            ycrs(j)=ycrst(j)
          enddo
          deallocate (xcrst,ycrst)
        endif 
        CALL CLSCRN
        CALL PLOTOT(1)
      endif

      deallocate(xusrt,yusrt)    

      RETURN
  END
  
      SUBROUTINE TRANSMESH
      
	  USE WINTERACTER
      USE BLK1MOD
	  
	  SAVE
	   
!      implicit none

      include 'd.inc'

      INCLUDE 'TXFRM.COM'

      INCLUDE 'BFILES.I90'
      
      CHARACTER*1 IFLAG
      allocatable xusrt(:),yusrt(:),xcrst(:),ycrst(:)
      data iopt1/1/

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

      TYPE(WIN_MESSAGE) :: MESSAGE
      call wdialogload(IDD_TRANSFORM)
      ierr=infoerror(1)

      CALL WDialogSelect(IDD_TRANSFORM)
      ierr=infoerror(1)

      CALL WDialogPutINTEGER(IDF_INTEGER1,IOPT1)
      
      CALL WDialogPutReal(IDF_REAL3,COEF1)
      CALL WDialogPutReal(IDF_REAL4,COEF2)
      CALL WDialogPutReal(IDF_REAL5,COEF3)
      CALL WDialogPutReal(IDF_REAL6,COEF4)
      CALL WDialogPutReal(IDF_REAL7,COEF5)
      CALL WDialogPutReal(IDF_REAL8,COEF6)
      CALL WDialogPutINTEGER(IDF_INTEGER2,ICOEF1)
      CALL WDialogPutINTEGER(IDF_INTEGER3,ICOEF2)
      CALL WDialogPutINTEGER(IDF_INTEGER4,ICOEF3)
      CALL WDialogPutINTEGER(IDF_INTEGER5,ICOEF4)
      CALL WDialogPutINTEGER(IDF_INTEGER9,ICOEF5)
      CALL WDialogPutINTEGER(IDF_INTEGER10,ICOEF6)

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

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

          CALL WDialogGetINTEGER(IDF_INTEGER1,IOPT1)
          CALL WDialogGetReal(IDF_REAL3,COEF1)
          CALL WDialogGetReal(IDF_REAL4,COEF2)
          CALL WDialogGetReal(IDF_REAL5,COEF3)
          CALL WDialoggetReal(IDF_REAL6,COEF4)
          CALL WDialoggetReal(IDF_REAL7,COEF5)
          CALL WDialoggetReal(IDF_REAL8,COEF6)
          CALL WDialogGetINTEGER(IDF_INTEGER2,ICOEF1)
          CALL WDialogGetINTEGER(IDF_INTEGER3,ICOEF2)
          CALL WDialogGetINTEGER(IDF_INTEGER4,ICOEF3)
          CALL WDialogGetINTEGER(IDF_INTEGER5,ICOEF4)
          CALL WDialogGetINTEGER(IDF_INTEGER9,ICOEF5)
          CALL WDialogGetINTEGER(IDF_INTEGER10,ICOEF6)
          go to 200
        elseif(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN  
          return
        ENDIF
      
      enddo
200   continue  
      if(.not. allocated(xusrt)) then
        allocate (xusrt(np),yusrt(np))

        do j=1,np
          xusrt(j)=xusr(j)
          yusrt(j)=yusr(j)
        enddo
        if(ncrsec .gt. 0) then
          allocate (xcrst(nrsec),ycrst(nrsec))
          do j=1,ncrsec
            xcrst(j)=xcrs(j)
            ycrst(j)=ycrs(j)
          enddo
        endif
      endif
      IF(IOPT1 .EQ. 1) THEN
        DO J=1,NP
          XUSR(J)=COEF1*XUSR(J)+COEF2
          YUSR(J)=COEF3*YUSR(J)+COEF4
          CORD(J,1)=(XUSR(J)+XS)/TXSCAL
          CORD(J,2)=(YUSR(J)+YS)/TXSCAL
          IF(COEF5 .EQ. 0.  .AND.  COEF6 .EQ. 0.) CYCLE
          WD(J)=COEF5*WD(J)+COEF6
        ENDDO
        if(ncrsec .gt. 0) then
          do j=1,ncrsec
            xcrs(j)=coef1*XCRS(J)+COEF2
            ycrs(j)=coef3*YCRS(J)+COEF4
          enddo
        endif
      ELSE IF(IOPT1 .EQ. 2) THEN
        do j=1,np
          reff=coef3
          angl=(xusr(j)-coef1)/reff
          a=cos(angl)
          a=reff*cos(angl)
          b=reff*sin(angl)
          xusr(j)=reff*sin(angl)-(yusr(j)-coef2)*sin(angl)
          yusr(j)=(yusr(j)-coef2)*cos(angl)+reff*(1.-cos(angl))
          CORD(J,1)=(XUSR(J)+XS)/TXSCAL
          CORD(J,2)=(YUSR(J)+YS)/TXSCAL
        enddo
        if(ncrsec .gt. 0) then
          do j=1,ncrsec
            reff=coef3+coef2-ycrs(j)
            ang=(xcrs(j)-coef1)/reff
            xcrs(j)=coef1+reff*sin(angl)
            ycrs(j)=coef2+reff*cos(angl)
          enddo
        endif
      ELSEIF(IOPT1 .EQ. 3) THEN
        DO J=1,NP
          A=(XUSR(J)-COEF1)*COS(COEF3)-(YUSR(J)-COEF2)*SIN(COEF3)
          B=(XUSR(J)-COEF1)*SIN(COEF3)+(YUSR(J)-COEF2)*COS(COEF3)
          XUSR(J)=A
          YUSR(J)=B
          CORD(J,1)=(XUSR(J)+XS)/TXSCAL
          CORD(J,2)=(YUSR(J)+YS)/TXSCAL
        ENDDO
        if(ncrsec .gt. 0) then
          do j=1,ncrsec
            A=(XCRS(J)-COEF1)*COS(COEF3)-(YCRS(J)-COEF2)*SIN(COEF3)
            B=(XCRS(J)-COEF1)*SIN(COEF3)+(YCRS(J)-COEF2)*COS(COEF3)
            xcrs(j)=A
            ycrs(j)=B
          enddo
        endif
      ENDIF
      CALL CLSCRN
      CALL PLOTOT(1)
      
      CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to keep '//&
                           CHAR(13)//' ','new locations?')
        !
!   If answer 'No', reset
!
      IF (WInfoDialog(4).EQ.2) then
        do j=1,np
          xusr(j)=xusrt(j)
          yusr(j)=yusrt(j)
          CORD(J,1)=(XUSR(J)+XS)/TXSCAL
          CORD(J,2)=(YUSR(J)+YS)/TXSCAL 
        enddo 
        deallocate (Xusrt,yusrt)
        if(ncrsec .gt. 0) then
          do j=1,ncrsec
            xcrs(j)=xcrst(j)
            ycrs(j)=ycrst(j)
          enddo
          deallocate (xcrst,ycrst)
        endif 
        CALL CLSCRN
        CALL PLOTOT(1)
      endif
      RETURN
      END