source:
vendors/XIOS/current/src/wait.f90
@
4187
Last change on this file since 4187 was 3428, checked in by rblod, 12 years ago | |
---|---|
File size: 1.3 KB |
Line | |
---|---|
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.