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.
587 lines
17 KiB
Fortran
587 lines
17 KiB
Fortran
5 years ago
|
SUBROUTINE ADD999(ISWT9,NELC)
|
||
|
|
|
||
|
|
! add type 999 elements to all 1-d elements
|
||
|
|
|
||
|
|
USE BLK1MOD
|
||
|
|
USE BLK2MOD
|
||
|
|
COMMON ISEQ(4000,10),LIST1(2000),LIST2(2000),J1OLD(20),J2OLD(20)
|
||
|
|
INCLUDE 'TXFRM.COM'
|
||
|
|
|
||
|
|
IF(.NOT. ALLOCATED(IUSEDM)) THEN
|
||
|
|
ALLOCATE (IUSEDM(MAXE))
|
||
|
|
IUSEDM=0
|
||
|
|
ENDIF
|
||
|
|
IF(.NOT. ALLOCATED(HSET)) THEN
|
||
|
|
ISWTH=0
|
||
|
|
ELSE
|
||
|
|
ISWTH=1
|
||
|
|
ENDIF
|
||
|
|
! loop on elements looking for 1-d
|
||
|
|
PI2=3.14159/2.
|
||
|
|
|
||
|
|
NTEMPLC=0
|
||
|
|
NCM=MAXECON
|
||
|
|
NCMi=MAXECON
|
||
|
|
IUSEDM=0
|
||
|
|
DO N=1,NE
|
||
|
|
IF(IMAT(N) .NE. 999) CYCLE
|
||
|
|
CALL KCON(0)
|
||
|
|
GO TO 75
|
||
|
|
ENDDO
|
||
|
|
GO TO 90
|
||
|
|
75 CONTINUE
|
||
|
|
DO N=1,NE
|
||
|
|
IF(IMAT(N) .EQ. 999) THEN
|
||
|
|
DO J=1,NCMi
|
||
|
|
IF(NCORN(ICON(N,J)) .EQ. 3) THEN
|
||
|
|
M=ICON(N,J)
|
||
|
|
IF(NOP(M,1) .EQ. NOP(N,1) .AND. NOP(M,3) .EQ. NOP(N,3) .OR.&
|
||
|
|
NOP(M,1) .EQ. NOP(N,3) .AND. NOP(M,3) .EQ. NOP(N,1)) THEN
|
||
|
|
IUSEDM(ICON(N,J))=1
|
||
|
|
GO TO 80
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
80 CONTINUE
|
||
|
|
ENDDO
|
||
|
|
90 n=1
|
||
|
|
ICL=0
|
||
|
|
do k=1,10
|
||
|
|
iseqp=2000
|
||
|
|
iseqm=2000
|
||
|
|
do ns=n,ne
|
||
|
|
if(imat(ns) .eq. 0 .or. (imat(ns) .ge. 900 .and. imat(ns) .lt. 2000)) cycle
|
||
|
|
if(ncorn(ns) .gt. 3) cycle
|
||
|
|
if(IUSEDM(ns) .eq. 1) cycle
|
||
|
|
! renumber elements to put them in order
|
||
|
|
N=NS
|
||
|
|
N1=NOP(NS,1)
|
||
|
|
N3=NOP(NS,3)
|
||
|
|
iseq(iseqp,k)=ns
|
||
|
|
IUSEDM(n)=1
|
||
|
|
go to 100
|
||
|
|
enddo
|
||
|
|
go to 200
|
||
|
|
100 continue
|
||
|
|
! search for element connected to n1 or n3
|
||
|
|
do m=1,ne
|
||
|
|
if(imat(ns) .eq. 0 .or. (imat(ns) .ge. 900 .and. imat(ns) .lt. 2000)) cycle
|
||
|
|
! if(imat(m) .gt. 0 .and. imat(m) .lt. 900) then
|
||
|
|
if(ncorn(m) .lt. 4) then
|
||
|
|
if(IUSEDM(m) .eq. 1) cycle
|
||
|
|
if(nop(m,1) .eq. n3) then
|
||
|
|
IUSEDM(m)=1
|
||
|
|
iseqp=iseqp+1
|
||
|
|
iseq(iseqp,k)=m
|
||
|
|
! n1=nop(m,1)
|
||
|
|
n3=nop(m,3)
|
||
|
|
n=m
|
||
|
|
go to 100
|
||
|
|
elseif(nop(m,1) .eq. n1) then
|
||
|
|
nop(m,1)=nop(m,3)
|
||
|
|
nop(m,3)=n1
|
||
|
|
IUSEDM(m)=1
|
||
|
|
iseqm=iseqm-1
|
||
|
|
iseq(iseqm,k)=m
|
||
|
|
n1=nop(m,1)
|
||
|
|
! n3=nop(m,3)
|
||
|
|
n=m
|
||
|
|
go to 100
|
||
|
|
elseif(nop(m,3) .eq. n1) then
|
||
|
|
IUSEDM(m)=1
|
||
|
|
iseqm=iseqm-1
|
||
|
|
iseq(iseqm,k)=m
|
||
|
|
n1=nop(m,1)
|
||
|
|
! n3=nop(m,3)
|
||
|
|
n=m
|
||
|
|
go to 100
|
||
|
|
elseif(nop(m,3) .eq. n3) then
|
||
|
|
nop(m,3)=nop(m,1)
|
||
|
|
nop(m,1)=n3
|
||
|
|
IUSEDM(m)=1
|
||
|
|
iseqp=iseqp+1
|
||
|
|
iseq(iseqp,k)=m
|
||
|
|
! n1=nop(m,1)
|
||
|
|
n3=nop(m,3)
|
||
|
|
n=m
|
||
|
|
go to 100
|
||
|
|
endif
|
||
|
|
endif
|
||
|
|
! endif
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
200 continue
|
||
|
|
! do n=990,1005
|
||
|
|
! write(150,*) n,(iseq(n,m),m=1,5)
|
||
|
|
! enddo
|
||
|
|
NETEMP=NE
|
||
|
|
|
||
|
|
do k=1,10
|
||
|
|
nss=0
|
||
|
|
do ns=1,4000
|
||
|
|
if(iseq(ns,k) .eq. 0) cycle
|
||
|
|
n=iseq(ns,k)
|
||
|
|
N1=NOP(N,1)
|
||
|
|
N2=NOP(N,2)
|
||
|
|
N3=NOP(N,3)
|
||
|
|
|
||
|
|
if(nss .eq. 0) then
|
||
|
|
ELDIR=ATAN2(YUSR(N3)-YUSR(N1),XUSR(N3)-XUSR(N1))
|
||
|
|
CALL GETNOD(J1)
|
||
|
|
INEW(J1) = 1
|
||
|
|
INSKP(J1) =0
|
||
|
|
IF(ISWTH .EQ. 1) THEN
|
||
|
|
WD(J1)=HSET(N1,3)
|
||
|
|
ELSE
|
||
|
|
WD(J1)=-9999.
|
||
|
|
ENDIF
|
||
|
|
CALL GETNOD(J2)
|
||
|
|
INEW(J2) = 1
|
||
|
|
INSKP(J2) =0
|
||
|
|
IF(ISWTH .EQ. 1) THEN
|
||
|
|
WD(J2)=HSET(N1,1)
|
||
|
|
ELSE
|
||
|
|
WD(J2)=-9999.
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
! XUSR(J1)=+WIDTHD(N1)/2.*COS(ELDIR-PI2)+XUSR(N1)
|
||
|
|
! YUSR(J1)=+WIDTHD(N1)/2.*SIN(ELDIR-PI2)+YUSR(N1)
|
||
|
|
XUSR(J1)=+WIDTH(N1)/2.*COS(ELDIR-PI2)+XUSR(N1)
|
||
|
|
YUSR(J1)=+WIDTH(N1)/2.*SIN(ELDIR-PI2)+YUSR(N1)
|
||
|
|
CORD(J1,1)=(XUSR(J1)+XS)/TXSCAL
|
||
|
|
CORD(J1,2)=(YUSR(J1)+YS)/TXSCAL
|
||
|
|
IF(ISWT9 .EQ. 2) THEN
|
||
|
|
WD(J1)=WD(N1)
|
||
|
|
ENDIF
|
||
|
|
nnn=iseq(ns+1,k)
|
||
|
|
if(nnn .eq. 0) then
|
||
|
|
ELDIR=ATAN2(YUSR(N3)-YUSR(N1),XUSR(N3)-XUSR(N1))
|
||
|
|
else
|
||
|
|
n4=nop(nnn,3)
|
||
|
|
ELDIR=ATAN2(YUSR(N4)-YUSR(N1),XUSR(N4)-XUSR(N1))
|
||
|
|
endif
|
||
|
|
! XUSR(J2)=+WIDTHD(N1)/2.*COS(ELDIR+PI2)+XUSR(N1)
|
||
|
|
! YUSR(J2)=+WIDTHD(N1)/2.*SIN(ELDIR+PI2)+YUSR(N1)
|
||
|
|
XUSR(J2)=+WIDTH(N1)/2.*COS(ELDIR+PI2)+XUSR(N1)
|
||
|
|
YUSR(J2)=+WIDTH(N1)/2.*SIN(ELDIR+PI2)+YUSR(N1)
|
||
|
|
CORD(J2,1)=(XUSR(J2)+XS)/TXSCAL
|
||
|
|
CORD(J2,2)=(YUSR(J2)+YS)/TXSCAL
|
||
|
|
IF(ISWT9 .EQ. 2) THEN
|
||
|
|
WD(J2)=WD(N1)
|
||
|
|
ENDIF
|
||
|
|
nss=1
|
||
|
|
else
|
||
|
|
nnn=iseq(ns+1,k)
|
||
|
|
if(nnn .eq. 0) then
|
||
|
|
ELDIR=ATAN2(YUSR(N3)-YUSR(N1),XUSR(N3)-XUSR(N1))
|
||
|
|
else
|
||
|
|
n4=nop(nnn,3)
|
||
|
|
ELDIR=ATAN2(YUSR(N4)-YUSR(N1),XUSR(N4)-XUSR(N1))
|
||
|
|
endif
|
||
|
|
endif
|
||
|
|
N0=N1
|
||
|
|
! get two node numbers and store in ntempc
|
||
|
|
CALL GETNOD(J3)
|
||
|
|
INEW(J3) = 1
|
||
|
|
INSKP(J3) =0
|
||
|
|
IF(ISWTH .EQ. 1) THEN
|
||
|
|
WD(J3)=HSET(N3,3)
|
||
|
|
ELSE
|
||
|
|
WD(J3)=-9999.
|
||
|
|
ENDIF
|
||
|
|
CALL GETNOD(J4)
|
||
|
|
INEW(J4) = 1
|
||
|
|
INSKP(J4) =0
|
||
|
|
IF(ISWTH .EQ. 1) THEN
|
||
|
|
WD(J4)=HSET(N3,1)
|
||
|
|
ELSE
|
||
|
|
WD(J4)=-9999.
|
||
|
|
ENDIF
|
||
|
|
IF(J4 .GT. NP) NP=J4
|
||
|
|
nn= imat(n)
|
||
|
|
if(nn .gt. 1999) then
|
||
|
|
! XUSR(J3)=+WIDTHD(N3)/2.*COS(ELDIR-PI2)+XUSR(N3)
|
||
|
|
! YUSR(J3)=+WIDTHD(N3)/2.*SIN(ELDIR-PI2)+YUSR(N3)
|
||
|
|
! XUSR(J4)=+WIDTHD(N3)/2.*COS(ELDIR+PI2)+XUSR(N3)
|
||
|
|
! YUSR(J4)=+WIDTHD(N3)/2.*SIN(ELDIR+PI2)+YUSR(N3)
|
||
|
|
XUSR(J3)=+WIDTH(N3)/2.*COS(ELDIR-PI2)+XUSR(N3)
|
||
|
|
YUSR(J3)=+WIDTH(N3)/2.*SIN(ELDIR-PI2)+YUSR(N3)
|
||
|
|
XUSR(J4)=+WIDTH(N3)/2.*COS(ELDIR+PI2)+XUSR(N3)
|
||
|
|
YUSR(J4)=+WIDTH(N3)/2.*SIN(ELDIR+PI2)+YUSR(N3)
|
||
|
|
ELSEIF(KID(nn,1) .NE. 0) THEN
|
||
|
|
JR2=KID(IMAT(N),2)
|
||
|
|
JR1=KID(IMAT(N),3)
|
||
|
|
JR4=KID(IMAT(N),4)
|
||
|
|
JR3=KID(IMAT(N),5)
|
||
|
|
XUSR(J1)=XUSR(JR1)
|
||
|
|
YUSR(J1)=YUSR(JR1)
|
||
|
|
XUSR(J2)=XUSR(JR2)
|
||
|
|
YUSR(J2)=YUSR(JR2)
|
||
|
|
XUSR(J3)=XUSR(JR3)
|
||
|
|
YUSR(J3)=YUSR(JR3)
|
||
|
|
XUSR(J4)=XUSR(JR4)
|
||
|
|
YUSR(J4)=YUSR(JR4)
|
||
|
|
! nop(n-1,7)=jr3
|
||
|
|
ELSE
|
||
|
|
! XUSR(J3)=+WIDTHD(N3)/2.*COS(ELDIR-PI2)+XUSR(N3)
|
||
|
|
! YUSR(J3)=+WIDTHD(N3)/2.*SIN(ELDIR-PI2)+YUSR(N3)
|
||
|
|
! XUSR(J4)=+WIDTHD(N3)/2.*COS(ELDIR+PI2)+XUSR(N3)
|
||
|
|
! YUSR(J4)=+WIDTHD(N3)/2.*SIN(ELDIR+PI2)+YUSR(N3)
|
||
|
|
XUSR(J3)=+WIDTH(N3)/2.*COS(ELDIR-PI2)+XUSR(N3)
|
||
|
|
YUSR(J3)=+WIDTH(N3)/2.*SIN(ELDIR-PI2)+YUSR(N3)
|
||
|
|
XUSR(J4)=+WIDTH(N3)/2.*COS(ELDIR+PI2)+XUSR(N3)
|
||
|
|
YUSR(J4)=+WIDTH(N3)/2.*SIN(ELDIR+PI2)+YUSR(N3)
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
CORD(J3,1)=(XUSR(J3)+XS)/TXSCAL
|
||
|
|
CORD(J3,2)=(YUSR(J3)+YS)/TXSCAL
|
||
|
|
CORD(J4,1)=(XUSR(J4)+XS)/TXSCAL
|
||
|
|
CORD(J4,2)=(YUSR(J4)+YS)/TXSCAL
|
||
|
|
IF(ISWT9 .EQ. 2) THEN
|
||
|
|
WD(J3)=WD(N3)
|
||
|
|
WD(J4)=WD(N3)
|
||
|
|
ENDIF
|
||
|
|
350 CONTINUE
|
||
|
|
CALL GETELM(I3)
|
||
|
|
! RECORD IN LIST FOR FUTURE
|
||
|
|
ICL=ICL+1
|
||
|
|
LIST1(ICL)=I3
|
||
|
|
LIST2(I3)=icl
|
||
|
|
NCORN(I3) = 8
|
||
|
|
IESKP(I3) = 0
|
||
|
|
NOP(I3,1)=J1
|
||
|
|
NOP(I3,3)=J3
|
||
|
|
NOP(I3,5)=N3
|
||
|
|
NOP(I3,6)=N2
|
||
|
|
NOP(I3,7)=N1
|
||
|
|
IF(ISWT9 .EQ. 0) THEN
|
||
|
|
IMAT(I3)=999
|
||
|
|
ELSE
|
||
|
|
IMAT(I3)=IMAT(N)
|
||
|
|
ENDIF
|
||
|
|
CALL GETELM(I4)
|
||
|
|
! RECORD IN LIST FOR FUTURE
|
||
|
|
ICL=ICL+1
|
||
|
|
LIST1(ICL)=I4
|
||
|
|
LIST2(I4)=-icl
|
||
|
|
NCORN(I4) = 8
|
||
|
|
IESKP(I4) = 0
|
||
|
|
IF(I4 .GT. NETEMP) NETEMP=I4
|
||
|
|
IMAT(I4)=999
|
||
|
|
NOP(I4,1)=J4
|
||
|
|
NOP(I4,2)= 0
|
||
|
|
NOP(I4,3)=J2
|
||
|
|
NOP(I4,5)=N1
|
||
|
|
NOP(I4,6)=N2
|
||
|
|
NOP(I4,7)=N3
|
||
|
|
IF(ISWT9 .EQ. 0) THEN
|
||
|
|
IMAT(I4)=999
|
||
|
|
ELSE
|
||
|
|
IMAT(I4)=IMAT(N)
|
||
|
|
CALL DELTEL(N)
|
||
|
|
ENDIF
|
||
|
|
J2=J4
|
||
|
|
J1=J3
|
||
|
|
ENDDO
|
||
|
|
enddo
|
||
|
|
NE=NETEMP
|
||
|
|
ICLM=ICL
|
||
|
|
NELCT=2
|
||
|
|
400 CONTINUE
|
||
|
|
CALL FILM(1)
|
||
|
|
call KCON(0)
|
||
|
|
|
||
|
|
do n=1,ne
|
||
|
|
|
||
|
|
if(imat(n) .eq. 2000) then
|
||
|
|
nm=nop(n,4)
|
||
|
|
if(necon(nm,1) .eq. n) then
|
||
|
|
nat=necon(nm,2)
|
||
|
|
else
|
||
|
|
nat=necon(nm,1)
|
||
|
|
endif
|
||
|
|
if(list2(n) .gt. 0) then
|
||
|
|
nm=nop(n,4)
|
||
|
|
if(necon(nm,1) .eq. n) then
|
||
|
|
nat=necon(nm,2)
|
||
|
|
else
|
||
|
|
nat=necon(nm,1)
|
||
|
|
endif
|
||
|
|
n1=nop(nat,7)
|
||
|
|
n2=nop(nat,1)
|
||
|
|
j1=nop(n,5)
|
||
|
|
j2=nop(n,7)
|
||
|
|
j3=nop(n,1)
|
||
|
|
j4=nop(n,3)
|
||
|
|
else
|
||
|
|
nm=nop(n,8)
|
||
|
|
if(necon(nm,1) .eq. n) then
|
||
|
|
nat=necon(nm,2)
|
||
|
|
else
|
||
|
|
nat=necon(nm,1)
|
||
|
|
endif
|
||
|
|
n1=nop(nat,3)
|
||
|
|
n2=nop(nat,5)
|
||
|
|
j1=nop(n,1)
|
||
|
|
j2=nop(n,3)
|
||
|
|
j3=nop(n,5)
|
||
|
|
j4=nop(n,7)
|
||
|
|
endif
|
||
|
|
xusr(j1)=xusr(n1)
|
||
|
|
yusr(j1)=yusr(n1)
|
||
|
|
cord(j1,1)=cord(n1,1)
|
||
|
|
cord(j1,2)=cord(n1,2)
|
||
|
|
xusr(j2)=xusr(n1)
|
||
|
|
yusr(j2)=yusr(n1)
|
||
|
|
cord(j2,1)=cord(n1,1)
|
||
|
|
cord(j2,2)=cord(n1,2)
|
||
|
|
xusr(j3)=xusr(n2)
|
||
|
|
yusr(j3)=yusr(n2)
|
||
|
|
cord(j3,1)=cord(n2,1)
|
||
|
|
cord(j3,2)=cord(n2,2)
|
||
|
|
xusr(j4)=xusr(n2)
|
||
|
|
yusr(j4)=yusr(n2)
|
||
|
|
cord(j4,1)=cord(n2,1)
|
||
|
|
cord(j4,2)=cord(n2,2)
|
||
|
|
elseif(imat(n) .eq. 2001) then
|
||
|
|
if(list2(n) .gt. 0) then
|
||
|
|
nm=nop(n,8)
|
||
|
|
if(necon(nm,1) .eq. n) then
|
||
|
|
nat=necon(nm,2)
|
||
|
|
else
|
||
|
|
nat=necon(nm,1)
|
||
|
|
endif
|
||
|
|
n1=nop(nat,5)
|
||
|
|
n2=nop(nat,3)
|
||
|
|
j1=nop(n,5)
|
||
|
|
j2=nop(n,7)
|
||
|
|
j3=nop(n,1)
|
||
|
|
j4=nop(n,3)
|
||
|
|
else
|
||
|
|
nm=nop(n,4)
|
||
|
|
if(necon(nm,1) .eq. n) then
|
||
|
|
nat=necon(nm,2)
|
||
|
|
else
|
||
|
|
nat=necon(nm,1)
|
||
|
|
endif
|
||
|
|
n1=nop(nat,1)
|
||
|
|
n2=nop(nat,7)
|
||
|
|
j1=nop(n,1)
|
||
|
|
j2=nop(n,3)
|
||
|
|
j3=nop(n,5)
|
||
|
|
j4=nop(n,7)
|
||
|
|
endif
|
||
|
|
xusr(j1)=xusr(n1)
|
||
|
|
yusr(j1)=yusr(n1)
|
||
|
|
cord(j1,1)=cord(n1,1)
|
||
|
|
cord(j1,2)=cord(n1,2)
|
||
|
|
xusr(j2)=xusr(n1)
|
||
|
|
yusr(j2)=yusr(n1)
|
||
|
|
cord(j2,1)=cord(n1,1)
|
||
|
|
cord(j2,2)=cord(n1,2)
|
||
|
|
xusr(j3)=xusr(n2)
|
||
|
|
yusr(j3)=yusr(n2)
|
||
|
|
cord(j3,1)=cord(n2,1)
|
||
|
|
cord(j3,2)=cord(n2,2)
|
||
|
|
xusr(j4)=xusr(n2)
|
||
|
|
yusr(j4)=yusr(n2)
|
||
|
|
cord(j4,1)=cord(n2,1)
|
||
|
|
cord(j4,2)=cord(n2,2)
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
450 CALL DELETM(0)
|
||
|
|
IF(NELC .LE. NELCT) THEN
|
||
|
|
NMESS=47
|
||
|
|
CALL GETINT(NNEL)
|
||
|
|
IF(NNEL .EQ. 2) GO TO 470
|
||
|
|
! Loop on newly created elements only
|
||
|
|
DO K=1,ICL,2
|
||
|
|
! work in pairs
|
||
|
|
N1=LIST1(K)
|
||
|
|
N2=LIST1(K+1)
|
||
|
|
NMT=IMAT(N1)
|
||
|
|
! temporarily get corner limits I1,I2,I3,I4
|
||
|
|
I1=NOP(N1,1)
|
||
|
|
I2=NOP(N2,3)
|
||
|
|
I3=NOP(N1,3)
|
||
|
|
I4=NOP(N2,1)
|
||
|
|
! Delete nodes in middle
|
||
|
|
JJ=NOP(N1,7)
|
||
|
|
JK=NOP(N1,5)
|
||
|
|
CALL DELETN(JJ)
|
||
|
|
IF(K .EQ. ICL-1) THEN
|
||
|
|
CALL DELETN(JK)
|
||
|
|
ENDIF
|
||
|
|
! CALL DELTEL(N1)
|
||
|
|
! CALL DELTEL(N2)
|
||
|
|
! Get x and y increments
|
||
|
|
DX1=(XUSR(I2)-XUSR(I1))/NNEL
|
||
|
|
DY1=(YUSR(I2)-YUSR(I1))/NNEL
|
||
|
|
DX2=(XUSR(I4)-XUSR(I3))/NNEL
|
||
|
|
DY2=(YUSR(I4)-YUSR(I3))/NNEL
|
||
|
|
|
||
|
|
! loop on new elements across section
|
||
|
|
J1OLD(1)=I1
|
||
|
|
J2OLD(1)=I3
|
||
|
|
IF(K .GT. 1) THEN
|
||
|
|
DO L=1,NNEL+1
|
||
|
|
J1OLD(L+1)=J2OLD(L+1)
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
! loop to creat nodes across section
|
||
|
|
DO L=1,NNEL
|
||
|
|
! Create new nodes for first in sequence
|
||
|
|
IF(K .EQ. 1) THEN
|
||
|
|
IF(L .LT. NNEL) THEN
|
||
|
|
CALL GETNOD(JNEW)
|
||
|
|
J1OLD(L+1)=JNEW
|
||
|
|
NP=MAX(NP,J1OLD(L+1))
|
||
|
|
XUSR(J1OLD(L+1))=XUSR(J1OLD(L))+DX1
|
||
|
|
YUSR(J1OLD(L+1))=YUSR(J1OLD(L))+DY1
|
||
|
|
CORD(J1OLD(L+1),1)=(XUSR(J1OLD(L+1))+XS)/TXSCAL
|
||
|
|
CORD(J1OLD(L+1),2)=(YUSR(J1OLD(L+1))+YS)/TXSCAL
|
||
|
|
INEW(J1OLD(L+1))=1
|
||
|
|
INSKP(J1OLD(L+1)) = 0
|
||
|
|
WD(J1OLD(L+1))=-9999.
|
||
|
|
WIDTH(J1OLD(L+1))=0.
|
||
|
|
SS1(J1OLD(L+1))=0.
|
||
|
|
SS2(J1OLD(L+1))=0.
|
||
|
|
WIDS(J1OLD(L+1))=0.
|
||
|
|
WIDBS(J1OLD(L+1))=0.
|
||
|
|
SSO(J1OLD(L+1))=0.
|
||
|
|
ELSE
|
||
|
|
J1OLD(L+1)=I2
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
! save forward nodes as list
|
||
|
|
IF(L .LT. NNEL) THEN
|
||
|
|
CALL GETNOD(JNEW)
|
||
|
|
J2OLD(L+1)=JNEW
|
||
|
|
NP=MAX(NP,J2OLD(L+1))
|
||
|
|
XUSR(J2OLD(l+1))=XUSR(J2OLD(L))+DX2
|
||
|
|
YUSR(J2OLD(L+1))=YUSR(J2OLD(L))+DY2
|
||
|
|
CORD(J2OLD(L+1),1)=(XUSR(J2OLD(L+1))+XS)/TXSCAL
|
||
|
|
CORD(J2OLD(L+1),2)=(YUSR(J2OLD(L+1))+YS)/TXSCAL
|
||
|
|
INEW(J2OLD(L+1))=1
|
||
|
|
INSKP(J2OLD(L+1)) = 0
|
||
|
|
WD(J2OLD(L+1))=-9999.
|
||
|
|
WIDTH(J2OLD(L+1))=0.
|
||
|
|
SS1(J2OLD(L+1))=0.
|
||
|
|
SS2(J2OLD(L+1))=0.
|
||
|
|
WIDS(J2OLD(L+1))=0.
|
||
|
|
WIDBS(J2OLD(L+1))=0.
|
||
|
|
SSO(J2OLD(L+1))=0.
|
||
|
|
ELSE
|
||
|
|
J2OLD(L+1)=I4
|
||
|
|
ENDIF
|
||
|
|
! Connect elements from list
|
||
|
|
CALL GETELM(NEA)
|
||
|
|
NE=MAX(NE,NEA)
|
||
|
|
NOP(NEA,1)=J1OLD(L)
|
||
|
|
NOP(NEA,3)=J2OLD(L)
|
||
|
|
NOP(NEA,5)=J2OLD(L+1)
|
||
|
|
NOP(NEA,7)=J1OLD(L+1)
|
||
|
|
NOP(NEA,2)=0
|
||
|
|
NOP(NEA,4)=0
|
||
|
|
NOP(NEA,6)=0
|
||
|
|
NOP(NEA,8)=0
|
||
|
|
IMAT(NEA)=NMT
|
||
|
|
NCORN(NEA) = 8
|
||
|
|
IESKP(NEA) = 0
|
||
|
|
ENDDO
|
||
|
|
ENDDO
|
||
|
|
470 CONTINUE
|
||
|
|
do n=1,ne
|
||
|
|
if(imat(n) .gt. 1000) then
|
||
|
|
CALL DELTEL(n)
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
RETURN
|
||
|
|
ENDIF
|
||
|
|
DO I=1,ICLM,2
|
||
|
|
NEL=LIST1(I)
|
||
|
|
IF(IMAT(NEL) .EQ. 0) CYCLE
|
||
|
|
IF(I .GT. 1) THEN
|
||
|
|
J3=J4
|
||
|
|
ELSE
|
||
|
|
CALL GETNOD(J3)
|
||
|
|
XUSR(J3)=(XUSR(NOP(NEL,7))+XUSR(NOP(NEL,1)))/2.
|
||
|
|
YUSR(J3)=(YUSR(NOP(NEL,7))+YUSR(NOP(NEL,1)))/2.
|
||
|
|
CORD(J3,1)=(XUSR(J3)+XS)/TXSCAL
|
||
|
|
CORD(J3,2)=(YUSR(J3)+YS)/TXSCAL
|
||
|
|
WD(J3)=(WD(NOP(NEL,1))+WD(NOP(NEL,7)))/2.
|
||
|
|
INEW(J3) = 1
|
||
|
|
INSKP(J3) =0
|
||
|
|
IF(J3 .GT. NP) NP=J3
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
CALL GETNOD(J4)
|
||
|
|
XUSR(J4)=(XUSR(NOP(NEL,3))+XUSR(NOP(NEL,5)))/2.
|
||
|
|
YUSR(J4)=(YUSR(NOP(NEL,3))+YUSR(NOP(NEL,5)))/2.
|
||
|
|
CORD(J4,1)=(XUSR(J4)+XS)/TXSCAL
|
||
|
|
CORD(J4,2)=(YUSR(J4)+YS)/TXSCAL
|
||
|
|
WD(J4)=(WD(NOP(NEL,3))+WD(NOP(NEL,5)))/2.
|
||
|
|
INEW(J4) = 1
|
||
|
|
INSKP(J4) =0
|
||
|
|
IF(J4 .GT. NP) NP=J4
|
||
|
|
CALL GETELM(I3)
|
||
|
|
! RECORD IN LIST FOR FUTURE
|
||
|
|
ICL=ICL+1
|
||
|
|
LIST1(ICL)=I3
|
||
|
|
NCORN(I3) = 8
|
||
|
|
IESKP(I3) = 0
|
||
|
|
IF(I3 .GT. NETEMP) NETEMP=I3
|
||
|
|
NOP(I3,5)=J4
|
||
|
|
NOP(I3,7)=J3
|
||
|
|
NOP(I3,1)=NOP(NEL,1)
|
||
|
|
NOP(I3,3)=NOP(NEL,3)
|
||
|
|
NOP(NEL,1)=J3
|
||
|
|
NOP(NEL,3)=J4
|
||
|
|
IMAT(I3)=IMAT(NEL)
|
||
|
|
|
||
|
|
NEL=LIST1(I+1)
|
||
|
|
IF(IMAT(NEL) .EQ. 0) CYCLE
|
||
|
|
IF(I .GT. 1) THEN
|
||
|
|
J3A=J4A
|
||
|
|
ELSE
|
||
|
|
CALL GETNOD(J3A)
|
||
|
|
XUSR(J3A)=(XUSR(NOP(NEL,3))+XUSR(NOP(NEL,5)))/2.
|
||
|
|
YUSR(J3A)=(YUSR(NOP(NEL,3))+YUSR(NOP(NEL,5)))/2.
|
||
|
|
CORD(J3A,1)=(XUSR(J3A)+XS)/TXSCAL
|
||
|
|
CORD(J3A,2)=(YUSR(J3A)+YS)/TXSCAL
|
||
|
|
WD(J3A)=(WD(NOP(NEL,3))+WD(NOP(NEL,5)))/2.
|
||
|
|
INEW(J3A) = 1
|
||
|
|
INSKP(J3A) =0
|
||
|
|
IF(J3A .GT. NP) NP=J3A
|
||
|
|
ENDIF
|
||
|
|
CALL GETNOD(J4A)
|
||
|
|
XUSR(J4A)=(XUSR(NOP(NEL,1))+XUSR(NOP(NEL,7)))/2.
|
||
|
|
YUSR(J4A)=(YUSR(NOP(NEL,1))+YUSR(NOP(NEL,7)))/2.
|
||
|
|
CORD(J4A,1)=(XUSR(J4A)+XS)/TXSCAL
|
||
|
|
CORD(J4A,2)=(YUSR(J4A)+YS)/TXSCAL
|
||
|
|
WD(J4A)=(WD(NOP(NEL,1))+WD(NOP(NEL,7)))/2.
|
||
|
|
INEW(J4A) = 1
|
||
|
|
INSKP(J4A) =0
|
||
|
|
IF(J4A .GT. NP) NP=J4A
|
||
|
|
CALL GETELM(I3)
|
||
|
|
! RECORD IN LIST FOR FUTURE
|
||
|
|
ICL=ICL+1
|
||
|
|
LIST1(ICL)=I3
|
||
|
|
NCORN(I3) = 8
|
||
|
|
IESKP(I3) = 0
|
||
|
|
IF(I3 .GT. NETEMP) NETEMP=I3
|
||
|
|
NOP(I3,1)=J4A
|
||
|
|
NOP(I3,3)=J3A
|
||
|
|
NOP(I3,5)=NOP(NEL,5)
|
||
|
|
NOP(I3,7)=NOP(NEL,7)
|
||
|
|
NOP(NEL,5)=J3A
|
||
|
|
NOP(NEL,7)=J4A
|
||
|
|
IMAT(I3)=IMAT(NEL)
|
||
|
|
|
||
|
|
ENDDO
|
||
|
|
NELCT=NELCT*2
|
||
|
|
GO TO 450
|
||
|
|
! RETURN
|
||
|
|
END
|
||
|
|
|