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.
145 lines
4.5 KiB
Fortran
145 lines
4.5 KiB
Fortran
5 years ago
|
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
|