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.

121 lines
2.8 KiB
Fortran

!IPK LAST UPDATE jAN 25 2001 CORRECT REFERENCE TO INEW
SUBROUTINE COMPACT(ISW)
!
! Compact nodes or element numbers
! ISW = 3 compact nodes
! ISW = 4 compact elements
!
USE BLK1MOD
! INCLUDE 'BLK1.COM'
DIMENSION ICREFN(MAXP),ICREFE(MAXE)
!
!
IF(ISW .EQ. 3) THEN
!
! First compact node list and create cross reference
!
JJ=1
DO J=1,NP
!IPK JAN01 FIX TEST
IF(INEW(J) .NE. 0) THEN
INEW(JJ)= INEW(J)
CORD(JJ,1)=CORD(J,1)
CORD(JJ,2)=CORD(J,2)
XUSR(JJ)=XUSR(J)
YUSR(JJ)=YUSR(J)
WD(JJ)=WD(J)
LAY(JJ)=LAY(J)
WIDTH(JJ)=WIDTH(J)
SS1(JJ)=SS1(J)
SS2(JJ)=SS2(J)
WIDS(JJ)=WIDS(J)
WIDBS(JJ)=WIDBS(J)
SSO(JJ)=SSO(J)
INSKP(JJ)=INSKP(J)
LOCK(JJ)=LOCK(J)
ICREFN(J)=JJ
JJ=JJ+1
ENDIF
ENDDO
DO J=JJ,NP
CORD(J,1)=-1.D20
CORD(J,2)=-1.D20
XUSR(J)=-1.D20
YUSR(J)=-1.D20
WD(J)=-9999.
LAY(J)=-9999
WIDTH(J)=0.
SS1(J)=0
SS2(J)=0.
WIDS(J)=0.
WIDBS(J)=0.
SSO(J)=0.
INSKP(J)=1
!IPK JAN01 ADD INEW
INEW(J)=0
LOCK(J)=0
ENDDO
NP=JJ-1
!
! Next renumber element connections
!
DO N=1,NE
DO M=1,8
IF(NOP(N,M) .NE. 0) THEN
NOP(N,M)=ICREFN(NOP(N,M))
ENDIF
ENDDO
ENDDO
! Renumber continuity lines
DO I=1,NCLM
DO J=1,350
IF(ICCLN(I,J) .GT. 0) THEN
ICCLN(I,J)=ICREFN(ICCLN(I,J))
ENDIF
ENDDO
ENDDO
ELSEIF(ISW .EQ. 4) THEN
!
! Compact elements
!
JJ=1
DO J=1,NE
IF(NOP(J,1) .NE. 0) THEN
DO M=1,8
NOP(JJ,M)=NOP(J,M)
ENDDO
ICREFE(J)=JJ
XC(JJ)=XC(J)
YC(JJ)=YC(J)
IMAT(JJ)=IMAT(J)
THTA(JJ)=THTA(J)
IEM(JJ)=0
NCORN(JJ)=NCORN(J)
IESKP(JJ)=IESKP(J)
JJ=JJ+1
ENDIF
ENDDO
DO J=JJ,NE
DO M=1,8
NOP(J,M)=0
ENDDO
IMAT(J)=0
THTA(J)=0
IEM(J)=0
NCORN(J)=0
IESKP(JJ)=-1
ENDDO
NE=JJ-1
DO J=1,NLST
DO I=1,LLIST(J)
ILIST(J,I)=ICREFE(ILIST(J,I))
ENDDO
ENDDO
ENDIF
RETURN
END