Coverage Report: SortMod.f90

0

-

Source:SortMod.f90

0

-

Graph:SortMod.gcno

0

-

Data:SortMod.gcda

0

-

Runs:29

1

-

!! Provides an interface for performing an insertion sort on a vector

2

-

3

-

MODULE SortMod

4

-

!! Provides an interface for performing an insertion sort on a vector

5

-

6

-

! At the Ith step, the first I-1 positions contain a sorted

7

-

! vector. We shall insert the Ith value into its place in that

8

-

! vector shifting up to produce a new vector of length I.

9

-

10

-

IMPLICIT NONE

11

-

PUBLIC

12

-

13

-

INTEGER, PRIVATE :: ILeft, IMiddle, IRight, I

14

-

15

-

INTERFACE Sort

16

-

MODULE PROCEDURE Sort_sngl, Sort_dble, Sort_cmplx

17

-

END INTERFACE Sort

18

-

19

-

CONTAINS

20

-

21

42*

SUBROUTINE Sort_sngl( x, N )

22

-

!! Subroutine to perform an insertion sort on a vector (single)

23

-

24

-

INTEGER, INTENT( IN ) :: N

25

-

REAL, INTENT( INOUT ) :: x(:)

26

-

REAL :: xTemp

27

-

28

42

IF ( N == 1 ) RETURN

29

-

30

3311*

DO I = 2, N

31

-

32

3304*

xTemp = x( I )

33

-

34

3304*

IF ( xTemp < x( 1 ) ) THEN

35

#####

x( 2 : I ) = x( 1 : I - 1 )

36

#####

x( 1 ) = xTemp ! goes in the first position

37

3304*

ELSE IF ( xTemp < x( I - 1 ) ) THEN ! Binary search for its place

38

-

39

#####

IRight = I - 1

40

#####

ILeft = 1

41

-

42

#####

DO WHILE ( IRight > ILeft + 1 )

43

#####

IMiddle = ( ILeft + IRight ) / 2

44

#####

IF ( xTemp < x( IMiddle ) ) THEN

45

#####

IRight = IMiddle

46

-

ELSE

47

#####

ILeft = IMiddle

48

-

ENDIF

49

-

END DO

50

-

51

-

! Shift and insert

52

#####

x( IRight + 1 : I ) = x( IRight : I - 1 )

53

#####

x( IRight ) = xTemp

54

-

55

-

ENDIF

56

-

57

-

END DO

58

-

59

-

END SUBROUTINE Sort_sngl

60

-

61

-

! ________________________________________________________________________

62

-

63

14*

SUBROUTINE Sort_dble( x, N )

64

-

!! Subroutine to perform an insertion sort on a vector (double)

65

-

66

-

INTEGER, INTENT( IN ) :: N

67

-

REAL (KIND=8), INTENT( INOUT ) :: x(:)

68

-

REAL (KIND=8) :: xTemp

69

-

70

14*

IF ( N == 1 ) RETURN

71

-

72

55950*

DO I = 2, N

73

-

74

55936*

xTemp = x( I )

75

-

76

55936*

IF ( xTemp < x( 1 ) ) THEN

77

#####

x( 2 : I ) = x( 1 : I - 1 )

78

#####

x( 1 ) = xTemp ! goes in the first position

79

55936*

ELSE IF ( xTemp < x( I - 1 ) ) THEN ! Binary search for its place

80

-

81

#####

IRight = I - 1

82

#####

ILeft = 1

83

-

84

#####

DO WHILE ( IRight > ILeft + 1 )

85

#####

IMiddle = ( ILeft + IRight ) / 2

86

#####

IF ( xTemp < x( IMiddle ) ) THEN

87

#####

IRight = IMiddle

88

-

ELSE

89

#####

ILeft = IMiddle

90

-

ENDIF

91

-

END DO

92

-

93

-

! Shift and insert

94

#####

x( IRight + 1 : I ) = x( IRight : I - 1 )

95

#####

x( IRight ) = xTemp

96

-

97

-

ENDIF

98

-

99

-

END DO

100

-

101

-

END SUBROUTINE Sort_dble

102

-

103

-

! ________________________________________________________________________

104

-

105

#####

SUBROUTINE Sort_cmplx( x, N )

106

-

!! Subroutine to perform an insertion sort on a vector (complex, double)

107

-

108

-

! Based on order of decreasing real part

109

-

110

-

INTEGER, INTENT( IN ) :: N

111

-

COMPLEX (KIND=8), INTENT( INOUT ) :: x( N )

112

-

COMPLEX (KIND=8) :: xTemp

113

-

114

#####

IF ( N == 1 ) RETURN

115

-

116

#####

DO I = 2, N

117

-

118

#####

xTemp = x( I )

119

-

120

#####

IF ( REAL( xTemp ) > REAL( x( 1 ) ) ) THEN

121

#####

x( 2 : I ) = x( 1 : I - 1 )

122

#####

x( 1 ) = xTemp ! goes in the first position

123

#####

       ELSE IF ( REAL( xTemp ) > REAL( x( I - 1 ) ) ) THEN ! Binary search for its place

124

-

125

#####

IRight = I - 1

126

#####

ILeft = 1

127

-

128

#####

DO WHILE ( IRight > ILeft + 1 )

129

#####

IMiddle = ( ILeft + IRight ) / 2

130

-

131

#####

IF ( REAL( xTemp ) > REAL( x( IMiddle ) ) ) THEN

132

#####

IRight = IMiddle

133

-

ELSE

134

#####

ILeft = IMiddle

135

-

END IF

136

-

END DO

137

-

138

#####

x( IRight + 1 : I ) = x( IRight : I - 1 )

139

#####

x( IRight ) = xTemp

140

-

141

-

END IF

142

-

143

-

END DO

144

-

145

-

END SUBROUTINE Sort_cmplx

146

-

147

-

END MODULE SortMod

148

-

149

-