SUBROUTINE REATTACH USE BLK1MOD USE BLK2MOD INTEGER NS1(3,4),NT1(3,4) CHARACTER*1 IFLAG,ANSW(10) DATA ANSW/' ',' ',' ',' ',' ',' ','n','z','r','q'/ ! SETUP CONNECTIVITY TABLE ISWW=0 CALL KCON(ISWW) ! SELECT FIRST ELEMENT 10 CONTINUE NHTPSV=NHTP NMESSSV=NMESS NBRRSV=NBRR NHTP=0 NMESS=20 NBRR=8 CALL HEDR CALL PROX(XC,YC,NE,XX,YY,IELEM,IFLAG,IESKP,IBOX) IF(IRMAIN .EQ. 1) THEN NHTP=NHTPSV NMESS=NMESSSV NBRR=NBRRSV CALL HEDR RETURN ENDIF IF(IFLAG .EQ. 'c' .AND. IBOX .GT. 0) THEN IFLAG=ANSW(IBOX) ENDIF ! IF(IFLAG .EQ. 'q') THEN NHTP=NHTPSV NMESS=NMESSSV NBRR=NBRRSV CALL HEDR RETURN ENDIF call fillem(ielem) ! GET UNATTACHED NOP kk=0 DO K=2,NCORN(IELEM),2 NSX=NOP(IELEM,K) IF(NDELM(NSX) .EQ. 1) THEN ! FOUND IT KK=KK+1 NS1(1,KK)=NOP(IELEM,K-1) NS1(2,KK)=NSX KKK=MOD(K,NCORN(IELEM))+1 NS1(3,KK)=NOP(IELEM,KKK) ! GO TO 280 ENDIF ENDDO 280 CONTINUE ! SELECT NEXT ELEMENT CALL PROX(XC,YC,NE,XX,YY,IELEM1,IFLAG,IESKP,IBOX) call fillem(ielem1) ! GET UNNATCHED SIDE ! FIND AN UNATTACHED SIDE (INDICATE OF TRIANGLE OR QUADRILATERAL) LL=0 DO K=2,NCORN(IELEM1),2 NSX=NOP(IELEM1,K) IF(NDELM(NSX) .EQ. 1) THEN ! FOUND IT LL=LL+1 NT1(1,LL)=NOP(IELEM1,K-1) NT1(2,LL)=NSX KKK=MOD(K,NCORN(IELEM1))+1 NT1(3,LL)=NOP(IELEM1,KKK) ! GO TO 300 ENDIF ENDDO 300 CONTINUE ! FORM A NEW ELEMENT ASSIGN TYPE AS INDICATED ! GET THE NEAREST TWO FACES DISTKP=1.E20 DO NN=1,KK DO MM=1,LL DIST=(XUSR(NS1(2,NN))-XUSR(NT1(2,MM)))**2+(YUSR(NS1(2,NN))-YUSR(NT1(2,MM)))**2 IF(DIST .LT. DISTKP) THEN NNN=NN MMM=MM DISTKP=DIST ENDIF ENDDO ENDDO CALL GETELM(J) DO K=1,3 NOP(J,K)=NS1(K,NNN) NOP(J,K+4)=NT1(K,MMM) ENDDO NOP(J,4)=0 NOP(J,8)=0 IMAT(J)=1 IESKP(J) = 0 NCORN(J)=8 ! GO BACK TO LOOK FOR NEW PAIR CALL PLOTOT(1) GO TO 10 RETURN END