Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | ConstrNum | |||
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.
FUNCTION AssignReverseConstructionNumber(ConstrNum,ErrorsFound) RESULT(NewConstrNum)
! FUNCTION INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN December 2006
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS FUNCTION:
! For interzone, unentered surfaces, we need to have "reverse" constructions
! assigned to the created surfaces. These need to be the reverse (outside to inside layer)
! of existing surfaces. Plus, there may be one already in the data structure so this is looked for as well.
! METHODOLOGY EMPLOYED:
! Create reverse layers. Look in current constructions to see if match. If no match, create a new one.
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! FUNCTION ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: ConstrNum ! Existing Construction number of first surface
LOGICAL, INTENT(INOUT) :: ErrorsFound
INTEGER :: NewConstrNum ! Reverse Construction Number
! FUNCTION PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! FUNCTION LOCAL VARIABLE DECLARATIONS:
INTEGER :: LayerPoint(MaxLayersInConstruct) = 0 ! Pointer array which refers back to
INTEGER :: nLayer
INTEGER :: Loop
LOGICAL :: Found
IF (ConstrNum == 0) THEN
! error caught elsewhere
NewConstrNum=0
RETURN
ENDIF
Construct(ConstrNum)%IsUsed=.true.
nLayer=0
LayerPoint=0
DO Loop=Construct(ConstrNum)%TotLayers,1,-1
nLayer=nLayer+1
LayerPoint(nLayer)=Construct(ConstrNum)%LayerPoint(Loop)
ENDDO
! now, got thru and see if there is a match already....
NewConstrNum=0
DO Loop=1,TotConstructs
Found=.true.
DO nLayer=1,MaxLayersInConstruct
IF (Construct(Loop)%LayerPoint(nLayer) /= LayerPoint(nLayer)) THEN
Found=.false.
EXIT
ENDIF
ENDDO
IF (Found) THEN
NewConstrNum=Loop
EXIT
ENDIF
ENDDO
! if need new one, bunch o stuff
IF (NewConstrNum == 0) THEN
ALLOCATE(ConstructSave(TotConstructs+1))
ConstructSave(1:TotConstructs)=Construct(1:TotConstructs)
ALLOCATE(NominalRSave(TotConstructs+1))
ALLOCATE(NominalUSave(TotConstructs+1))
NominalRSave=0.0d0
NominalRSave(1:TotConstructs)=NominalRforNominalUCalculation(1:TotConstructs)
NominalUSave=0.0d0
NominalUSave(1:TotConstructs)=NominalU(1:TotConstructs)
TotConstructs=TotConstructs+1
DEALLOCATE(Construct)
DEALLOCATE(NominalRforNominalUCalculation)
DEALLOCATE(NominalU)
ALLOCATE(Construct(TotConstructs))
Construct=ConstructSave
DEALLOCATE(ConstructSave)
ALLOCATE(NominalRforNominalUCalculation(TotConstructs))
ALLOCATE(NominalU(TotConstructs))
NominalRforNominalUCalculation=NominalRSave
NominalU=NominalUSave
DEALLOCATE(NominalRSave)
DEALLOCATE(NominalUSave)
! Put in new attributes
NewConstrNum=TotConstructs
Construct(NewConstrNum)%IsUsed=.true.
Construct(TotConstructs)=Construct(ConstrNum) ! preserve some of the attributes.
! replace others...
Construct(TotConstructs)%Name='iz-'//TRIM(Construct(ConstrNum)%Name)
Construct(TotConstructs)%TotLayers=Construct(ConstrNum)%TotLayers
DO nLayer=1,MaxLayersInConstruct
Construct(TotConstructs)%LayerPoint(nLayer)=LayerPoint(nLayer)
IF (LayerPoint(nLayer) /= 0) THEN
NominalRforNominalUCalculation(TotConstructs)=NominalRforNominalUCalculation(TotConstructs)+NominalR(LayerPoint(nLayer))
ENDIF
ENDDO
! no error if zero -- that will have been caught with earlier construction
! the following line was changed to fix CR7601
IF (NominalRforNominalUCalculation(TotConstructs) /= 0.0d0) THEN
NominalU(TotConstructs)=1.0/NominalRforNominalUCalculation(TotConstructs)
ENDIF
CALL CheckAndSetConstructionProperties(TotConstructs,ErrorsFound)
ENDIF
RETURN
END FUNCTION AssignReverseConstructionNumber