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.
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 WriteSurfaceShadowing
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer
! DATE WRITTEN July 2007
! MODIFIED January 2010, Kyle Benne
! Added SQLite output
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Write out tables based on which surfaces shade subsurfaces.
! METHODOLOGY EMPLOYED:
! Create arrays for the call to writeTable and then call it.
! Use <br> tag to put multiple rows into a single cell.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSurfaces, ONLY: Surface, TotSurfaces
USE DataShadowingCombinations
USE SQLiteProcedures, ONLY: CreateSQLiteTabularDataRecords
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! all arrays are in the format: (row, column)
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: columnHead
INTEGER,ALLOCATABLE,DIMENSION(:) :: columnWidth
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: rowHead
CHARACTER(len=2000),ALLOCATABLE, DIMENSION(:,:) :: tableBody
!CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: unique
INTEGER,ALLOCATABLE, DIMENSION(:) :: unique
INTEGER :: numUnique
!CHARACTER(len=MaxNameLength) :: curRecSurf
INTEGER :: curRecSurf
CHARACTER(len=2000) :: listOfSurf
INTEGER :: found
INTEGER :: iShadRel
INTEGER :: jUnique
INTEGER :: iKindRec
INTEGER :: numreceivingfields
INTEGER :: HTS
INTEGER :: NGSS
!displaySurfaceShadowing=.false. for debugging
IF (displaySurfaceShadowing) THEN
numreceivingfields=0
DO HTS=1,TotSurfaces
DO NGSS=1,ShadowComb(HTS)%NumGenSurf
numreceivingfields=numreceivingfields+1
ENDDO
DO NGSS=1,ShadowComb(HTS)%NumSubSurf
numreceivingfields=numreceivingfields+1
ENDDO
ENDDO
ALLOCATE(ShadowRelate(numreceivingfields))
numShadowRelate=0
DO HTS=1,TotSurfaces
DO NGSS=1,ShadowComb(HTS)%NumGenSurf
numShadowRelate=numShadowRelate+1
ShadowRelate(numShadowRelate)%castSurf = ShadowComb(HTS)%GenSurf(NGSS)
ShadowRelate(numShadowRelate)%recSurf = HTS
ShadowRelate(numShadowRelate)%recKind = recKindSurface
ENDDO
DO NGSS=1,ShadowComb(HTS)%NumSubSurf
numShadowRelate=numShadowRelate+1
ShadowRelate(numShadowRelate)%castSurf = ShadowComb(HTS)%SubSurf(NGSS)
ShadowRelate(numShadowRelate)%recSurf = HTS
ShadowRelate(numShadowRelate)%recKind = recKindSubsurface
ENDDO
ENDDO
CALL WriteReportHeaders('Surface Shadowing Summary','Entire Facility',isAverage)
ALLOCATE(unique(numShadowRelate))
!do entire process twice, once with surfaces receiving, once with subsurfaces receiving
DO iKindRec = recKindSurface,recKindSubsurface
numUnique = 0
!first find the number of unique
DO iShadRel = 1, numShadowRelate
IF (ShadowRelate(iShadRel)%recKind .EQ. iKindRec) THEN
curRecSurf = ShadowRelate(iShadRel)%recSurf
found = 0
DO jUnique = 1, numUnique
IF (curRecSurf .EQ. unique(jUnique)) THEN
found = jUnique
EXIT
END IF
END DO
IF (found .EQ. 0) THEN
numUnique = numUnique + 1
unique(numUnique) = curRecSurf
END IF
END IF
END DO
ALLOCATE(rowHead(numUnique))
ALLOCATE(columnHead(1))
ALLOCATE(columnWidth(1))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(numUnique,1))
columnHead(1) = 'Possible Shadow Receivers'
IF (numUnique == 0) columnHead(1) = 'None'
DO jUnique = 1,numUnique
curRecSurf = unique(jUnique)
rowHead(jUnique) = Surface(curRecSurf)%Name
listOfSurf = ''
DO iShadRel = 1, numShadowRelate
IF (ShadowRelate(iShadRel)%recKind .EQ. iKindRec) THEN
IF (curRecSurf .EQ. ShadowRelate(iShadRel)%recSurf) THEN
listOfSurf = TRIM(listOfSurf) // TRIM(Surface(ShadowRelate(iShadRel)%castSurf)%Name) // ' | ' !'<br>'
END IF
END IF
END DO
tableBody(jUnique,1) = listOfSurf
END DO
!write the table
SELECT CASE (iKindRec)
CASE (recKindSurface)
CALL writeSubtitle('Surfaces (Walls, Roofs, etc) that may be Shadowed by Other Surfaces ')
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'SurfaceShadowingSummary',&
'Entire Facility',&
'Surfaces (Walls, Roofs, etc) that may be Shadowed by Other Surfaces ')
CASE (recKindSubsurface)
CALL writeSubtitle('Subsurfaces (Windows and Doors) that may be Shadowed by Surfaces ')
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'SurfaceShadowingSummary',&
'Entire Facility',&
'Subsurfaces (Windows and Doors) that may be Shadowed by Surfaces ')
END SELECT
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
!deallocate these arrays since they are used to create the next
!table
DEALLOCATE(rowHead)
DEALLOCATE(columnHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
END DO
DEALLOCATE(unique)
END IF
END SUBROUTINE WriteSurfaceShadowing