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.
265 lines
8.6 KiB
Fortran
265 lines
8.6 KiB
Fortran
5 years ago
|
SUBROUTINE FORMLINEL(I1D,I2D,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'
|
||
|
|
! COMPUTE OVERALL LENGTH
|
||
|
|
REAL*8 XNEXT,YNEXT,FRAC,XCUR,YCUR,ZNEXT(3),ZCUR(3)
|
||
|
|
REAL*8 EMB
|
||
|
|
EMB=5.
|
||
|
|
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
|
||
|
|
if(ictt .ne. 0) then
|
||
|
|
nelts=nelts+2
|
||
|
|
if(ictt .eq. 1) then
|
||
|
|
XLENGTH=TOTLEN*TXSCAL/(NELTS-2)
|
||
|
|
else
|
||
|
|
XLENGTH=(TOTLEN*TXSCAL-EMB*2)/(NELTS-2)
|
||
|
|
ENDIF
|
||
|
|
ELSE
|
||
|
|
XLENGTH=TOTLEN*TXSCAL/NELTS
|
||
|
|
ENDIF
|
||
|
|
! GET NEW NODE LOCATIONS AND CREAT ELEMENT
|
||
|
|
! JFIST=0
|
||
|
|
IF(JKP .EQ. 0) THEN
|
||
|
|
! JFIST=1
|
||
|
|
CALL GETNOD(J)
|
||
|
|
JKP=J
|
||
|
|
!
|
||
|
|
! Store ALXX and ALYY into it
|
||
|
|
!
|
||
|
|
|
||
|
|
CORD(J,1) = ALXX(1)
|
||
|
|
CORD(J,2) = ALYY(1)
|
||
|
|
WD(J)=HMID(J)
|
||
|
|
HSET(J,1)=HLEFT(1)
|
||
|
|
HSET(J,2)=HMID(1)
|
||
|
|
HSET(J,3)=HRIGHT(1)
|
||
|
|
IF(ALWD(1).GT. 0.) THEN
|
||
|
|
WIDTHD(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
|
||
|
|
IF(NELTS .EQ. 1) THEN
|
||
|
|
XNEXT=ALXX(JEND)
|
||
|
|
YNEXT=ALYY(JEND)
|
||
|
|
if(ictt .eq. 0) then
|
||
|
|
ZNEXT(1)=HLEFT(JEND)
|
||
|
|
ZNEXT(2)=HMID(JEND)
|
||
|
|
ZNEXT(3)=HRIGHT(JEND)
|
||
|
|
else
|
||
|
|
ZNEXT(1)=HLEFT(JST)
|
||
|
|
ZNEXT(2)=HMID(JST)
|
||
|
|
ZNEXT(3)=HRIGHT(JST)
|
||
|
|
endif
|
||
|
|
CALL GETNOD(J)
|
||
|
|
|
||
|
|
IF(ALWD(J).GT. 0.) THEN
|
||
|
|
WIDTHD(J)=ALWD(JEND)
|
||
|
|
ENDIF
|
||
|
|
ELSEIF(N .EQ. 1 .AND. ICTT .NE. 0) THEN
|
||
|
|
IF(ICTT .EQ. 1) THEN
|
||
|
|
XNEXT=XCUR
|
||
|
|
YNEXT=YCUR
|
||
|
|
ZCUR(1)=HLEFT(JST)
|
||
|
|
ZCUR(2)=HMID(JST)
|
||
|
|
ZCUR(3)=HRIGHT(JST)
|
||
|
|
ZNEXT(1)=HLEFT(JST)
|
||
|
|
ZNEXT(2)=HMID(JST)
|
||
|
|
ZNEXT(3)=HRIGHT(JST)
|
||
|
|
ELSE
|
||
|
|
ANGLEL=ATAN2(ALYY(JPTC)-ALYY(JPTC-1),ALXX(JPTC)-ALXX(JPTC-1))
|
||
|
|
XNEXT=XCUR+EMB/TXSCAL*COS(ANGLEL)
|
||
|
|
YNEXT=YCUR+EMB/TXSCAL*SIN(ANGLEL)
|
||
|
|
ZCUR(1)=HLEFT(JST)
|
||
|
|
ZCUR(2)=HMID(JST)
|
||
|
|
ZCUR(3)=HRIGHT(JST)
|
||
|
|
ENDIF
|
||
|
|
CALL GETNOD(J)
|
||
|
|
IF(ALWD(J).GT. 0.) THEN
|
||
|
|
WIDTHD(J)=ALWD(JST)
|
||
|
|
ENDIF
|
||
|
|
! ELSEIF(N .EQ. 1 .AND. ICTT .EQ. 0) THEN
|
||
|
|
! ANGLEL=ATAN2(ALYY(JPTC)-ALYY(JPTC-1),ALXX(JPTC)-ALXX(JPTC-1))
|
||
|
|
! XNEXT=XCUR+EMB/TXSCAL*COS(ANGLEL)
|
||
|
|
! YNEXT=YCUR+EMB/TXSCAL*SIN(ANGLEL)
|
||
|
|
! ZCUR(1)=HLEFT(JST+1)
|
||
|
|
! ZCUR(2)=HMID(JST+1)
|
||
|
|
! ZCUR(3)=HRIGHT(JST+1)
|
||
|
|
! CALL GETNOD(J)
|
||
|
|
! IF(ALWD(J).GT. 0.) THEN
|
||
|
|
! WIDTHD(J)=ALWD(JST+1)
|
||
|
|
! ENDIF
|
||
|
|
ELSEIF(N .EQ. NELTS .AND. ICTT .NE. 0) THEN
|
||
|
|
IF(ICTT .EQ. 1) THEN
|
||
|
|
XNEXT=ALXX(JEND)
|
||
|
|
YNEXT=ALYY(JEND)
|
||
|
|
ZCUR(1)=HLEFT(JEND)
|
||
|
|
ZCUR(2)=HMID(JEND)
|
||
|
|
ZCUR(3)=HRIGHT(JEND)
|
||
|
|
ZNEXT(1)=ZCUR(1)
|
||
|
|
ZNEXT(2)=ZCUR(2)
|
||
|
|
ZNEXT(3)=ZCUR(3)
|
||
|
|
ELSE
|
||
|
|
XNEXT=ALXX(JEND)
|
||
|
|
YNEXT=ALYY(JEND)
|
||
|
|
ZCUR(1)=HLEFT(JEND)
|
||
|
|
ZCUR(2)=HMID(JEND)
|
||
|
|
ZCUR(3)=HRIGHT(JEND)
|
||
|
|
ENDIF
|
||
|
|
CALL GETNOD(J)
|
||
|
|
IF(ALWD(J).GT. 0.) THEN
|
||
|
|
WIDTHD(J)=ALWD(JST)
|
||
|
|
ENDIF
|
||
|
|
ELSE
|
||
|
|
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))
|
||
|
|
ELSEIF(ALYY(JPTC)-ALYY(JPTC-1) .NE. 0.) THEN
|
||
|
|
FRAC=(YNEXT-ALYY(JPTC-1))/(ALYY(JPTC)-ALYY(JPTC-1))
|
||
|
|
ELSE
|
||
|
|
FRAC=1.5
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
IF(FRAC .GT. 1.00001 .AND. JPTC .LT. JEND) THEN
|
||
|
|
XLENGTHR=XLENGTHR-SQRT((ALXX(JPTC)-XCUR)**2+(ALYY(JPTC)-YCUR)**2)
|
||
|
|
XCUR=ALXX(JPTC)
|
||
|
|
YCUR=ALYY(JPTC)
|
||
|
|
ZCUR(1)=HLEFT(JPTC)
|
||
|
|
ZCUR(2)=HMID(JPTC)
|
||
|
|
ZCUR(3)=HRIGHT(JPTC)
|
||
|
|
JPTC=JPTC+1
|
||
|
|
GO TO 500
|
||
|
|
ENDIF
|
||
|
|
if(n .eq. nelts .and. ictt .eq. 0) then
|
||
|
|
ZNEXT(1)=HLEFT(JPTC-1)
|
||
|
|
ZNEXT(2)=HMID(JPTC-1)
|
||
|
|
ZNEXT(3)=HRIGHT(JPTC-1)
|
||
|
|
else
|
||
|
|
ZNEXT(1)=HLEFT(JPTC-1)+FRAC*(HLEFT(JPTC)-HLEFT(JPTC-1))
|
||
|
|
ZNEXT(2)=HMID(JPTC-1)+FRAC*(HMID(JPTC)-HMID(JPTC-1))
|
||
|
|
ZNEXT(3)=HRIGHT(JPTC-1)+FRAC*(HRIGHT(JPTC)-HRIGHT(JPTC-1))
|
||
|
|
endif
|
||
|
|
if(ictt .eq. 2) then
|
||
|
|
ZNEXT(1)=-9999.
|
||
|
|
ZNEXT(2)=-9999.
|
||
|
|
ZNEXT(3)=-9999.
|
||
|
|
endif
|
||
|
|
! GET NEW LOCATION
|
||
|
|
|
||
|
|
CALL GETNOD(J)
|
||
|
|
|
||
|
|
IF(ALWD(1).GT. 0.) THEN
|
||
|
|
WIDTHD(J)=ALWD(JPTC-1)+FRAC*(ALWD(JPTC)-ALWD(JPTC-1))
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
! Store GRIDX and GRIDY into it
|
||
|
|
!
|
||
|
|
CORD(J,1) = XNEXT
|
||
|
|
CORD(J,2) = YNEXT
|
||
|
|
WD(J)=ZNEXT(2)
|
||
|
|
HSET(J,1)=ZNEXT(1)
|
||
|
|
HSET(J,2)=ZNEXT(2)
|
||
|
|
HSET(J,3)=ZNEXT(3)
|
||
|
|
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
|
||
|
|
WIDTHD(J)=WIDTHD(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 CONTINUE
|
||
|
|
! IF(N .EQ. 1 .AND. ICTT .EQ. 1) THEN
|
||
|
|
! J1=J
|
||
|
|
! CYCLE
|
||
|
|
! ELSEIF(N .EQ. NELTS .AND. ICTT .EQ. 1) THEN
|
||
|
|
IF(N .EQ. NELTS .AND. ICTT .EQ. 1) THEN
|
||
|
|
WIDTHD(J1)=WIDTHD(J)
|
||
|
|
WD(J1)=WD(J)
|
||
|
|
SS1(J1)=SS1(J)
|
||
|
|
SS2(J1)=SS2(J)
|
||
|
|
WIDS(J1)=WIDS(J)
|
||
|
|
WIDBS(J1)=WIDBS(J)
|
||
|
|
SSO(J1)=SSO(J)
|
||
|
|
BS1(J1)=BS1(J)
|
||
|
|
XUSR(J1)=XUSR(J)
|
||
|
|
YUSR(J1)=YUSR(J)
|
||
|
|
CORD(J1,1)=CORD(J,1)
|
||
|
|
CORD(J1,2)=CORD(J,2)
|
||
|
|
HSET(J1,1)=HSET(J,1)
|
||
|
|
HSET(J1,2)=HSET(J,2)
|
||
|
|
HSET(J1,3)=HSET(J,3)
|
||
|
|
ENDIF
|
||
|
|
call getelm(k)
|
||
|
|
if(n .eq. 1 .and. ictt .eq. 0 .and. jst .ne. 1) then
|
||
|
|
wd(j1)=wd(j)
|
||
|
|
hset(j1,1)=hset(j,1)
|
||
|
|
hset(j1,2)=hset(j,2)
|
||
|
|
hset(j1,3)=hset(j,3)
|
||
|
|
endif
|
||
|
|
NOP(K,1)=J1
|
||
|
|
NOP(K,2)=0
|
||
|
|
NOP(K,3)=J
|
||
|
|
NCORN(K)=3
|
||
|
|
IMAT(K)=ITYPB
|
||
|
|
if(ictt .eq. 1) then
|
||
|
|
if(n .eq. 1) imat(k)= 2000
|
||
|
|
if(n .eq. nelts) imat(k)= 2001
|
||
|
|
endif
|
||
|
|
IESKP(K) = 0
|
||
|
|
NE = MAX(K,NE)
|
||
|
|
IERC=0
|
||
|
|
CALL PLTELM(K,IERC)
|
||
|
|
J1=J
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
ENDDO
|
||
|
|
JKP=J
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
|