pkg/runclock/runclock_gettime.F

1eeb28fe07 Alis*0001 #include "RUNCLOCK_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: RUNCLOCK_GETTIME
                0005 C     !INTERFACE:
                0006       SUBROUTINE RUNCLOCK_GETTIME( yr,mo,dy,hr,mi,sc,tins )
                0007
                0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
                0010 C     | SUBROUTINE RUNCLOCK_GETTIME
                0011 C     | o Routine to get wall clock time
                0012 C     *==========================================================*
                0013 C     \ev
                0014 C     !USES:
                0015       IMPLICIT NONE
                0016
                0017 C     === Global variables ===
                0018 #include "RUNCLOCK.h"
                0019
                0020 C     !INPUT/OUTPUT PARAMETERS:
                0021 C     === Routine arguments ===
                0022       INTEGER yr,mo,dy,hr,mi,sc
                0023       Real*8  tins
                0024
                0025 C     !LOCAL VARIABLES:
                0026 C     == Local variables ==
                0027 C     For use with DATE_AND_TIME
                0028       CHARACTER*(8)  DAT_DATE
                0029       CHARACTER*(10) DAT_TIME
                0030       CHARACTER*(5)  DAT_ZONE
                0031       INTEGER        DAT_VALS(10)
                0032 C     For use with TIMER_GET_TIME
                0033       Real*8 TM_userTime
                0034       Real*8 TM_systemTime
                0035       Real*8 TM_wallClockTime
                0036       INTEGER ms
                0037 CEOP
                0038
                0039 #ifdef ALLOW_RUNCLOCK
                0040
                0041 C     !LOCAL VARIABLES:
                0042 C     === Local variables ===
                0043       INTEGER tm
                0044
                0045 #ifdef RUNCLOCK_USES_DATE_AND_TIME
                0046       CALL date_and_time(DAT_DATE,DAT_TIME,DAT_ZONE,DAT_VALS)
                0047       ms=DAT_VALS(8)
                0048       sc=DAT_VALS(7)
                0049       mi=DAT_VALS(6)
                0050       hr=DAT_VALS(5)
                0051       dy=DAT_VALS(3)
                0052       mo=DAT_VALS(3)
                0053       yr=DAT_VALS(3)
                0054       tins=(((((yr-05)*12+mo)*30.+dy)*24.+hr)*60.+mi)*60.+sc+0.001*ms
                0055 #else
                0056       CALL timer_get_time(TM_userTime,TM_systemTime,TM_wallClockTime)
                0057       tm=int( TM_wallClockTime )
                0058        sc=mod(tm,60)
                0059       tm=(tm-sc)/60
                0060        mi=mod(tm,60)
                0061       tm=(tm-mi)/60
                0062        hr=mod(tm,24)
                0063       tm=(tm-hr)/24
                0064        dy=mod(tm,30)
                0065       tm=(tm-dy)/30
                0066        mo=mod(tm,12)
                0067        yr=(tm-mo)/12
                0068       ms=TM_wallClockTime-int( TM_wallClockTime )
                0069       tins=TM_wallClockTime
                0070 #endif /* RUNCLOCK_USES_DATE_AND_TIME */
                0071
                0072 c     write(0,*) 'RUNCLOCK_GETTIME: yr ... =',yr,mo,dy,hr,mi,sc,ms,tins
                0073
                0074 #endif /* ALLOW_RUNCLOCK */
                0075
                0076       RETURN
                0077       END