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