9 Integer,
Parameter :: kdp = selected_real_kind(15)
25 Real (kind=kdp),
Dimension (:),
Intent (In) :: xdont
26 Integer,
Dimension (:),
Intent (Out) :: irngt
28 Real (kind=kdp) :: xvala, xvalb
30 Integer,
Dimension (SIZE(IRNGT)) :: jwrkt
31 Integer :: lmtna, lmtnc, irng1, irng2
32 Integer :: nval, iind, iwrkd, iwrk, iwrkf, jinda, iinda, iindb
34 nval = min(
SIZE(xdont),
SIZE(irngt))
48 If (xdont(iind-1) <= xdont(iind))
Then
49 irngt(iind-1) = iind - 1
53 irngt(iind) = iind - 1
56 If (modulo(nval, 2) /= 0)
Then
73 Do iwrkd = 0, nval - 1, 4
74 If ((iwrkd+4) > nval)
Then
75 If ((iwrkd+2) >= nval)
Exit
79 If (xdont(irngt(iwrkd+2)) <= xdont(irngt(iwrkd+3)))
Exit
83 If (xdont(irngt(iwrkd+1)) <= xdont(irngt(iwrkd+3)))
Then
84 irng2 = irngt(iwrkd+2)
85 irngt(iwrkd+2) = irngt(iwrkd+3)
86 irngt(iwrkd+3) = irng2
91 irng1 = irngt(iwrkd+1)
92 irngt(iwrkd+1) = irngt(iwrkd+3)
93 irngt(iwrkd+3) = irngt(iwrkd+2)
94 irngt(iwrkd+2) = irng1
101 If (xdont(irngt(iwrkd+2)) <= xdont(irngt(iwrkd+3))) cycle
105 If (xdont(irngt(iwrkd+1)) <= xdont(irngt(iwrkd+3)))
Then
106 irng2 = irngt(iwrkd+2)
107 irngt(iwrkd+2) = irngt(iwrkd+3)
108 If (xdont(irng2) <= xdont(irngt(iwrkd+4)))
Then
110 irngt(iwrkd+3) = irng2
113 irngt(iwrkd+3) = irngt(iwrkd+4)
114 irngt(iwrkd+4) = irng2
120 irng1 = irngt(iwrkd+1)
121 irng2 = irngt(iwrkd+2)
122 irngt(iwrkd+1) = irngt(iwrkd+3)
123 If (xdont(irng1) <= xdont(irngt(iwrkd+4)))
Then
124 irngt(iwrkd+2) = irng1
125 If (xdont(irng2) <= xdont(irngt(iwrkd+4)))
Then
127 irngt(iwrkd+3) = irng2
130 irngt(iwrkd+3) = irngt(iwrkd+4)
131 irngt(iwrkd+4) = irng2
135 irngt(iwrkd+2) = irngt(iwrkd+4)
136 irngt(iwrkd+3) = irng1
137 irngt(iwrkd+4) = irng2
152 If (lmtna >= nval)
Exit
161 jinda = iwrkf + lmtna
162 iwrkf = iwrkf + lmtnc
163 If (iwrkf >= nval)
Then
164 If (jinda >= nval)
Exit
180 jwrkt(1:lmtna) = irngt(iwrkd:jinda)
182 xvala = xdont(jwrkt(iinda))
183 xvalb = xdont(irngt(iindb))
190 If (xvala > xvalb)
Then
191 irngt(iwrk) = irngt(iindb)
193 If (iindb > iwrkf)
Then
195 irngt(iwrk+1:iwrkf) = jwrkt(iinda:lmtna)
198 xvalb = xdont(irngt(iindb))
200 irngt(iwrk) = jwrkt(iinda)
202 If (iinda > lmtna) exit
203 xvala = xdont(jwrkt(iinda))
225 Real,
Dimension (:),
Intent (In) :: xdont
226 Integer,
Dimension (:),
Intent (Out) :: irngt
230 Integer,
Dimension (SIZE(IRNGT)) :: jwrkt
231 Integer :: lmtna, lmtnc, irng1, irng2
232 Integer :: nval, iind, iwrkd, iwrk, iwrkf, jinda, iinda, iindb
234 nval = min(
SIZE(xdont),
SIZE(irngt))
248 If (xdont(iind-1) <= xdont(iind))
Then
249 irngt(iind-1) = iind - 1
253 irngt(iind) = iind - 1
256 If (modulo(nval, 2) /= 0)
Then
273 Do iwrkd = 0, nval - 1, 4
274 If ((iwrkd+4) > nval)
Then
275 If ((iwrkd+2) >= nval)
Exit
279 If (xdont(irngt(iwrkd+2)) <= xdont(irngt(iwrkd+3)))
Exit
283 If (xdont(irngt(iwrkd+1)) <= xdont(irngt(iwrkd+3)))
Then
284 irng2 = irngt(iwrkd+2)
285 irngt(iwrkd+2) = irngt(iwrkd+3)
286 irngt(iwrkd+3) = irng2
291 irng1 = irngt(iwrkd+1)
292 irngt(iwrkd+1) = irngt(iwrkd+3)
293 irngt(iwrkd+3) = irngt(iwrkd+2)
294 irngt(iwrkd+2) = irng1
301 If (xdont(irngt(iwrkd+2)) <= xdont(irngt(iwrkd+3))) cycle
305 If (xdont(irngt(iwrkd+1)) <= xdont(irngt(iwrkd+3)))
Then
306 irng2 = irngt(iwrkd+2)
307 irngt(iwrkd+2) = irngt(iwrkd+3)
308 If (xdont(irng2) <= xdont(irngt(iwrkd+4)))
Then
310 irngt(iwrkd+3) = irng2
313 irngt(iwrkd+3) = irngt(iwrkd+4)
314 irngt(iwrkd+4) = irng2
320 irng1 = irngt(iwrkd+1)
321 irng2 = irngt(iwrkd+2)
322 irngt(iwrkd+1) = irngt(iwrkd+3)
323 If (xdont(irng1) <= xdont(irngt(iwrkd+4)))
Then
324 irngt(iwrkd+2) = irng1
325 If (xdont(irng2) <= xdont(irngt(iwrkd+4)))
Then
327 irngt(iwrkd+3) = irng2
330 irngt(iwrkd+3) = irngt(iwrkd+4)
331 irngt(iwrkd+4) = irng2
335 irngt(iwrkd+2) = irngt(iwrkd+4)
336 irngt(iwrkd+3) = irng1
337 irngt(iwrkd+4) = irng2
352 If (lmtna >= nval)
Exit
361 jinda = iwrkf + lmtna
362 iwrkf = iwrkf + lmtnc
363 If (iwrkf >= nval)
Then
364 If (jinda >= nval)
Exit
380 jwrkt(1:lmtna) = irngt(iwrkd:jinda)
382 xvala = xdont(jwrkt(iinda))
383 xvalb = xdont(irngt(iindb))
390 If (xvala > xvalb)
Then
391 irngt(iwrk) = irngt(iindb)
393 If (iindb > iwrkf)
Then
395 irngt(iwrk+1:iwrkf) = jwrkt(iinda:lmtna)
398 xvalb = xdont(irngt(iindb))
400 irngt(iwrk) = jwrkt(iinda)
402 If (iinda > lmtna) exit
403 xvala = xdont(jwrkt(iinda))
424 Integer,
Dimension (:),
Intent (In) :: xdont
425 Integer,
Dimension (:),
Intent (Out) :: irngt
427 Integer :: xvala, xvalb
429 Integer,
Dimension (SIZE(IRNGT)) :: jwrkt
430 Integer :: lmtna, lmtnc, irng1, irng2
431 Integer :: nval, iind, iwrkd, iwrk, iwrkf, jinda, iinda, iindb
433 nval = min(
SIZE(xdont),
SIZE(irngt))
447 If (xdont(iind-1) <= xdont(iind))
Then
448 irngt(iind-1) = iind - 1
452 irngt(iind) = iind - 1
455 If (modulo(nval, 2) /= 0)
Then
472 Do iwrkd = 0, nval - 1, 4
473 If ((iwrkd+4) > nval)
Then
474 If ((iwrkd+2) >= nval)
Exit
478 If (xdont(irngt(iwrkd+2)) <= xdont(irngt(iwrkd+3)))
Exit
482 If (xdont(irngt(iwrkd+1)) <= xdont(irngt(iwrkd+3)))
Then
483 irng2 = irngt(iwrkd+2)
484 irngt(iwrkd+2) = irngt(iwrkd+3)
485 irngt(iwrkd+3) = irng2
490 irng1 = irngt(iwrkd+1)
491 irngt(iwrkd+1) = irngt(iwrkd+3)
492 irngt(iwrkd+3) = irngt(iwrkd+2)
493 irngt(iwrkd+2) = irng1
500 If (xdont(irngt(iwrkd+2)) <= xdont(irngt(iwrkd+3))) cycle
504 If (xdont(irngt(iwrkd+1)) <= xdont(irngt(iwrkd+3)))
Then
505 irng2 = irngt(iwrkd+2)
506 irngt(iwrkd+2) = irngt(iwrkd+3)
507 If (xdont(irng2) <= xdont(irngt(iwrkd+4)))
Then
509 irngt(iwrkd+3) = irng2
512 irngt(iwrkd+3) = irngt(iwrkd+4)
513 irngt(iwrkd+4) = irng2
519 irng1 = irngt(iwrkd+1)
520 irng2 = irngt(iwrkd+2)
521 irngt(iwrkd+1) = irngt(iwrkd+3)
522 If (xdont(irng1) <= xdont(irngt(iwrkd+4)))
Then
523 irngt(iwrkd+2) = irng1
524 If (xdont(irng2) <= xdont(irngt(iwrkd+4)))
Then
526 irngt(iwrkd+3) = irng2
529 irngt(iwrkd+3) = irngt(iwrkd+4)
530 irngt(iwrkd+4) = irng2
534 irngt(iwrkd+2) = irngt(iwrkd+4)
535 irngt(iwrkd+3) = irng1
536 irngt(iwrkd+4) = irng2
551 If (lmtna >= nval)
Exit
560 jinda = iwrkf + lmtna
561 iwrkf = iwrkf + lmtnc
562 If (iwrkf >= nval)
Then
563 If (jinda >= nval)
Exit
579 jwrkt(1:lmtna) = irngt(iwrkd:jinda)
581 xvala = xdont(jwrkt(iinda))
582 xvalb = xdont(irngt(iindb))
589 If (xvala > xvalb)
Then
590 irngt(iwrk) = irngt(iindb)
592 If (iindb > iwrkf)
Then
594 irngt(iwrk+1:iwrkf) = jwrkt(iinda:lmtna)
597 xvalb = xdont(irngt(iindb))
599 irngt(iwrk) = jwrkt(iinda)
601 If (iinda > lmtna) exit
602 xvala = xdont(jwrkt(iinda))
subroutine d_mrgrnk(XDONT, IRNGT)
subroutine r_mrgrnk(XDONT, IRNGT)
subroutine i_mrgrnk(XDONT, IRNGT)