1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
SUBROUTINE intsrt(Nr,Vecx)
c-----------------------------------------------------------------------
c Returns sorted Vecx. Uses a shell sort.
c-----------------------------------------------------------------------
c Name Type Description
c-----------------------------------------------------------------------
c abss d Work pa long nr used vector to hold the sorted absolute
c values
c bot i Local index to the element at the bottom of the gap, i.e.
c index with the lower value.
c gap i Local distance between the records that are being compared.
c gap starts out at half the number of records and is halved
c until it reaches 1.
c i i Local do loop
c median d Output median of the absolute differences
c nabss i Work PARAMETER for the length of abss
c nr i Input row dimension of s
c nsrt i Local number of comparisons to make on one pass through the
c records
c pa i Local PARAMETER for the maximum number of innovation errors
c s d Input nr long vector to be sorted.
c tmp d Local temporary scalar
c top i Local index to the element at the top of the gap, i.e.
c index with the higher value and gap higher than bot.
c-----------------------------------------------------------------------
c Type the variables
c-----------------------------------------------------------------------
IMPLICIT NONE
c ------------------------------------------------------------------
INTEGER bot,gap,Nr,nsrt,top,Vecx,tmp
DIMENSION Vecx(Nr)
c-----------------------------------------------------------------------
c Use a Shell sort the nr records of Vecx. Compares records half
c the number of records apart, then keep halving the gap size until
c records next to eachother are compared.
c-----------------------------------------------------------------------
gap=Nr
DO WHILE (.true.)
gap=gap/2
IF(gap.gt.0)THEN
nsrt=Nr-gap
c-----------------------------------------------------------------------
c Compare and sort nsrt records that are gap records apart.
c-----------------------------------------------------------------------
bot=0
DO WHILE (.true.)
bot=bot+1
IF(bot.le.nsrt)THEN
DO WHILE (.true.)
c ------------------------------------------------------------------
top=bot+gap
c-----------------------------------------------------------------------
c See if Vecx(top) and Vecx(bot) need to be exchanged and switch
c them if they do.
c-----------------------------------------------------------------------
IF(Vecx(bot).le.Vecx(top))GO TO 10
tmp=Vecx(top)
Vecx(top)=Vecx(bot)
Vecx(bot)=tmp
c ------------------------------------------------------------------
IF(bot.le.gap)GO TO 10
bot=bot-gap
END DO
END IF
GO TO 20
10 CONTINUE
END DO
END IF
c ------------------------------------------------------------------
bot=Nr/2
c ------------------------------------------------------------------
RETURN
20 CONTINUE
END DO
END
|
