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

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