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.

426 lines
13 KiB
Fortran

Subroutine EltDisp(nsw)
USE WINTERACTER
USE BLK1MOD
!
include 'd.inc'
! INCLUDE 'BLK1.COM'
INCLUDE 'TXFRM.COM'
!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
!
!
! Declare window-type and message variables
!
TYPE(WIN_STYLE) :: WINDOW
TYPE(WIN_MESSAGE) :: MESSAGE
INTEGER :: N,IBOX,NN,NOOP(16),NEAC(8)
INTEGER :: IERR
CHARACTER*1 :: IFLAG
DATA N/1/
ims=0
100 continue
call wdialogload(IDD_ELTDATA)
ierr=infoerror(1)
IF(NSW .NE. 0) N=ABS(NSW)
CALL WDialogPutInteger(IDF_INTEGER1,N)
NN=N
DO N1=1,8
NOOP(N1)=NOP(N,N1)
NOOP(N1+8)=NOP(N,N1)
ENDDO
IMAAT=IMAT(N)
120 CONTINUE
CALL WDialogPutInteger(IDF_INTEGER1,N)
CALL WDialogPutInteger(IDF_INTEGER2,NOOP(1))
CALL WDialogPutInteger(IDF_INTEGER3,NOOP(2))
CALL WDialogPutInteger(IDF_INTEGER4,NOOP(3))
CALL WDialogPutInteger(IDF_INTEGER5,NOOP(4))
CALL WDialogPutInteger(IDF_INTEGER6,NOOP(5))
CALL WDialogPutInteger(IDF_INTEGER7,NOOP(6))
CALL WDialogPutInteger(IDF_INTEGER8,NOOP(7))
CALL WDialogPutInteger(IDF_INTEGER9,NOOP(8))
CALL WDialogPutInteger(IDF_INTEGER10,IMAAT)
CALL WDialogSelect(IDD_ELTDATA)
ierr=infoerror(1)
CALL WDialogShow(-1,-1,0,Modeless)
ierr=infoerror(1)
if(ims .eq. 1) go to 200
150 CONTINUE
IF(NSW .LE. 0) THEN
call wdialogload(IDD_SELELT)
ierr=infoerror(1)
CALL WDialogPutInteger(IDF_INTEGER1,N)
CALL WDialogSelect(IDD_SELELT)
ierr=infoerror(1)
CALL WDialogShow(-1,-1,0,ModaL)
ierr=infoerror(1)
do
IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
CALL WDialogGetInteger(IDF_INTEGER1,N)
ims=1
go to 100
endif
!ipksep02
ims=1
go to 100
enddo
ELSE
call wdialogload(IDD_ELTERR)
ierr=infoerror(1)
CALL WDialogPutInteger(IDF_INTEGER1,N)
CALL WDialogSelect(IDD_ELTERR)
ierr=infoerror(1)
CALL WDialogShow(-1,-1,0,ModaL)
ierr=infoerror(1)
do
IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
CALL WDialogGetInteger(IDF_INTEGER1,N)
ims=1
go to 100
endif
!ipk sep02
ims=1
go to 100
enddo
ENDIF
200 continue
DO
CALL WMessage(ITYPE,MESSAGE)
SELECT CASE (ITYPE)
CASE (PushButton)
IF(MESSAGE%VALUE1.EQ.IDOK) THEN
CALL WDialogGetInteger(IDF_INTEGER1,N)
CALL WDialogGetInteger(IDF_INTEGER2,NOOP(1))
CALL WDialogGetInteger(IDF_INTEGER3,NOOP(2))
CALL WDialogGetInteger(IDF_INTEGER4,NOOP(3))
CALL WDialogGetInteger(IDF_INTEGER5,NOOP(4))
CALL WDialogGetInteger(IDF_INTEGER6,NOOP(5))
CALL WDialogGetInteger(IDF_INTEGER7,NOOP(6))
CALL WDialogGetInteger(IDF_INTEGER8,NOOP(7))
CALL WDialogGetInteger(IDF_INTEGER9,NOOP(8))
CALL WDialogGetInteger(IDF_INTEGER10,IMAAT)
ISUM=0
DO N1=1,8
NOP(N,N1)=NOOP(N1)
ISUM=ISUM+NOOP(N1)
ENDDO
IMAT(N)=IMAAT
IF(ISUM .EQ. 0) THEN
XC(N)=VOID
YC(N)=VOID
IF(N .LT. NELAST) NELAST=N
IESKP(N)=1
NCORN(N)=0
IMAT(N)=0
ENDIF
call WDialogHide()
call wdialogUNload()
RETURN
ELSEIF(MESSAGE%VALUE1.EQ.IDNEXT) THEN
CALL WDialogGetInteger(IDF_INTEGER1,N)
CALL WDialogGetInteger(IDF_INTEGER2,NOOP(1))
CALL WDialogGetInteger(IDF_INTEGER3,NOOP(2))
CALL WDialogGetInteger(IDF_INTEGER4,NOOP(3))
CALL WDialogGetInteger(IDF_INTEGER5,NOOP(4))
CALL WDialogGetInteger(IDF_INTEGER6,NOOP(5))
CALL WDialogGetInteger(IDF_INTEGER7,NOOP(6))
CALL WDialogGetInteger(IDF_INTEGER8,NOOP(7))
CALL WDialogGetInteger(IDF_INTEGER9,NOOP(8))
CALL WDialogGetInteger(IDF_INTEGER10,IMAAT)
ISUM=0
DO N1=1,8
NOP(N,N1)=NOOP(N1)
ISUM=ISUM+NOOP(N1)
ENDDO
IMAT(N)=IMAAT
IF(ISUM .EQ. 0) THEN
XC(N)=VOID
YC(N)=VOID
IF(N .LT. NELAST) NELAST=N
IESKP(N)=1
NCORN(N)=0
IMAT(N)=0
ENDIF
GO TO 150
ELSEIF(MESSAGE%VALUE1.EQ.IDF_delete) THEN
CALL WDialogGetInteger(IDF_INTEGER1,N)
CALL DELTEL(N)
call WDialogHide()
call wdialogUNload()
RETURN
ELSEIF(MESSAGE%VALUE1.EQ.IDCANCEL) THEN
call WDialogHide()
call wdialogUNload()
RETURN
ELSEIF(MESSAGE%VALUE1.EQ.IDFROTATE) THEN
call WDialogHide()
call wdialogUNload()
call plotot(1)
CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select starting node','CHOOSE NODE')
IBOX=1
DO K=1,8
NEAC(K)=NOP(N,K)
ENDDO
CALL PROXEL(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX,NEAC)
DO K=1,NCORN(N)
IF(NOOP(K) .EQ. INODE) THEN
LL=K-1
DO L=1,NCORN(N)
LL=LL+1
IF(NCORN(N) .EQ. 6 .AND. LL .EQ. 7) LL=LL+2
NOOP(L)=NOOP(LL)
ENDDO
IF(NCORN(N) .EQ. 6) THEN
NOOP(7)=0
NOOP(8)=0
ENDIF
call wdialogload(IDD_ELTDATA)
GO TO 120
ENDIF
enddo
CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Selected node not within element','CHOOSE NODE')
call wdialogload(IDD_ELTDATA)
GO TO 120
ENDIF
END SELECT
END DO
RETURN
END
SUBROUTINE GETELMNO
USE BLK1MOD
! INCLUDE 'BLK1.COM'
CHARACTER*1 IFLAG
CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select element','CHOOSE ELEMENT')
IBOX=1
CALL PROX(XC,YC,NE,XX,YY,IELEM,IFLAG,IESKP,IBOX)
INEG=-IELEM
CALL ELTDISP1(INEG)
RETURN
END
Subroutine EltDisp1(nsw)
USE WINTERACTER
USE BLK1MOD
!
include 'd.inc'
! INCLUDE 'BLK1.COM'
INCLUDE 'TXFRM.COM'
!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
!
!
! Declare window-type and message variables
!
TYPE(WIN_STYLE) :: WINDOW
TYPE(WIN_MESSAGE) :: MESSAGE
INTEGER :: N,IBOX,NN,NOOP(16),NEAC(8)
INTEGER :: IERR
CHARACTER*1 :: IFLAG
DATA N/1/
ims=0
100 continue
call wdialogload(IDD_ELTDATA)
ierr=infoerror(1)
IF(NSW .NE. 0) N=ABS(NSW)
CALL WDialogPutInteger(IDF_INTEGER1,N)
NN=N
DO N1=1,8
NOOP(N1)=NOP(N,N1)
NOOP(N1+8)=NOP(N,N1)
ENDDO
IMAAT=IMAT(N)
120 CONTINUE
CALL WDialogPutInteger(IDF_INTEGER1,N)
CALL WDialogPutInteger(IDF_INTEGER2,NOOP(1))
CALL WDialogPutInteger(IDF_INTEGER3,NOOP(2))
CALL WDialogPutInteger(IDF_INTEGER4,NOOP(3))
CALL WDialogPutInteger(IDF_INTEGER5,NOOP(4))
CALL WDialogPutInteger(IDF_INTEGER6,NOOP(5))
CALL WDialogPutInteger(IDF_INTEGER7,NOOP(6))
CALL WDialogPutInteger(IDF_INTEGER8,NOOP(7))
CALL WDialogPutInteger(IDF_INTEGER9,NOOP(8))
CALL WDialogPutInteger(IDF_INTEGER10,IMAAT)
CALL WDialogSelect(IDD_ELTDATA)
ierr=infoerror(1)
CALL WDialogShow(-1,-1,0,Modal)
ierr=infoerror(1)
150 CONTINUE
DO
! Branch depending on type of message.
!
IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
CALL WDialogGetInteger(IDF_INTEGER1,N)
CALL WDialogGetInteger(IDF_INTEGER2,NOOP(1))
CALL WDialogGetInteger(IDF_INTEGER3,NOOP(2))
CALL WDialogGetInteger(IDF_INTEGER4,NOOP(3))
CALL WDialogGetInteger(IDF_INTEGER5,NOOP(4))
CALL WDialogGetInteger(IDF_INTEGER6,NOOP(5))
CALL WDialogGetInteger(IDF_INTEGER7,NOOP(6))
CALL WDialogGetInteger(IDF_INTEGER8,NOOP(7))
CALL WDialogGetInteger(IDF_INTEGER9,NOOP(8))
CALL WDialogGetInteger(IDF_INTEGER10,IMAAT)
ISUM=0
DO N1=1,8
NOP(N,N1)=NOOP(N1)
ISUM=ISUM+NOOP(N1)
ENDDO
IMAT(N)=IMAAT
IF(ISUM .EQ. 0) THEN
XC(N)=VOID
YC(N)=VOID
IF(N .LT. NELAST) NELAST=N
IESKP(N)=1
NCORN(N)=0
IMAT(N)=0
ENDIF
CALL HEDR
RETURN
ELSEIF (WInfoDialog(ExitButton) .EQ. IDNEXT) THEN
CALL WDialogGetInteger(IDF_INTEGER1,N)
CALL WDialogGetInteger(IDF_INTEGER2,NOOP(1))
CALL WDialogGetInteger(IDF_INTEGER3,NOOP(2))
CALL WDialogGetInteger(IDF_INTEGER4,NOOP(3))
CALL WDialogGetInteger(IDF_INTEGER5,NOOP(4))
CALL WDialogGetInteger(IDF_INTEGER6,NOOP(5))
CALL WDialogGetInteger(IDF_INTEGER7,NOOP(6))
CALL WDialogGetInteger(IDF_INTEGER8,NOOP(7))
CALL WDialogGetInteger(IDF_INTEGER9,NOOP(8))
CALL WDialogGetInteger(IDF_INTEGER10,IMAAT)
ISUM=0
DO N1=1,8
NOP(N,N1)=NOOP(N1)
ISUM=ISUM+NOOP(N1)
ENDDO
IMAT(N)=IMAAT
IF(ISUM .EQ. 0) THEN
XC(N)=VOID
YC(N)=VOID
IF(N .LT. NELAST) NELAST=N
IESKP(N)=1
NCORN(N)=0
IMAT(N)=0
ENDIF
GO TO 150
ELSEIF (WInfoDialog(ExitButton) .EQ. IDF_DELETE) THEN
CALL WDialogGetInteger(IDF_INTEGER1,N)
CALL DELTEL(N)
RETURN
ELSEIF (WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
RETURN
ELSEIF (WInfoDialog(ExitButton) .EQ. IDFROTATE) THEN
call plotot(1)
CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select starting node','CHOOSE NODE')
IBOX=1
DO K=1,8
NEAC(K)=NOP(N,K)
ENDDO
CALL PROXEL(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX,NEAC)
DO K=1,NCORN(N)
IF(NOOP(K) .EQ. INODE) THEN
LL=K-1
DO L=1,NCORN(N)
LL=LL+1
IF(NCORN(N) .EQ. 6 .AND. LL .EQ. 7) LL=LL+2
NOOP(L)=NOOP(LL)
ENDDO
IF(NCORN(N) .EQ. 6) THEN
NOOP(7)=0
NOOP(8)=0
ENDIF
call wdialogload(IDD_ELTDATA)
GO TO 120
ENDIF
enddo
CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Selected node not within element','CHOOSE NODE')
call wdialogload(IDD_ELTDATA)
GO TO 120
ENDIF
END DO
RETURN
END
Subroutine EltERRDisp(nsw,ims)
USE WINTERACTER
USE BLK1MOD
!
include 'd.inc'
! INCLUDE 'BLK1.COM'
INCLUDE 'TXFRM.COM'
!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
!
!
! Declare window-type and message variables
!
TYPE(WIN_STYLE) :: WINDOW
TYPE(WIN_MESSAGE) :: MESSAGE
INTEGER :: NSW,IBOX,NN,NOOP(16)
INTEGER :: IERR
CHARACTER*1 :: IFLAG
DATA N/1/
ims=0
100 continue
call wdialogload(IDD_ELTERR2)
ierr=infoerror(1)
CALL WDialogPutInteger(IDF_INTEGER1,NSW)
CALL WDialogSelect(IDD_ELTERR)
ierr=infoerror(1)
CALL WDialogShow(-1,-1,0,ModaL)
ierr=infoerror(1)
do
IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
CALL WDialogGetInteger(IDF_INTEGER1,NSW)
ims=1
return
else
ims=0
return
endif
enddo
return
end