source: XIOS/trunk/src/wait.f90 @ 470

Last change on this file since 470 was 349, checked in by ymipsl, 12 years ago

Add wait subroutine in fortran to simulate some active work from clients.

YM

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.