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(inout), | DIMENSION(:) | :: | Alphas | ||
integer, | intent(inout), | DIMENSION(:) | :: | iAlphas | ||
integer, | intent(inout) | :: | marker |
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 QsortPartition(Alphas,iAlphas,marker)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN March 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! <description>
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY: MaxNameLength
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(INOUT),DIMENSION(:) :: Alphas ! Alphas to be sorted
INTEGER, INTENT(INOUT),DIMENSION(:) :: iAlphas ! Pointers -- this is the array that is actually sorted
INTEGER, INTENT(INOUT) :: marker
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
integer :: i, j
integer :: itemp
CHARACTER(len=MaxNameLength*2) :: ctemp
CHARACTER(len=MaxNameLength*2) :: cpivot ! pivot point
cpivot = Alphas(1)
i= 0
j= size(Alphas) + 1
do
j = j-1
do
if (Alphas(j) <= cpivot) exit
j = j-1
end do
i = i+1
do
if (Alphas(i) >= cpivot) exit
i = i+1
end do
if (i < j) then
! exchange iAlphas(i) and iAlphas(j)
ctemp=Alphas(i)
Alphas(i)=Alphas(j)
Alphas(j)=ctemp
itemp = iAlphas(i)
iAlphas(i) = iAlphas(j)
iAlphas(j) = itemp
elseif (i == j) then
marker = i+1
return
else
marker = i
return
endif
end do
END SUBROUTINE QsortPartition