!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