You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
386 lines
10 KiB
Fortran
386 lines
10 KiB
Fortran
5 years ago
|
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
|