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.
122 lines
4.0 KiB
Fortran
122 lines
4.0 KiB
Fortran
5 years ago
|
SUBROUTINE FORMLINEL(I1D,I2D,ALXX,ALYY,ALWD,JST,JEND,JKP,XLENGTH,ITYPB,ICTT)
|
||
|
|
!
|
||
|
|
! Routine to create a form series of nodes along a line
|
||
|
|
!
|
||
|
|
USE BLK1MOD
|
||
|
|
! INCLUDE 'BLK1.COM'
|
||
|
|
|
||
|
|
INCLUDE 'TXFRM.COM'
|
||
|
|
REAL*8 ALXX(*),ALYY(*),ALWD(*)
|
||
|
|
! COMPUTE OVERALL LENGTH
|
||
|
|
|
||
|
|
TOTLEN=0.
|
||
|
|
DO J=JST,JEND-1
|
||
|
|
TOTLEN=TOTLEN+SQRT((ALXX(J+1)-ALXX(J))**2+(ALYY(J+1)-ALYY(J))**2)
|
||
|
|
ENDDO
|
||
|
|
! ESTIMATE NUMBER OF ELEMENTS
|
||
|
|
NELTS=TOTLEN*TXSCAL/XLENGTH+1
|
||
|
|
XLENGTH=TOTLEN*TXSCAL/NELTS
|
||
|
|
! GET NEW NODE LOCATIONS AND CREAT ELEMENT
|
||
|
|
|
||
|
|
IF(JKP .EQ. 0) THEN
|
||
|
|
CALL GETNOD(J)
|
||
|
|
JKP=J
|
||
|
|
!
|
||
|
|
! Store ALXX and ALYY into it
|
||
|
|
!
|
||
|
|
|
||
|
|
CORD(J,1) = ALXX(1)
|
||
|
|
CORD(J,2) = ALYY(1)
|
||
|
|
IF(ALWD(1).GT. 0.) THEN
|
||
|
|
WIDTH(J)=ALWD(1)
|
||
|
|
ENDIF
|
||
|
|
INEW(J) = 1
|
||
|
|
INSKP(J) = 0
|
||
|
|
!
|
||
|
|
XUSR(J) = ALXX(1)*TXSCAL - XS
|
||
|
|
YUSR(J) = ALYY(1)*TXSCAL - YS
|
||
|
|
!
|
||
|
|
! Display point
|
||
|
|
!
|
||
|
|
ENDIF
|
||
|
|
CALL PLTNOD(JKP,1)
|
||
|
|
JPTC=JST+1
|
||
|
|
XLENGTHR=XLENGTH/TXSCAL
|
||
|
|
XCUR=ALXX(JST)
|
||
|
|
YCUR=ALYY(JST)
|
||
|
|
DO N=1,NELTS
|
||
|
|
500 ANGLEL=ATAN2(ALYY(JPTC)-ALYY(JPTC-1),ALXX(JPTC)-ALXX(JPTC-1))
|
||
|
|
XNEXT=XCUR+XLENGTHR*COS(ANGLEL)
|
||
|
|
YNEXT=YCUR+XLENGTHR*SIN(ANGLEL)
|
||
|
|
IF(ALXX(JPTC)-ALXX(JPTC-1) .NE. 0.) THEN
|
||
|
|
FRAC=(XNEXT-ALXX(JPTC-1))/(ALXX(JPTC)-ALXX(JPTC-1))
|
||
|
|
ELSE
|
||
|
|
FRAC=(YNEXT-ALYY(JPTC-1))/(ALYY(JPTC)-ALYY(JPTC-1))
|
||
|
|
ENDIF
|
||
|
|
IF(FRAC .GT. 1. .AND. JPTC .LT. JEND) THEN
|
||
|
|
XLENGTHR=XLENGTHR-SQRT((ALXX(JPTC)-XCUR)**2+(ALYY(JPTC)-YCUR)**2)
|
||
|
|
XCUR=ALXX(JPTC)
|
||
|
|
YCUR=ALYY(JPTC)
|
||
|
|
JPTC=JPTC+1
|
||
|
|
GO TO 500
|
||
|
|
ENDIF
|
||
|
|
! GET NEW LOCATION
|
||
|
|
|
||
|
|
CALL GETNOD(J)
|
||
|
|
|
||
|
|
IF(ALWD(1).GT. 0.) THEN
|
||
|
|
WIDTH(J)=ALWD(JPTC-1)+FRAC*(ALWD(JPTC)-ALWD(JPTC-1))
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
! Store GRIDX and GRIDY into it
|
||
|
|
!
|
||
|
|
CORD(J,1) = XNEXT
|
||
|
|
CORD(J,2) = YNEXT
|
||
|
|
INEW(J) = 1
|
||
|
|
INSKP(J) = 0
|
||
|
|
!
|
||
|
|
XUSR(J) = XNEXT*TXSCAL - XS
|
||
|
|
YUSR(J) = YNEXT*TXSCAL - YS
|
||
|
|
!
|
||
|
|
! Display point
|
||
|
|
!
|
||
|
|
CALL PLTNOD(J,1)
|
||
|
|
XCUR=XNEXT
|
||
|
|
YCUR=YNEXT
|
||
|
|
XLENGTHR=XLENGTH/TXSCAL
|
||
|
|
|
||
|
|
IF(I1D .EQ. 1 .OR. I2D .EQ. 1) THEN
|
||
|
|
IF(N .EQ. 1) THEN
|
||
|
|
J1=JKP
|
||
|
|
IF(ALWD(1) .NE. 0.) GO TO 600
|
||
|
|
call nodedisp(jKP)
|
||
|
|
ENDIF
|
||
|
|
IF(ALWD(1) .NE. 0.) GO TO 600
|
||
|
|
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)
|
||
|
|
600 call getelm(k)
|
||
|
|
NOP(K,1)=J1
|
||
|
|
NOP(K,2)=0
|
||
|
|
NOP(K,3)=J
|
||
|
|
NCORN(K)=3
|
||
|
|
IMAT(K)=ITYPB
|
||
|
|
IESKP(K) = 0
|
||
|
|
NE = MAX(K,NE)
|
||
|
|
IERC=0
|
||
|
|
CALL PLTELM(K,IERC)
|
||
|
|
J1=J
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
ENDDO
|
||
|
|
JKP=J
|
||
|
|
WRITE(155,*),JST,JEND,JKP
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
|