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 | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | ZoneName | |||
integer, | intent(in) | :: | N | |||
real(kind=r64), | intent(out), | DIMENSION(N,N) | :: | F | ||
integer, | intent(in), | DIMENSION(N) | :: | SPtr | ||
logical, | intent(out) | :: | NoUserInputF | |||
logical, | intent(inout) | :: | ErrorsFound |
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 GetInputViewFactorsbyName(ZoneName,N,F,SPtr,NoUserInputF,ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Curt Pedersen
! DATE WRITTEN September 2005
! MODIFIED Linda Lawrie;September 2010
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine gets the user view factor info.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor, ONLY: GetNumObjectsFound,GetObjectItem,GetObjectItemNum,FindItemInList
USE General, ONLY: TrimSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(Len=*), INTENT(IN) :: ZoneName ! Needed to check for user input view factors.
INTEGER, INTENT (IN) :: N ! NUMBER OF SURFACES
REAL(r64), INTENT (OUT), DIMENSION(N,N) :: F ! USER INPUT DIRECT VIEW FACTOR MATRIX (N X N)
INTEGER, INTENT (IN), DIMENSION(N) :: SPtr ! pointer to actual surface number
LOGICAL, INTENT (OUT) :: NoUserInputF ! Flag signifying no input F's for this
LOGICAL, INTENT (INOUT) :: ErrorsFound ! True when errors are found in number of fields vs max args
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: UserFZoneIndex
INTEGER :: NumAlphas
INTEGER :: NumNums
INTEGER :: IOStat
INTEGER :: index
INTEGER :: numinx1
INTEGER :: inx1
INTEGER :: inx2
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: ZoneSurfaceNames
NoUserInputF = .true.
UserFZoneIndex=GetObjectItemNum('ZoneProperty:UserViewFactors:bySurfaceName',ZoneName)
IF (UserFZoneIndex > 0) THEN
ALLOCATE(ZoneSurfaceNames(N))
DO index=1,N
ZoneSurfaceNames(index)=Surface(SPtr(index))%Name
ENDDO
NoUserInputF = .false.
CALL GetObjectItem('ZoneProperty:UserViewFactors:bySurfaceName',UserFZoneIndex,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IF (NumNums < N**2) THEN
CALL ShowSevereError('GetInputViewFactors: '//trim(cCurrentModuleObject)// &
'="'//trim(ZoneName)//'", not enough values.')
CALL ShowContinueError('...Number of input values ['// &
TRIM(TrimSigDigits(NumNums))//'] is less than the required number=['// &
TRIM(TrimSigDigits(N**2))//'].')
ErrorsFound=.true.
NumNums=0 ! cancel getting any coordinates
ENDIF
F = 0.0d0
numinx1=0
DO index = 2, NumAlphas,2
inx1=FindItemInList(cAlphaArgs(index),ZoneSurfaceNames,N)
inx2=FindItemInList(cAlphaArgs(index+1),ZoneSurfaceNames,N)
IF (inx1 == 0) THEN
CALL ShowSevereError('GetInputViewFactors: '//trim(cCurrentModuleObject)// &
'="'//trim(ZoneName)//'", invalid surface name.')
CALL ShowContinueError('...Surface name="'//trim(cAlphaArgs(index))//'", not in this zone.')
ErrorsFound=.true.
ENDIF
IF (inx2 == 0) THEN
CALL ShowSevereError('GetInputViewFactors: '//trim(cCurrentModuleObject)// &
'="'//trim(ZoneName)//'", invalid surface name.')
CALL ShowContinueError('...Surface name="'//trim(cAlphaArgs(index+2))//'", not in this zone.')
ErrorsFound=.true.
ENDIF
numinx1=numinx1+1
IF (inx1 > 0 .and. inx2 > 0) F(inx1,inx2)=rNumericArgs(numinx1)
END DO
DEALLOCATE(ZoneSurfaceNames)
END IF
END SUBROUTINE GetInputViewFactorsbyName