Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| integer, | intent(in) | :: | NS1 | |||
| integer, | intent(in) | :: | NS2 | |||
| integer, | intent(in) | :: | NS3 |
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE DeterminePolygonOverlap(NS1,NS2,NS3)
! SUBROUTINE INFORMATION:
! AUTHOR Legacy Code
! DATE WRITTEN
! MODIFIED na
! RE-ENGINEERED Lawrie, Oct 2000
! PURPOSE OF THIS SUBROUTINE:
! This subroutine computes the possible overlap of two polygons.
! It uses homogeneous coordinate techniques to determine the overlap area
! between two convex polygons. Results are stored in the homogeneous coordinate (HC) arrays.
! METHODOLOGY EMPLOYED:
! The vertices defining the overlap between fig.1 and fig.2
! consist of: the vertices of fig.1 enclosed by fig.2 (A)
! plus the vertices of fig.2 enclosed by fig.1 (B)
! plus the intercepts of fig.1 and fig.2 (C & D)
! +----------------------+
! ! !
! ! FIG.2 !
! ! !
! +--------------C----------A !
! ! ! / !
! ! ! / !
! ! B-------D--------------+
! ! FIG.1 /
! ! /
! +-------------------+
! REFERENCES:
! BLAST/IBLAST code, original author George Walton
! USE STATEMENTS:
USE General, ONLY: RoundSigDigits
USE DataSystemVariables, ONLY: SutherlandHodgman
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: NS1 ! Number of the figure being overlapped
INTEGER, INTENT(IN) :: NS2 ! Number of the figure doing overlapping
INTEGER, INTENT(IN) :: NS3 ! Location to place results of overlap
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER N ! Loop index
INTEGER NV1 ! Number of vertices of figure NS1
INTEGER NV2 ! Number of vertices of figure NS2
INTEGER NV3 ! Number of vertices of figure NS3 (the overlap of NS1 and NS2)
INTEGER NIN1 ! Number of vertices of NS1 within NS2
INTEGER NIN2 ! Number of vertices of NS2 within NS1
LOGICAL, SAVE :: TooManyFiguresMessage=.false.
LOGICAL, SAVE :: TooManyVerticesMessage=.false.
! Check for exceeding array limits.
#ifdef EP_Count_Calls
NumDetPolyOverlap_Calls=NumDetPolyOverlap_Calls+1
#endif
IF (NS3 > MAXHCS) THEN
OverlapStatus = TooManyFigures
IF (.not. TooManyFiguresMessage .and. .not. DisplayExtraWarnings) THEN
CALL ShowWarningError('DeterminePolygonOverlap: Too many figures [>'// &
TRIM(RoundSigDigits(MaxHCS))//'] detected in an overlap calculation.'// &
' Use Output:Diagnostics,DisplayExtraWarnings; for more details.')
TooManyFiguresMessage=.true.
ENDIF
IF (DisplayExtraWarnings) THEN
NumTooManyFigures=NumTooManyFigures+1
IF (NumTooManyFigures > 1) THEN
ALLOCATE(TempSurfErrorTracking(NumTooManyFigures))
TempSurfErrorTracking(1:NumTooManyFigures-1)=TrackTooManyFigures
DEALLOCATE(TrackTooManyFigures)
ALLOCATE(TrackTooManyFigures(NumTooManyFigures))
TrackTooManyFigures=TempSurfErrorTracking
DEALLOCATE(TempSurfErrorTracking)
ELSE
ALLOCATE(TrackTooManyFigures(NumTooManyFigures))
ENDIF
TrackTooManyFigures(NumTooManyFigures)%SurfIndex1=CurrentShadowingSurface
TrackTooManyFigures(NumTooManyFigures)%SurfIndex2=CurrentSurfaceBeingShadowed
ENDIF
RETURN
ENDIF
OverlapStatus = PartialOverlap
NV1 = HCNV(NS1)
NV2 = HCNV(NS2)
NV3 = 0
IF (.not. SutherlandHodgman) THEN
CALL INCLOS(NS1,NV1,NS2,NV2,NV3,NIN1) ! Find vertices of NS1 within NS2.
IF (NIN1 >= NV1) THEN
OverlapStatus = FirstSurfWithinSecond
ELSE
CALL INCLOS(NS2,NV2,NS1,NV1,NV3,NIN2) ! Find vertices of NS2 within NS1.
IF (NIN2 >= NV2) THEN
OverlapStatus = SecondSurfWithinFirst
ELSE
CALL INTCPT(NV1,NV2,NV3,NS1,NS2) ! Find intercepts of NS1 & NS2.
IF (NV3 < 3) THEN ! Overlap must have 3 or more vertices
OverlapStatus = NoOverlap
RETURN
END IF
END IF
END IF
ELSE
! simple polygon clipping
CALL CLIPPOLY(NS1,NS2,NV1,NV2,NV3)
ENDIF
IF (NV3 < MAXHCV .and. NS3 <= MAXHCS) THEN
IF (.not. SutherlandHodgman) THEN
CALL ORDER(NV3,NS3) ! Put vertices in clockwise order.
ELSE
DO N = 1, NV3
HCX(N,NS3)=NINT(XTEMP(N),i64)
HCY(N,NS3)=NINT(YTEMP(N),i64)
END DO
ENDIF
CALL HTRANS0(NS3,NV3) ! Determine h.c. values of sides.
! Skip overlaps of negligible area.
IF (ABS(HCAREA(NS3))*HCMULT < ABS(HCAREA(NS1))) THEN
OverlapStatus = NoOverlap
ELSE
IF (HCAREA(NS1)*HCAREA(NS2) > 0.0d0) HCAREA(NS3) = -HCAREA(NS3) ! Determine sign of area of overlap
HCT(NS3) = HCT(NS2)*HCT(NS1) ! Determine transmission of overlap
if (HCT(NS2) /= 1.0d0 .and. HCT(NS2) /= 0.0d0 .and. HCT(NS1) /= 1.0d0 .and. HCT(NS1) /= 0.0d0) then
if (HCT(NS2) >= .5d0 .and. HCT(NS1) >= .5d0) then
HCT(NS3)=1.0d0-HCT(NS3)
endif
endif
END IF
ELSEIF (NV3 > MAXHCV) THEN
OverlapStatus = TooManyVertices
IF (.not. TooManyVerticesMessage .and. .not. DisplayExtraWarnings) THEN
CALL ShowWarningError('DeterminePolygonOverlap: Too many vertices [>'// &
TRIM(RoundSigDigits(MaxHCV))//'] detected in an overlap calculation.'// &
' Use Output:Diagnostics,DisplayExtraWarnings; for more details.')
TooManyVerticesMessage=.true.
ENDIF
IF (DisplayExtraWarnings) THEN
NumTooManyVertices=NumTooManyVertices+1
IF (NumTooManyVertices > 1) THEN
ALLOCATE(TempSurfErrorTracking(NumTooManyVertices))
TempSurfErrorTracking(1:NumTooManyVertices-1)=TrackTooManyVertices
DEALLOCATE(TrackTooManyVertices)
ALLOCATE(TrackTooManyVertices(NumTooManyVertices))
TrackTooManyVertices=TempSurfErrorTracking
DEALLOCATE(TempSurfErrorTracking)
ELSE
ALLOCATE(TrackTooManyVertices(NumTooManyVertices))
ENDIF
TrackTooManyVertices(NumTooManyVertices)%SurfIndex1=CurrentShadowingSurface
TrackTooManyVertices(NumTooManyVertices)%SurfIndex2=CurrentSurfaceBeingShadowed
ENDIF
ELSEIF (NS3 > MAXHCS) THEN
OverlapStatus = TooManyFigures
IF (.not. TooManyFiguresMessage .and. .not. DisplayExtraWarnings) THEN
CALL ShowWarningError('DeterminePolygonOverlap: Too many figures [>'// &
TRIM(RoundSigDigits(MaxHCS))//'] detected in an overlap calculation.'// &
' Use Output:Diagnostics,DisplayExtraWarnings; for more details.')
TooManyFiguresMessage=.true.
ENDIF
IF (DisplayExtraWarnings) THEN
NumTooManyFigures=NumTooManyFigures+1
IF (NumTooManyFigures > 1) THEN
ALLOCATE(TempSurfErrorTracking(NumTooManyFigures))
TempSurfErrorTracking(1:NumTooManyFigures-1)=TrackTooManyFigures
DEALLOCATE(TrackTooManyFigures)
ALLOCATE(TrackTooManyFigures(NumTooManyFigures))
TrackTooManyFigures=TempSurfErrorTracking
DEALLOCATE(TempSurfErrorTracking)
ELSE
ALLOCATE(TrackTooManyFigures(NumTooManyFigures))
ENDIF
TrackTooManyFigures(NumTooManyFigures)%SurfIndex1=CurrentShadowingSurface
TrackTooManyFigures(NumTooManyFigures)%SurfIndex2=CurrentSurfaceBeingShadowed
ENDIF
ENDIF
RETURN
END SUBROUTINE DeterminePolygonOverlap