source: XMLIO_SERVER/trunk/src/IOSERVER/mod_wait.f90 @ 32

Last change on this file since 32 was 32, checked in by ymipsl, 13 years ago

Portage sur Vargas + correction sur IOSERVER : finalisation de la derniÚre requÚte

File size: 1.3 KB
Line 
1MODULE mod_wait
2  INTEGER, SAVE :: wait_param=10
3  REAL, SAVE    :: opt_param
4
5
6  INTEGER, SAVE :: last_count
7
8CONTAINS
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
68END MODULE mod_wait 
Note: See TracBrowser for help on using the repository browser.