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
3.6 KiB
Fortran
121 lines
3.6 KiB
Fortran
5 years ago
|
SUBROUTINE RVSDIAG
|
||
|
|
! routine to test for and reverse diagonals
|
||
|
|
USE BLK1MOD
|
||
|
|
USE BLK2MOD
|
||
|
|
INCLUDE 'BFILES.I90'
|
||
|
|
|
||
|
|
REAL IGrDistanceLine
|
||
|
|
dist(n1,n2)=sqrt((xusr(n1)-xusr(n2))**2+(yusr(n1)-yusr(n2))**2)
|
||
|
|
! save current file
|
||
|
|
|
||
|
|
IFILOUT=IACTVFIL+50
|
||
|
|
CALL WRTFIL(IFILOUT)
|
||
|
|
|
||
|
|
! fill midsides
|
||
|
|
CALL FILM(1)
|
||
|
|
! get elements connected to nodes table
|
||
|
|
MIDSIDE=0
|
||
|
|
IERR=1
|
||
|
|
CALL NDNECON(IERR)
|
||
|
|
|
||
|
|
! gets nodes nodes opposite
|
||
|
|
! loop on midsides
|
||
|
|
KCOUNT=0
|
||
|
|
DO N=1,NP
|
||
|
|
IF(NECON(N,2) .EQ. 0) CYCLE
|
||
|
|
NEL1=NECON(N,1)
|
||
|
|
NEL2=NECON(N,2)
|
||
|
|
WRITE(160,*) 'ELTS',NEL1,NEL2
|
||
|
|
! test for two triangles
|
||
|
|
IF(NCORN(NEL1) .EQ. 8 .OR. NCORN(NEL1) .LT. 6) CYCLE
|
||
|
|
IF(NCORN(NEL2) .EQ. 8 .OR. NCORN(NEL2) .LT. 6) CYCLE
|
||
|
|
! get the adjacent nodes N1 and N2
|
||
|
|
DO K=2,6,2
|
||
|
|
IF(N .EQ. NOP(NEL1,K)) THEN
|
||
|
|
! get the adjacent nodes N1 and N2
|
||
|
|
N1=NOP(NEL1,K-1)
|
||
|
|
N2=K+1
|
||
|
|
IF(N2 .GT. 6) N2=1
|
||
|
|
N2=NOP(NEL1,N2)
|
||
|
|
! get first of two nodes facing each other N3
|
||
|
|
N3=K+3
|
||
|
|
IF(N3 .GT. 6) N3=N3-6
|
||
|
|
N3=NOP(NEL1,N3)
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
! get second of two nodes facing each other N4
|
||
|
|
DO K=2,6,2
|
||
|
|
IF(N .EQ. NOP(NEL2,K)) THEN
|
||
|
|
N4=K+3
|
||
|
|
IF(N4 .GT. 6) N4=N4-6
|
||
|
|
N4=NOP(NEL2,N4)
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
IF(WD(N1) .EQ. WD(N3) .AND. WD(N2) .EQ. WD(N3)) GO TO 500
|
||
|
|
IF(WD(N1) .EQ. WD(N4) .AND. WD(N2) .EQ. WD(N4)) GO TO 500
|
||
|
|
IF(WD(N1) .EQ. WD(N3) .AND. WD(N1) .EQ. WD(N4)) GO TO 500
|
||
|
|
IF(WD(N2) .EQ. WD(N3) .AND. WD(N2) .EQ. WD(N4)) GO TO 500
|
||
|
|
X1=XUSR(N1)
|
||
|
|
X2=XUSR(N2)
|
||
|
|
X3=XUSR(N3)
|
||
|
|
X4=XUSR(N4)
|
||
|
|
Y1=YUSR(N1)
|
||
|
|
Y2=YUSR(N2)
|
||
|
|
Y3=YUSR(N3)
|
||
|
|
Y4=YUSR(N4)
|
||
|
|
CALL IGRINTERSECTLINE(X1,Y1,X2,Y2,X3,Y3,X4,Y4,XINTER,YINTER,ISTAT)
|
||
|
|
IF(ISTAT .NE. 5) GO TO 500
|
||
|
|
METHOD=1
|
||
|
|
D1=IGrDistanceLine(X1,Y1,X2,Y2,XINTER,YINTER,METHOD)
|
||
|
|
! D2=IGrDistanceLine(X1,Y1,X2,Y2,X4,Y4,METHOD)
|
||
|
|
D1=SQRT((X1-XINTER)**2+(Y1-YINTER)**2)
|
||
|
|
D2=SQRT((X2-XINTER)**2+(Y2-YINTER)**2)
|
||
|
|
D3=SQRT((X1-X2)**2+(Y1-Y2)**2)
|
||
|
|
IF(D1 .LT. 0.05*D3) GO TO 500
|
||
|
|
IF(D2 .LT. 0.05*D3) GO TO 500
|
||
|
|
IF(WD(N3) .EQ. WD(N1)) THEN
|
||
|
|
IF(ABS(WD(N4)-WD(N3)) .LT. ABS(WD(N2)-WD(N3))) THEN
|
||
|
|
KCOUNT=KCOUNT+1
|
||
|
|
WRITE(160,*) 'QV1',KCOUNT,NEL1,NEL2,N1,N2,N3,N4
|
||
|
|
CALL DUMPBIN(KCOUNT,1)
|
||
|
|
CALL REVERS(NEL1,NEL2)
|
||
|
|
GO TO 500
|
||
|
|
ELSE
|
||
|
|
GO TO 500
|
||
|
|
ENDIF
|
||
|
|
ELSEIF(WD(N3) .EQ. WD(N2)) THEN
|
||
|
|
IF(ABS(WD(N4)-WD(N3)) .LT. ABS(WD(N3)-WD(N2))) THEN
|
||
|
|
KCOUNT=KCOUNT+1
|
||
|
|
WRITE(160,*) 'QV2',KCOUNT,NEL1,NEL2,N1,N2,N3,N4
|
||
|
|
CALL DUMPBIN(KCOUNT,1)
|
||
|
|
CALL REVERS(NEL1,NEL2)
|
||
|
|
GO TO 500
|
||
|
|
ELSE
|
||
|
|
GO TO 500
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
! test if they are equal height
|
||
|
|
IF(WD(N3) .EQ. WD(N4) .or. ABS(WD(N3) -WD(N4)) .LT. ABS(WD(N1)-WD(N2))) THEN
|
||
|
|
! if so reverse connections
|
||
|
|
if(dist(n1,n2)*1.5 .lt. dist(n3,n4)) go to 500
|
||
|
|
KCOUNT=KCOUNT+1
|
||
|
|
WRITE(160,*) 'RV1',KCOUNT,NEL1,NEL2,N1,N2,N3,N4
|
||
|
|
CALL REVERS(NEL1,NEL2)
|
||
|
|
CALL DUMPBIN(KCOUNT,1)
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
! test if N4 closer or equal to N3 than N1 or N2
|
||
|
|
IF(ABS(WD(N4) - WD(N3)) .LT. ABS(WD(N1) - WD(N3)) .OR. ABS(WD(N4) - WD(N3)) .LT. ABS(WD(N2) - WD(N3))) THEN
|
||
|
|
! if so reverse connections
|
||
|
|
if(dist(n1,n2)*1.5 .lt. dist(n3,n4)) go to 500
|
||
|
|
KCOUNT=KCOUNT+1
|
||
|
|
WRITE(160,*) 'RV2',KCOUNT,NEL1,NEL2,N1,N2,N3,N4
|
||
|
|
CALL REVERS(NEL1,NEL2)
|
||
|
|
CALL DUMPBIN(KCOUNT,1)
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
500 CONTINUE
|
||
|
|
! end loop
|
||
|
|
ENDDO
|
||
|
|
RETURN
|
||
|
|
END
|