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