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.
421 lines
9.4 KiB
Fortran
421 lines
9.4 KiB
Fortran
!IPK NEW ROUTINE SEP 9 2006
|
|
SUBROUTINE FORM999(ISWT9,iswtw,NELC)
|
|
!
|
|
! Generate continuity lines
|
|
!
|
|
|
|
USE WINTERACTER
|
|
USE BLK1MOD
|
|
USE BLK2MOD
|
|
include 'd.inc'
|
|
|
|
! INCLUDE 'BLK1.COM'
|
|
! INCLUDE 'BLK2.COM'
|
|
INCLUDE 'TXFRM.COM'
|
|
CHARACTER*1 IFLAG
|
|
DIMENSION DIRL(5000),IPROCES(MAXE)
|
|
!
|
|
! Declare window-type and message variables
|
|
!
|
|
TYPE(WIN_STYLE) :: WINDOW
|
|
|
|
TYPE(WIN_MESSAGE) :: MESSAGE
|
|
|
|
integer :: N1,N2,N3,IERR
|
|
|
|
DATA SPAC/10./,ieltyp/1/,ielsw/1/,iensw/0/
|
|
|
|
! DIST(N1,N2)=SQRT((CORD(N1,1)-CORD(N2,1))**2 &
|
|
! & +(CORD(N1,2)-CORD(N2,2))**2)
|
|
! PROJ(N1,N2,DR)= (CORD(N2,1)-CORD(N1,1))*COS(DR)+(CORD(N2,2)-CORD(N1,2))*SIN(DR)
|
|
!
|
|
! WRITE(150,*) 'IN FORM999',ISWT9,iswtw,NELC
|
|
! FLUSH(150)
|
|
if(iswtw .eq. 1) THEN
|
|
IFRMEL=0
|
|
IGTWEL=0
|
|
CALL ADD999(ISWT9,NELC)
|
|
RETURN
|
|
ENDIF
|
|
CALL WMessageBox(YesNo, QuestionIcon, 1,'Are 1-D elements already formed?','1-D ELEMENTS')
|
|
|
|
! If answer 'Yes' set ifrmel to 0
|
|
!
|
|
IF (WInfoDialog(4) .EQ. 2) then
|
|
IFRMEL=1
|
|
!NO
|
|
! WRITE(150,*) 'GOING TO FROM1DEL'
|
|
! FLUSH(150)
|
|
CALL FORM1DEL
|
|
! WRITE(150,*) 'BACK FROM FROM1DEL'
|
|
! FLUSH(150)
|
|
|
|
ELSE
|
|
!YES
|
|
IFRMEL=0
|
|
|
|
|
|
CALL WMessageBox(YesNo, QuestionIcon, 1,'Is width data available?','WIDTH DATA')
|
|
|
|
! If answer 'Yes' set igtwel to 0
|
|
!
|
|
IF (WInfoDialog(4) .EQ. 2) then
|
|
!NO
|
|
IGTWEL=1
|
|
CALL SETWID
|
|
! WRITE(150,*) 'BACK FROM SETWID'
|
|
! FLUSH(150)
|
|
ELSE
|
|
!YES
|
|
IGTWEL=0
|
|
! CALL CCLINE(2)
|
|
! WRITE(150,*) 'GOING TO ADD999'
|
|
! FLUSH(150)
|
|
CALL ADD999(ISWT9,NELC)
|
|
! WRITE(150,*) 'BACK FROM ADD999'
|
|
! FLUSH(150)
|
|
CALL HEDR
|
|
RETURN
|
|
ENDIF
|
|
|
|
100 CONTINUE
|
|
|
|
ENDIF
|
|
|
|
! GET NODAL CONNECTIONS
|
|
! WRITE(150,*) 'ABOUT TO GO TO NDNECON'
|
|
! FLUSH(150)
|
|
IERR=0
|
|
CALL NDNECON(IERR)
|
|
|
|
! START ALONG LINE OF ELEMENTS
|
|
|
|
DO N=1,NTRAC
|
|
|
|
N1=ITRAC(N)
|
|
IF(N .GT. 1) THEN
|
|
N0=ITRAC(N-1)
|
|
ENDIF
|
|
IF(N .LT. NTRAC) THEN
|
|
N2=ITRAC(N+1)
|
|
ENDIF
|
|
|
|
! Get direction
|
|
|
|
IF(N .EQ. 1) THEN
|
|
DIRX=XUSR(N2)-XUSR(N1)
|
|
DIRY=YUSR(N2)-YUSR(N1)
|
|
DIRL(N)=ATAN2(DIRX,-DIRY)
|
|
ELSEIF(N .EQ. NTRAC) THEN
|
|
DIRX=XUSR(N1)-XUSR(N0)
|
|
DIRY=YUSR(N1)-YUSR(N0)
|
|
DIRL(N)=ATAN2(DIRX,-DIRY)
|
|
ELSE
|
|
DIRX=XUSR(N2)-XUSR(N0)
|
|
DIRY=YUSR(N2)-YUSR(N0)
|
|
DIRL(N)=ATAN2(DIRX,-DIRY)
|
|
ENDIF
|
|
ENDDO
|
|
|
|
! Move nodes apart adding new numbers
|
|
|
|
DO N=1,NTRAC
|
|
! WRITE(150,*) 'STARTING NTRAC ITRAC',N,ITRAC(N)
|
|
N1=ITRAC(N)
|
|
CALL GETNOD(J)
|
|
JTRAC(N)=J
|
|
! XUSR(J)=XUSR(N1)-WIDTHD(N1)/2.*COS(DIRL(N))
|
|
! YUSR(J)=YUSR(N1)-WIDTHD(N1)/2.*SIN(DIRL(N))
|
|
XUSR(J)=XUSR(N1)-WIDTH(N1)/2.*COS(DIRL(N))
|
|
YUSR(J)=YUSR(N1)-WIDTH(N1)/2.*SIN(DIRL(N))
|
|
CORD(J,1)=(XUSR(J)+XS)/TXSCAL
|
|
CORD(J,2)=(YUSR(J)+YS)/TXSCAL
|
|
INEW(J)=1
|
|
INSKP(J) = 0
|
|
WD(J)=-9999.
|
|
WIDTH(J)=0.
|
|
SS1(J)=0.
|
|
SS2(J)=0.
|
|
WIDS(J)=0.
|
|
WIDBS(J)=0.
|
|
SSO(J)=0.
|
|
|
|
CALL GETNOD(J1)
|
|
KTRAC(N)=J1
|
|
! XUSR(J1)=XUSR(N1)+WIDTHD(N1)/2.*COS(DIRL(N))
|
|
! YUSR(J1)=YUSR(N1)+WIDTHD(N1)/2.*SIN(DIRL(N))
|
|
XUSR(J1)=XUSR(N1)+WIDTH(N1)/2.*COS(DIRL(N))
|
|
YUSR(J1)=YUSR(N1)+WIDTH(N1)/2.*SIN(DIRL(N))
|
|
CORD(J1,1)=(XUSR(J1)+XS)/TXSCAL
|
|
CORD(J1,2)=(YUSR(J1)+YS)/TXSCAL
|
|
INEW(J1)=1
|
|
INSKP(J1) = 0
|
|
WD(J1)=-9999.
|
|
WIDTH(J1)=0.
|
|
SS1(J1)=0.
|
|
SS2(J1)=0.
|
|
WIDS(J1)=0.
|
|
WIDBS(J1)=0.
|
|
SSO(J1)=0.
|
|
ENDDO
|
|
DO N=1,NTRAC-1
|
|
CALL GETELM(J)
|
|
NOP(J,1)=ITRAC(N+1)
|
|
NOP(J,3)=ITRAC(N)
|
|
NOP(J,5)=JTRAC(N)
|
|
NOP(J,7)=JTRAC(N+1)
|
|
NOP(J,2)=0
|
|
NOP(J,4)=0
|
|
NOP(J,6)=0
|
|
NOP(J,8)=0
|
|
IMAT(J)=999
|
|
NCORN(J) = 8
|
|
IESKP(J) = 0
|
|
CALL GETELM(J)
|
|
NOP(J,1)=ITRAC(N)
|
|
NOP(J,3)=ITRAC(N+1)
|
|
NOP(J,5)=KTRAC(N+1)
|
|
NOP(J,7)=KTRAC(N)
|
|
NOP(J,2)=0
|
|
NOP(J,4)=0
|
|
NOP(J,6)=0
|
|
NOP(J,8)=0
|
|
IMAT(J)=999
|
|
NCORN(J) = 8
|
|
IESKP(J) = 0
|
|
NE = MAX(J,NE)
|
|
ENDDO
|
|
NE = MAX(J,NE)
|
|
|
|
|
|
RETURN
|
|
END
|
|
|
|
SUBROUTINE FORM1DEL
|
|
|
|
USE WINTERACTER
|
|
USE BLK1MOD
|
|
USE BLK2MOD
|
|
include 'd.inc'
|
|
|
|
! INCLUDE 'BLK1.COM'
|
|
! INCLUDE 'BLK2.COM'
|
|
INCLUDE 'TXFRM.COM'
|
|
CHARACTER*1 IFLAG
|
|
!
|
|
! Declare window-type and message variables
|
|
!
|
|
TYPE(WIN_STYLE) :: WINDOW
|
|
|
|
TYPE(WIN_MESSAGE) :: MESSAGE
|
|
|
|
integer :: N1,N2,N3,IERR
|
|
|
|
CALL WMessageBox(YesNo, QuestionIcon, 1,'Are 1-D nodes already defined?','FORM 1-D ELEMENTS')
|
|
|
|
! If answer 'Yes' set ifrmel to 0
|
|
!
|
|
IF (WInfoDialog(4) .ne. 2) then
|
|
|
|
! yes
|
|
CALL FRMEL(1)
|
|
ELSE
|
|
! no
|
|
CALL WMessageBox(YesNo, QuestionIcon, 1,'Use same width etc properties ?','FORM 1-D ELEMENTS')
|
|
|
|
! If answer 'Yes' set IGWID=1
|
|
!
|
|
IF (WInfoDialog(4) .ne. 2) then
|
|
|
|
! yes
|
|
IGWID=1
|
|
ELSE
|
|
IGWID=0
|
|
! no
|
|
ENDIF
|
|
|
|
CALL WMessageBox(OKCancel, 4, 1,'Click on each node to form elements?'//CHAR(13)// &
|
|
'Then click quit to continue','FORM 1-D ELEMENTS')
|
|
JREF=0
|
|
NTRAC=0
|
|
NHTP=0
|
|
NBRR=3
|
|
NMESS=15
|
|
CALL HEDR
|
|
|
|
100 CONTINUE
|
|
CALL XYLOC(XX,YY,IFLAG,IBOX)
|
|
IF(IRMAIN .EQ. 1) RETURN
|
|
IF(IFLAG .EQ. 'q' .OR. (IFLAG .EQ. 'c' .AND. IBOX .EQ. 10))THEN
|
|
GO TO 200
|
|
ENDIF
|
|
!
|
|
IF (IFLAG .EQ. 'c') THEN
|
|
!
|
|
call getnod(j)
|
|
NTRAC=NTRAC+1
|
|
ITRAC(NTRAC)=J
|
|
INSKP(J)=0
|
|
CORD(J,1) = XX
|
|
CORD(J,2) = YY
|
|
INEW(J) = 1
|
|
!
|
|
XUSR(J) = XX*TXSCAL - XS
|
|
YUSR(J) = YY*TXSCAL - YS
|
|
IF (J .GT. NP) NP = J
|
|
call pltnod(j,1)
|
|
IF(JREF .EQ.0) THEN
|
|
WIDTH(J)=50.
|
|
call nodedisp(j)
|
|
ELSE
|
|
WIDTH(J)=WIDTH(J1)
|
|
WD(J)=WD(J1)
|
|
SS1(J)=SS1(J1)
|
|
SS2(J)=SS2(J1)
|
|
WIDS(J)=WIDS(J1)
|
|
WIDBS(J)=WIDBS(J1)
|
|
SSO(J)=SSO(J1)
|
|
BS1(J)=BS1(J1)
|
|
IF(IGWID .EQ. 0) THEN
|
|
call nodedisp(j)
|
|
ENDIF
|
|
CALL PLTNOD(J,0)
|
|
call getelm(k)
|
|
NOP(K,1)=J1
|
|
NOP(K,2)=0
|
|
NOP(K,3)=J
|
|
NCORN(K)=3
|
|
IMAT(K)=1
|
|
IESKP(K) = 0
|
|
NE = MAX(K,NE)
|
|
IERC=0
|
|
CALL PLTELM(K,IERC)
|
|
|
|
ENDIF
|
|
J1=J
|
|
JREF=1
|
|
GO TO 100
|
|
ENDIF
|
|
ENDIF
|
|
|
|
200 CONTINUE
|
|
call clscrn
|
|
CALL PLOTOT(1)
|
|
NHTP=1
|
|
NMESS=0
|
|
NBRR=0
|
|
CALL HEDR
|
|
RETURN
|
|
END
|
|
|
|
SUBROUTINE SETWID
|
|
|
|
CALL FRMEL(0)
|
|
RETURN
|
|
END
|
|
|
|
SUBROUTINE FRMEL(ISW)
|
|
|
|
USE WINTERACTER
|
|
USE BLK1MOD
|
|
USE BLK2MOD
|
|
include 'd.inc'
|
|
|
|
! INCLUDE 'BLK1.COM'
|
|
! INCLUDE 'BLK2.COM'
|
|
INCLUDE 'TXFRM.COM'
|
|
CHARACTER*1 IFLAG
|
|
!
|
|
! Declare window-type and message variables
|
|
!
|
|
TYPE(WIN_STYLE) :: WINDOW
|
|
|
|
TYPE(WIN_MESSAGE) :: MESSAGE
|
|
|
|
integer :: N1,N2,N3,IERR
|
|
|
|
NHTP=0
|
|
NBRR=3
|
|
NMESS=15
|
|
CALL HEDR
|
|
|
|
IF(ISW .EQ. 1) THEN
|
|
CALL WMessageBox(YesNo, QuestionIcon, 1,'Is width data available?','WIDTH DATA')
|
|
|
|
! If answer 'Yes' set igtwel to 0
|
|
!
|
|
IF (WInfoDialog(4) .EQ. 2) then
|
|
!NO
|
|
IGTWEL=1
|
|
ELSE
|
|
!YES
|
|
IGTWEL=0
|
|
ENDIF
|
|
ELSE
|
|
|
|
IGTWEL=1
|
|
ENDIF
|
|
|
|
IF(IGTWEL .EQ. 1) THEN
|
|
CALL WMessageBox(YesNo, QuestionIcon, 1,'Use same width etc properties ?','FORM 1-D ELEMENTS')
|
|
|
|
! If answer 'Yes' set IGWID=1
|
|
!
|
|
IF (WInfoDialog(4) .ne. 2) then
|
|
|
|
! yes
|
|
IGWID=1
|
|
ELSE
|
|
IGWID=0
|
|
! no
|
|
ENDIF
|
|
ENDIF
|
|
NTRAC=0
|
|
100 CONTINUE
|
|
CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,J,IFLAG,INSKP,IBOX)
|
|
IF(IRMAIN .EQ. 1) RETURN
|
|
IF(IFLAG .EQ. 'q' .OR. (IFLAG .EQ. 'c' .AND. IBOX .EQ. 10))THEN
|
|
GO TO 200
|
|
ENDIF
|
|
!
|
|
IF (IFLAG .EQ. 'c') THEN
|
|
!
|
|
IF(IGTWEL .EQ. 1) THEN
|
|
IF(NTRAC .EQ. 0) THEN
|
|
call nodedisp(j)
|
|
ELSE
|
|
WIDTH(J)=WIDTH(J1)
|
|
WD(J)=WD(J1)
|
|
SS1(J)=SS1(J1)
|
|
SS2(J)=SS2(J1)
|
|
WIDS(J)=WIDS(J1)
|
|
WIDBS(J)=WIDBS(J1)
|
|
SSO(J)=SSO(J1)
|
|
BS1(J)=BS1(J1)
|
|
IF(IGWID .EQ. 0) THEN
|
|
call nodedisp(j)
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
CALL PLTNOD(J,0)
|
|
! IF(ISW .EQ. 1) THEN
|
|
if(ntrac .ne. 0) then
|
|
call getelm(k)
|
|
NOP(K,1)=J1
|
|
NOP(K,2)=0
|
|
NOP(K,3)=J
|
|
NCORN(K)=3
|
|
IMAT(K)=1
|
|
IESKP(K) = 0
|
|
NE = MAX(K,NE)
|
|
IERC=0
|
|
CALL PLTELM(K,IERC)
|
|
ENDIF
|
|
J1=J
|
|
NTRAC=NTRAC+1
|
|
ITRAC(NTRAC)=J
|
|
GO TO 100
|
|
ENDIF
|
|
200 CONTINUE
|
|
RETURN
|
|
END |