Last change
on this file since 1973 was
501,
checked in by ymipsl, 10 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
|
Rev | Line | |
---|
[349] | 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.