source:
vendors/XMLIO_SERVER/current/src/IOSERVER/mod_wait.f90
@
2765
Last change on this file since 2765 was 1897, checked in by flavoni, 14 years ago | |
---|---|
File size: 1.3 KB |
Rev | Line | |
---|---|---|
[1897] | 1 | MODULE mod_wait |
2 | INTEGER, SAVE :: wait_param=10 | |
3 | REAL, SAVE :: opt_param | |
4 | ||
5 | ||
6 | INTEGER, SAVE :: last_count | |
7 | ||
8 | CONTAINS | |
9 | ||
10 | ||
11 | FUNCTION Top() | |
12 | IMPLICIT NONE | |
13 | DOUBLE PRECISION :: Top | |
14 | INTEGER :: count,count_rate,count_max | |
15 | LOGICAL, SAVE :: first=.TRUE. | |
16 | ||
17 | ||
18 | CALL system_clock(count,count_rate,count_max) | |
19 | IF (first) THEN | |
20 | Top=0. | |
21 | ELSE | |
22 | IF (Count>=Last_Count) THEN | |
23 | Top=(1.*(Count-last_Count))/count_rate | |
24 | ELSE | |
25 | Top=(1.*(Count-last_Count+Count_max))/count_rate | |
26 | ENDIF | |
27 | ENDIF | |
28 | Last_Count=Count | |
29 | first=.FALSE. | |
30 | END FUNCTION Top | |
31 | ||
32 | SUBROUTINE Init_wait | |
33 | IMPLICIT NONE | |
34 | INTEGER :: i,j | |
35 | LOGICAL :: out_ok | |
36 | DOUBLE PRECISION :: time | |
37 | INTEGER :: last_param | |
38 | ||
39 | out_ok=.FALSE. | |
40 | ||
41 | DO WHILE (.NOT. out_ok) | |
42 | opt_param=0. | |
43 | ||
44 | time=top() | |
45 | !CDIR NOVECTOR | |
46 | DO i=1,1000000*wait_param | |
47 | opt_param=opt_param+(i/(i+opt_param)) | |
48 | ENDDO | |
49 | time=top() | |
50 | last_param=wait_param | |
51 | wait_param=wait_param*(1./time) | |
52 | IF (ABS(wait_param-last_param)/(0.5*(wait_param+last_param)) <0.01) out_ok=.TRUE. | |
53 | END DO | |
54 | END SUBROUTINE Init_wait | |
55 | ||
56 | SUBROUTINE Wait_us(n) | |
57 | IMPLICIT NONE | |
58 | INTEGER :: n | |
59 | INTEGER :: i | |
60 | ||
61 | !CDIR NOVECTOR | |
62 | DO i=1,n*wait_param | |
63 | opt_param=opt_param+(i/(i+opt_param)) | |
64 | ENDDO | |
65 | ||
66 | END SUBROUTINE Wait_us | |
67 | ||
68 | END MODULE mod_wait |
Note: See TracBrowser
for help on using the repository browser.