SUBROUTINE GETALLANGS USE BLK1MOD USE BLK2MOD SAVE ICOUNTMX DIMENSION ANGA(2),ANGB(2) DATA ICOUNTMX/0/ IF(.NOT. ALLOCATED(NKEY1)) THEN ALLOCATE (NKEY1(MAXE)) ENDIF IF(.NOT. ALLOCATED(ANGOP)) THEN ALLOCATE (ANGOP(MAXP)) ENDIF CALL HEDR ICOUNTMX=50 ILMIT=0 CALL GEtrev(ICOUNTMX,ILMIT) IF(ICOUNTMX .LT. 0) RETURN NKEY1=0 ! set all the nodal angles negative ANGOP=-1. ! get elements connected to nodes table IERR=0 CALL NDNECON(IERR) ! loop on the elements to find mid-sides DO N=1,NE ! work only with triangles IF(NCORN(N) .EQ. 6) THEN ! go to each mid-side DO K=2,6,2 N1=NOP(N,K-1) KN=MOD(K+1,6) N3=NOP(N,KN) KP=MOD(K+3,6) N2=NOP(N,KP) NCUR=NOP(N,K) IF(NCUR .EQ. 0) THEN CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK, & 'You have tried to reverse before executing "FILL"'//CHAR(13) & //'Reversing terminated',& 'UNABLE TO REVERSE') ! CALL SYMBL(0.,7.30,0.20,STRELS,0.,60) RETURN ENDIF ! call GETANG to get angle opposite N1-N3 line ANGTMP=GETANG(N1,N2,N3) IF(ANGTMP .GT. ANGOP(NCUR)) ANGOP(NCUR)=ANGTMP ENDDO ENDIF ENDDO ! get the angles in ascending order CALL SORT(ANGOP,ICN,NP) ICOUNT=0 ! loop backwards and use the sorrt key ICN DO J=NP,1,-1 MIDND=ICN(J) ! only work when angles greater than 90 deg IF(ANGOP(MIDND) .GT. 1.5708) THEN ! check if there are two elements connected to this mid side IF(NECON(MIDND,2) .GT. 0) THEN ! make sure the opposite elements are not quadrilaterals IF(NCORN(NECON(MIDND,1)) .EQ. 6 .AND. NCORN(NECON(MIDND,2)) .EQ. 6) THEN ! only proceed when the first mid-side has not been processed IF(NKEY1(NECON(MIDND,1)) .EQ. 0) THEN NEL1=NECON(MIDND,1) ! only proceed when the second mid-side has not been processed IF(NKEY1(NECON(MIDND,2)) .EQ. 0) THEN ! we really have a candidate lest check if it will make the angles worse ! first find the locations of the mid sides in the order data to get more angles DO KK=1,2 DO K=2,6,2 ! test for a fit IF(NOP(NECON(MIDND,KK),K) .EQ. MIDND) THEN ! get angles before and after ! corner before N1=NOP(NECON(MIDND,KK),K-1) ! corner after N3=MOD(K+1,6) N3=NOP(NECON(MIDND,KK),N3) ! test for possible equal elev if(ilmit .eq. 1) then if(wd(n1) .gt. -9000.) then if(wd(n1) .eq. wd(n3)) go to 180 endif endif ! corner opposite N2=MOD(K+3,6) N2=NOP(NECON(MIDND,KK),N2) ! call GETANG to get angle opposite N2-N3 LINE ANGB(KK)=GETANG(N2,N1,N3) ! call GETANG to get angle opposite N1-N2 LINE ANGA(KK)=GETANG(N1,N3,N2) ENDIF ENDDO ENDDO ! test if the side angles are larger, if so skip out IF(ANGOP(MIDND) .LT. ANGB(2)+ANGA(1)) GO TO 180 IF(ANGOP(MIDND) .LT. ANGB(1)+ANGA(2)) GO TO 180 ! finally we can proceed ICOUNT=ICOUNT+1 ! NELPR(ICOUNT,2)=NECON(MIDND,2) ! NELPR(ICOUNT,1)=NEL1 NKEY1(NECON(MIDND,1))=1 NKEY1(NECON(MIDND,2))=1 N1=NEL1 N2=NECON(MIDND,2) ! carry out reversal CALL REVERS(N1,N2) ! show the elements call fillemc(n1,4) call fillemc(n2,4) IF(ICOUNT .GE. ICOUNTMX) GO TO 200 ENDIF ENDIF ENDIF ENDIF ELSE GO TO 200 ENDIF 180 CONTINUE ENDDO 200 CONTINUE RETURN END FUNCTION GETANG(N1,N2,N3) USE BLK1MOD A=SQRT((XUSR(N1)-XUSR(N2))**2+(YUSR(N1)-YUSR(N2))**2) B=SQRT((XUSR(N2)-XUSR(N3))**2+(YUSR(N2)-YUSR(N3))**2) C=SQRT((XUSR(N3)-XUSR(N1))**2+(YUSR(N3)-YUSR(N1))**2) ANG1=(A**2+B**2-C**2)/(2.*A*B) IF(ANG1 .GT. 1.) ANG1=1. GETANG=ACOS(ANG1) RETURN END