1!--------------------------------------------------------------------------------------------------!
2! Copyright (C) by the DBCSR developers group - All rights reserved                                !
3! This file is part of the DBCSR library.                                                          !
4!                                                                                                  !
5! For information on the license, see the LICENSE file.                                            !
6! For further information please visit https://dbcsr.cp2k.org                                      !
7! SPDX-License-Identifier: GPL-2.0+                                                                !
8!--------------------------------------------------------------------------------------------------!
9
10MODULE dbcsr_machine
11   USE ISO_FORTRAN_ENV, ONLY: input_unit, &
12                              output_unit
13   USE dbcsr_kinds, ONLY: default_string_length, &
14                          dp, &
15                          int_8
16   USE dbcsr_machine_internal, ONLY: &
17      m_abort, m_chdir, m_flush_internal => m_flush, m_getarg, m_getcwd, m_getlog, m_getpid, &
18      m_hostnm, m_iargc, m_memory, m_memory_details, m_memory_max, m_mov, m_procrun
19
20!$ USE OMP_LIB, ONLY: omp_get_max_threads, omp_get_thread_num, omp_get_num_threads, OMP_GET_WTIME
21
22   IMPLICIT NONE
23
24   ! Except for some error handling code, all code should
25   ! get a unit number from the print keys or from the logger, in order
26   ! to guarantee correct output behavior,
27   ! for example in farming or path integral runs
28   ! default_input_unit should never be used
29   ! but we need to know what it is, as we should not try to open it for output
30   INTEGER, PUBLIC, PARAMETER                   :: default_output_unit = output_unit, &
31                                                   default_input_unit = input_unit
32
33   PRIVATE
34
35   PUBLIC :: m_walltime, m_datum, m_flush, m_flush_internal, &
36             m_hostnm, m_getcwd, m_getlog, m_getpid, m_getarg, m_procrun, &
37             m_memory, m_iargc, m_abort, m_chdir, m_mov, m_memory_details, &
38             m_energy, m_memory_max, m_cpuinfo
39
40   ! should only be set according to the state in &GLOBAL
41   LOGICAL, SAVE, PUBLIC :: flush_should_flush = .FALSE.
42
43CONTAINS
44
45   SUBROUTINE m_flush(lunit)
46      !! flushes units if the &GLOBAL flag is set accordingly
47      !! @note
48      !! flushing might degrade performance significantly (30% and more)
49
50      INTEGER, INTENT(IN)                                :: lunit
51
52      IF (flush_should_flush) CALL m_flush_internal(lunit)
53   END SUBROUTINE
54   FUNCTION m_walltime() RESULT(wt)
55      !! returns time from a real-time clock, protected against rolling
56      !! early/easily
57      !! @note
58      !! same implementation for all machines.
59      !! might still roll, if not called multiple times per count_max/count_rate
60
61#if defined(__LIBXSMM)
62      USE libxsmm, ONLY: libxsmm_timer_tick, libxsmm_timer_duration
63#endif
64      REAL(KIND=dp)                                      :: wt
65
66#if defined(__LIBXSMM)
67      wt = libxsmm_timer_duration(0_int_8, libxsmm_timer_tick())
68#else
69
70      INTEGER(KIND=int_8)                                :: count
71      INTEGER(KIND=int_8), SAVE                          :: count_max, count_rate, cycles = -1, &
72                                                            last_count
73!$    IF (.FALSE.) THEN
74! count lies in [0,count_max] and increases monotonically
75
76         IF (cycles == -1) THEN ! get parameters of system_clock and initialise
77            CALL SYSTEM_CLOCK(count_rate=count_rate, count_max=count_max)
78            cycles = 0
79            last_count = 0
80         ENDIF
81
82         CALL SYSTEM_CLOCK(count=count)
83
84         ! protect against non-standard cases where time might be non-monotonous,
85         ! but it is unlikely that the clock cycled (e.g. underlying system clock adjustments)
86         ! i.e. if count is smaller than last_count by only a small fraction of count_max,
87         ! we use last_count instead
88         ! if count is smaller, we assume that the clock cycled.
89         IF (count < last_count) THEN
90            IF (last_count - count < count_max/100) THEN
91               count = last_count
92            ELSE
93               cycles = cycles + 1
94            ENDIF
95         ENDIF
96
97         ! keep track of our history
98         last_count = count
99
100         wt = (REAL(count, KIND=dp) + REAL(cycles, KIND=dp)*(1.0_dp + REAL(count_max, KIND=dp))) &
101              /REAL(count_rate, KIND=dp)
102!$    ELSE
103!$       wt = OMP_GET_WTIME()
104!$    ENDIF
105#endif
106   END FUNCTION m_walltime
107
108   SUBROUTINE m_cpuinfo(model_name)
109      !! reads /proc/cpuinfo if it exists (i.e. Linux) to return relevant info
110
111      CHARACTER(LEN=default_string_length)               :: model_name
112         !! as obtained from the 'model name' field, UNKNOWN otherwise
113
114      INTEGER, PARAMETER                                 :: bufferlen = 2048
115
116      CHARACTER(LEN=bufferlen)                           :: buffer
117      INTEGER                                            :: i, icol, iline, imod, stat
118
119      model_name = "UNKNOWN"
120      buffer = ""
121      OPEN (121245, FILE="/proc/cpuinfo", ACTION="READ", STATUS="OLD", ACCESS="STREAM", IOSTAT=stat)
122      IF (stat == 0) THEN
123         DO i = 1, bufferlen
124            READ (121245, END=999) buffer(I:I)
125         ENDDO
126999      CLOSE (121245)
127         imod = INDEX(buffer, "model name")
128         IF (imod > 0) THEN
129            icol = imod - 1 + INDEX(buffer(imod:), ":")
130            iline = icol - 1 + INDEX(buffer(icol:), NEW_LINE('A'))
131            IF (iline == icol - 1) iline = bufferlen + 1
132            model_name = buffer(icol + 1:iline - 1)
133         ENDIF
134      ENDIF
135   END SUBROUTINE m_cpuinfo
136
137   FUNCTION m_energy() RESULT(wt)
138      !! returns the energy used since some time in the past.
139      !! The precise meaning depends on the infrastructure is available.
140      !! In the cray_pm_energy case, this is the energy used by the node in kJ.
141
142      REAL(KIND=dp)                            :: wt
143
144#if defined(__CRAY_PM_ENERGY)
145      wt = read_energy("/sys/cray/pm_counters/energy")
146#elif defined(__CRAY_PM_ACCEL_ENERGY)
147      wt = read_energy("/sys/cray/pm_counters/accel_energy")
148#else
149      wt = 0.0 ! fallback default
150#endif
151
152   END FUNCTION m_energy
153
154#if defined(__CRAY_PM_ACCEL_ENERGY) || defined(__CRAY_PM_ENERGY)
155   FUNCTION read_energy(filename) RESULT(wt)
156      !! reads energy values from the sys-filesystem
157      CHARACTER(LEN=*)                                   :: filename
158      REAL(KIND=dp)                                      :: wt
159
160      CHARACTER(LEN=80)                                  :: DATA
161      INTEGER                                            :: i, iostat
162      INTEGER(KIND=int_8)                                :: raw
163
164      OPEN (121245, FILE=filename, ACTION="READ", STATUS="OLD", ACCESS="STREAM")
165      DO I = 1, 80
166         READ (121245, END=999) DATA(I:I)
167      ENDDO
168999   CLOSE (121245)
169      DATA(I:80) = ""
170      READ (DATA, *, IOSTAT=iostat) raw
171      IF (iostat .NE. 0) THEN
172         wt = 0.0_dp
173      ELSE
174         ! convert from J to kJ
175         wt = raw/1000.0_dp
176      ENDIF
177   END FUNCTION read_energy
178#endif
179
180   SUBROUTINE m_datum(cal_date)
181      !! returns a datum in human readable format using a standard Fortran routine
182      CHARACTER(len=*), INTENT(OUT)                      :: cal_date
183
184      CHARACTER(len=10)                                  :: time
185      CHARACTER(len=8)                                   :: date
186
187      CALL DATE_AND_TIME(date=date, time=time)
188      cal_date = date(1:4)//"-"//date(5:6)//"-"//date(7:8)//" "//time(1:2)//":"//time(3:4)//":"//time(5:10)
189
190   END SUBROUTINE m_datum
191
192END MODULE dbcsr_machine
193