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) | :: | OldIndex | |||
| integer, | intent(in) | :: | NewIndex |
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 ShiftPlantLoopSideCallingOrder(OldIndex, NewIndex)
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN <April 2011
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! re-arrange the calling order, move one loop side from an old index to a new one
! METHODOLOGY EMPLOYED:
! move
! REFERENCES:
! na
! USE STATEMENTS:
USE DataPlant
USE General, ONLY : RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: OldIndex
INTEGER, INTENT(IN) :: NewIndex
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
TYPE (PlantCallingOrderInfoStruct), ALLOCATABLE, DIMENSION(:) :: TempPlantCallingOrderInfo
TYPE (PlantCallingOrderInfoStruct) :: RecordToMoveInPlantCallingOrderInfo
IF (OldIndex == 0) THEN
CALL ShowSevereError('ShiftPlantLoopSideCallingOrder: developer error notice of invalid index, Old Index=0')
ENDIF
IF (NewIndex == 0) THEN
CALL ShowSevereError('ShiftPlantLoopSideCallingOrder: developer error notice of invalid index, New Index=1')
ENDIF
If ((OldIndex == 0) .or. (NewIndex == 0)) THEN
RETURN
ENDIF
IF (.not. ALLOCATED(TempPlantCallingOrderInfo) ) ALLOCATE ( TempPlantCallingOrderInfo(TotNumHalfLoops))
! store copy of prior structure
TempPlantCallingOrderInfo = PlantCallingOrderInfo
RecordToMoveInPlantCallingOrderInfo = PlantCallingOrderInfo(OldIndex)
IF (OldIndex == NewIndex) THEN
! do nothing, no shift needed.
ELSEIF ((OldIndex == 1) .AND. (NewIndex > OldIndex) .AND. (NewIndex < TotNumHalfLoops)) THEN
! example was: 1 2 3 4 5 6 7 8 (with OI = 1, NI = 5)
! example shifted: 2 3 4 5 1 6 7 8
PlantCallingOrderInfo(1:NewIndex -1) = TempPlantCallingOrderInfo(2:NewIndex)
PlantCallingOrderInfo(NewIndex) = RecordToMoveInPlantCallingOrderInfo
PlantCallingOrderInfo(NewIndex+1:TotNumHalfLoops) = TempPlantCallingOrderInfo(NewIndex+1:TotNumHalfLoops)
ELSEIF ((OldIndex == 1) .AND. (NewIndex > OldIndex) .AND. (NewIndex == TotNumHalfLoops)) THEN
! example was: 1 2 3 4 5 6 7 8 (with OI = 1, NI = 8)
! example shifted: 2 3 4 5 6 7 8 1
PlantCallingOrderInfo(1:NewIndex -1) = TempPlantCallingOrderInfo(2:NewIndex)
PlantCallingOrderInfo(NewIndex) = RecordToMoveInPlantCallingOrderInfo
ELSEIF ((OldIndex > 1) .AND. (NewIndex > OldIndex) .AND. (NewIndex < TotNumHalfLoops) ) THEN
! example was: 1 2 3 4 5 6 7 8 (with OI = 3, NI = 6)
! example shifted: 1 2 4 5 6 3 7 8
PlantCallingOrderInfo(1:OldIndex-1) = TempPlantCallingOrderInfo(1:OldIndex-1)
PlantCallingOrderInfo(OldIndex:NewIndex-1) = TempPlantCallingOrderInfo(OldIndex+1:NewIndex)
PlantCallingOrderInfo(NewIndex) = RecordToMoveInPlantCallingOrderInfo
PlantCallingOrderInfo(NewIndex+1:TotNumHalfLoops) = TempPlantCallingOrderInfo(NewIndex+1:TotNumHalfLoops)
ELSEIF ((OldIndex > 1) .AND. (NewIndex > OldIndex) .AND. (NewIndex == TotNumHalfLoops) ) THEN
! example was: 1 2 3 4 5 6 7 8 (with OI = 3, NI = 8)
! example shifted: 1 2 4 5 6 7 8 3
PlantCallingOrderInfo(1:OldIndex-1) = TempPlantCallingOrderInfo(1:OldIndex-1)
PlantCallingOrderInfo(OldIndex:NewIndex-1) = TempPlantCallingOrderInfo(OldIndex+1:NewIndex)
PlantCallingOrderInfo(NewIndex) = RecordToMoveInPlantCallingOrderInfo
ELSEIF((OldIndex > 1) .AND. (NewIndex < OldIndex) .AND. (NewIndex == 1) ) THEN
! example was: 1 2 3 4 5 6 7 8 (with OI = 3, NI = 1)
! example shifted: 3 1 2 4 5 6 7 8
PlantCallingOrderInfo(NewIndex) = RecordToMoveInPlantCallingOrderInfo
PlantCallingOrderInfo(NewIndex+1:OldIndex) = TempPlantCallingOrderInfo(1:OldIndex-1)
PlantCallingOrderInfo(OldIndex+1:TotNumHalfLoops) = TempPlantCallingOrderInfo(OldIndex+1:TotNumHalfLoops)
ELSEIF((OldIndex > 1) .AND. (NewIndex < OldIndex) .AND. (NewIndex > 1) ) THEN
! example was: 1 2 3 4 5 6 7 8 (with OI = 3, NI = 2)
! example shifted: 1 3 2 4 5 6 7 8
PlantCallingOrderInfo(1:NewIndex-1) = TempPlantCallingOrderInfo(1:NewIndex-1)
PlantCallingOrderInfo(NewIndex) = RecordToMoveInPlantCallingOrderInfo
PlantCallingOrderInfo(NewIndex+1:OldIndex) = TempPlantCallingOrderInfo(NewIndex:NewIndex +(OldIndex-NewIndex)-1)
PlantCallingOrderInfo(OldIndex+1:TotNumHalfLoops) = TempPlantCallingOrderInfo(OldIndex+1:TotNumHalfLoops)
ELSE
CALL ShowSevereError('ShiftPlantLoopSideCallingOrder: developer error notice, ' &
//'caught unexpected logical case in ShiftPlantLoopSideCallingOrder PlantUtilities')
ENDIF
RETURN
END SUBROUTINE ShiftPlantLoopSideCallingOrder