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.
192 lines
4.3 KiB
Fortran
192 lines
4.3 KiB
Fortran
5 years ago
|
SUBROUTINE ADDTRIANG
|
||
|
|
|
||
|
|
! Subroutine to add a triangular block
|
||
|
|
|
||
|
|
USE BLK1MOD
|
||
|
|
USE BLK2MOD
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
! INCLUDE 'BLK2.COM'
|
||
|
|
|
||
|
|
INCLUDE 'TXFRM.COM'
|
||
|
|
|
||
|
|
CHARACTER*1 IFLAG
|
||
|
|
|
||
|
|
DATA N1,N2,N3/1,1,1/
|
||
|
|
|
||
|
|
! Initiliaze list etc
|
||
|
|
|
||
|
|
NHTPSV=NHTP
|
||
|
|
NMESSSV=NMESS
|
||
|
|
NBRRSV=NBRR
|
||
|
|
|
||
|
|
DO N=1,NP
|
||
|
|
LIST(N)=0
|
||
|
|
ENDDO
|
||
|
|
! Get the points that form the triangle
|
||
|
|
|
||
|
|
4 CONTINUE
|
||
|
|
NHTP=0
|
||
|
|
NMESS=8
|
||
|
|
NBRR = 3
|
||
|
|
CALL HEDR
|
||
|
|
!
|
||
|
|
! Get screen coordinates of each end of line
|
||
|
|
!
|
||
|
|
7 CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
|
||
|
|
ALX=XTEMP
|
||
|
|
ALY=YTEMP
|
||
|
|
IF(IRMAIN .EQ. 1) RETURN
|
||
|
|
!
|
||
|
|
IF(IFLAG .EQ. 'q' .OR. (IFLAG .EQ. 'c' .AND. IBOX .EQ. 10))THEN
|
||
|
|
CALL WRTOUT(0)
|
||
|
|
RETURN
|
||
|
|
elseif(iflag .eq. 'n') then
|
||
|
|
call getfpna(XTEMP)
|
||
|
|
call getfpna(YTEMP)
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
! Exit input
|
||
|
|
!
|
||
|
|
! 9 CALL PLOTT(ALX,ALY,3)
|
||
|
|
! CALL PLOTT(ALX,ALY,2)
|
||
|
|
NBRR=0
|
||
|
|
CALL HEDR
|
||
|
|
CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
|
||
|
|
ARX=XTEMP
|
||
|
|
ARY=YTEMP
|
||
|
|
if(iflag .eq. 'n') then
|
||
|
|
call getfpna(XTEMP)
|
||
|
|
call getfpna(YTEMP)
|
||
|
|
endif
|
||
|
|
IF(IRMAIN .EQ. 1) RETURN
|
||
|
|
!
|
||
|
|
! 12 CALL PLOTT(XTEMP,YTEMP,3)
|
||
|
|
CALL PLOTT(ALX,ALY,3)
|
||
|
|
CALL PLOTT(XTEMP,YTEMP,2)
|
||
|
|
CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
|
||
|
|
BRX=XTEMP
|
||
|
|
BRY=YTEMP
|
||
|
|
if(iflag .eq. 'n') then
|
||
|
|
call getfpna(XTEMP)
|
||
|
|
call getfpna(YTEMP)
|
||
|
|
endif
|
||
|
|
IF(IRMAIN .EQ. 1) RETURN
|
||
|
|
!
|
||
|
|
16 CONTINUE
|
||
|
|
! CALL PLOTT(XTEMP,YTEMP,3)
|
||
|
|
CALL PLOTT(XTEMP,YTEMP,2)
|
||
|
|
CALL PLOTT(ALX,ALY,2)
|
||
|
|
|
||
|
|
! Get the number of element information
|
||
|
|
|
||
|
|
CALL PANELTRG(N1,N2,N3)
|
||
|
|
|
||
|
|
! Get middle number
|
||
|
|
|
||
|
|
IF(N1 .GT. N2) THEN
|
||
|
|
IF(N1 .GT. N3) THEN
|
||
|
|
IF(N2 .GT. N3) THEN
|
||
|
|
NMID=N2
|
||
|
|
ELSE
|
||
|
|
NMID=N1
|
||
|
|
ENDIF
|
||
|
|
ELSE
|
||
|
|
NMID=N1
|
||
|
|
ENDIF
|
||
|
|
ELSE
|
||
|
|
IF(N2 .GT. N3) THEN
|
||
|
|
IF(N1 .GT. N3) THEN
|
||
|
|
NMID=N1
|
||
|
|
ELSE
|
||
|
|
NMID=N3
|
||
|
|
ENDIF
|
||
|
|
ELSE
|
||
|
|
NMID=N2
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
! Form the new nodes
|
||
|
|
|
||
|
|
CALL DEFNOD(ALX,ALY)
|
||
|
|
CALL DEFNOD(ARX,ARY)
|
||
|
|
CALL DEFNOD(BRX,BRY)
|
||
|
|
|
||
|
|
! Now work on sides
|
||
|
|
|
||
|
|
DO N=1,N1-1
|
||
|
|
RATIO=FLOAT(N)/FLOAT(N1)
|
||
|
|
X1=ALX+RATIO*(ARX-ALX)
|
||
|
|
Y1=ALY+RATIO*(ARY-ALY)
|
||
|
|
CALL DEFNOD(X1,Y1)
|
||
|
|
ENDDO
|
||
|
|
DO N=1,N2-1
|
||
|
|
RATIO=FLOAT(N)/FLOAT(N2)
|
||
|
|
X1=ARX+RATIO*(BRX-ARX)
|
||
|
|
Y1=ARY+RATIO*(BRY-ARY)
|
||
|
|
CALL DEFNOD(X1,Y1)
|
||
|
|
ENDDO
|
||
|
|
DO N=1,N3-1
|
||
|
|
RATIO=FLOAT(N)/FLOAT(N3)
|
||
|
|
X1=BRX+RATIO*(ALX-BRX)
|
||
|
|
Y1=BRY+RATIO*(ALY-BRY)
|
||
|
|
CALL DEFNOD(X1,Y1)
|
||
|
|
ENDDO
|
||
|
|
CALL FRMNODT(ALX,ALY,ARX,ARY,BRX,BRY,NMID)
|
||
|
|
|
||
|
|
! For triangles for the added nodes
|
||
|
|
|
||
|
|
CALL DELN2(NP,1)
|
||
|
|
|
||
|
|
NHTP=NHTPSV
|
||
|
|
NMESS=NMESSSV
|
||
|
|
NBRR=NBRRSV
|
||
|
|
|
||
|
|
CALL HEDR
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
SUBROUTINE PANELTRG(N1,N2,N3)
|
||
|
|
|
||
|
|
use winteracter
|
||
|
|
|
||
|
|
implicit none
|
||
|
|
|
||
|
|
include 'D.inc'
|
||
|
|
INCLUDE 'BFILES.I90'
|
||
|
|
|
||
|
|
!
|
||
|
|
! Declare window-type and message variables
|
||
|
|
!
|
||
|
|
TYPE(WIN_STYLE) :: WINDOW
|
||
|
|
|
||
|
|
TYPE(WIN_MESSAGE) :: MESSAGE
|
||
|
|
|
||
|
|
integer :: N1,N2,N3,IERR
|
||
|
|
! real ::
|
||
|
|
character*3 :: sub
|
||
|
|
|
||
|
|
call wdialogload(IDD_TRIANG)
|
||
|
|
ierr=infoerror(1)
|
||
|
|
|
||
|
|
CALL WDialogPutInteger(idf_integer1,n1)
|
||
|
|
CALL WDialogPutInteger(idf_integer2,n2)
|
||
|
|
CALL WDialogPutInteger(idf_integer3,n3)
|
||
|
|
|
||
|
|
|
||
|
|
CALL WDialogSelect(IDD_TRIANG)
|
||
|
|
ierr=infoerror(1)
|
||
|
|
|
||
|
|
CALL WDialogShow(-1,-1,0,Modal)
|
||
|
|
ierr=infoerror(1)
|
||
|
|
|
||
|
|
IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
|
||
|
|
CALL WDialogGetInteger(idf_integer1,n1)
|
||
|
|
CALL WDialogGetInteger(idf_integer2,n2)
|
||
|
|
CALL WDialogGetInteger(idf_integer3,n3)
|
||
|
|
|
||
|
|
|
||
|
|
ENDIF
|
||
|
|
RETURN
|
||
|
|
END
|