source: XIOS/dev/dev_olga/src/wait.f90 @ 1201

Last change on this file since 1201 was 501, checked in by ymipsl, 9 years ago

Add licence copyright to all file ond directory src using the command :
svn propset -R copyright -F header_licence src

XIOS is now officialy under CeCILL licence

YM

  • Property copyright set to
    Software name : XIOS (Xml I/O Server)
    http://forge.ipsl.jussieu.fr/ioserver
    Creation date : January 2009
    Licence : CeCCIL version2
    see license file in root directory : Licence_CeCILL_V2-en.txt
    or http://www.cecill.info/licences/Licence_CeCILL_V2-en.html
    Holder : CEA/LSCE (Laboratoire des Sciences du CLimat et de l'Environnement)
    CNRS/IPSL (Institut Pierre Simon Laplace)
    Project Manager : Yann Meurdesoif
    yann.meurdesoif@cea.fr
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.