(git:15c1bfc)
Loading...
Searching...
No Matches
machine.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Machine interface based on Fortran 2003 and POSIX
10!> \par History
11!> JGH (05.07.2001) : added G95 interface
12!> - m_flush added (12.06.2002,MK)
13!> - Missing print_memory added (24.09.2002,MK)
14!> - Migrate to generic implementation based on F2003 + POSIX (2014, Ole Schuett)
15!> \author APSI, JGH, Ole Schuett
16! **************************************************************************************************
17MODULE machine
18 USE iso_c_binding, ONLY: c_char, &
19 c_int, &
20 c_ptr, &
21 c_null_char, &
22 c_associated
23 USE iso_fortran_env, ONLY: input_unit, &
24 output_unit
25 USE omp_lib, ONLY: omp_get_wtime
26 USE kinds, ONLY: default_path_length, &
28 dp, &
29 int_8
30#if defined(__LIBXSMM)
31#include "libxsmm_version.h"
32#if !defined(__LIBXSMM2) && (1 < __LIBXSMM || (1170000 < \
33 (libxsmm_config_version_major*1000000 + libxsmm_config_version_minor*10000 + libxsmm_config_version_update*100 + libxsmm_config_version_patch)))
34#define __LIBXSMM2
35#endif
36 USE libxsmm, ONLY: libxsmm_timer_tick, libxsmm_timer_duration, libxsmm_get_target_archid, &
37 libxsmm_target_arch_generic, libxsmm_x86_sse4, libxsmm_x86_avx, libxsmm_x86_avx2, &
38#if defined(__libxsmm2)
39 libxsmm_x86_avx512_skx, libxsmm_aarch64_v81, libxsmm_aarch64_sve128
40#else
41 libxsmm_x86_avx512_skx => libxsmm_x86_avx512_core
42#endif
43#endif
44
45 IMPLICIT NONE
46
47 ! Except for some error handling code, all code should
48 ! get a unit number from the print keys or from the logger, in order
49 ! to guarantee correct output behavior,
50 ! for example in farming or path integral runs
51 ! default_input_unit should never be used
52 ! but we need to know what it is, as we should not try to open it for output
53 INTEGER, PUBLIC, PARAMETER :: default_output_unit = output_unit, &
54 default_input_unit = input_unit, &
56
57#include "machine_cpuid.h"
58 ! Enumerates the target architectures or instruction set extensions.
59 ! A feature is present if within range for the respective architecture.
60 ! For example, to check for MACHINE_X86_AVX the following is true:
61 ! MACHINE_X86_AVX <= m_cpuid() and MACHINE_X86 >= m_cpuid().
62 ! For example, to check for MACHINE_ARM_SOME the following is true:
63 ! MACHINE_ARM_SOME <= m_cpuid() and MACHINE_ARM >= m_cpuid().
64 INTEGER, PUBLIC, PARAMETER :: &
65 machine_cpu_generic = cp_machine_cpu_generic, &
66 !
67 machine_x86_sse4 = cp_machine_x86_sse4, &
68 machine_x86_avx = cp_machine_x86_avx, &
69 machine_x86_avx2 = cp_machine_x86_avx2, &
70 machine_x86_avx512 = cp_machine_x86_avx512, &
72 !
73 machine_arm_arch64 = cp_machine_arm_arch64, &
74 machine_arm_sve128 = cp_machine_arm_sve128, &
75 machine_arm_sve256 = cp_machine_arm_sve256, &
76 machine_arm_sve512 = cp_machine_arm_sve512, &
78 !
79 ! other archs to be added as needed
80 machine_cpu_unknown = cp_machine_unknown ! marks end of range
81
82 PRIVATE
83
89
90 INTERFACE
91 ! **********************************************************************************************
92 !> \brief Target architecture or instruction set extension according to compiler target flags.
93 !> \return cpuid according to MACHINE_* integer-parameter.
94 !> \par History
95 !> 04.2019 created [Hans Pabst]
96 ! **********************************************************************************************
97 PURE FUNCTION m_cpuid_static() BIND(C)
98 IMPORT :: c_int
99 INTEGER(C_INT) :: m_cpuid_static
100 END FUNCTION m_cpuid_static
101
102 ! **********************************************************************************************
103 !> \brief Trace OpenMP constructs if ennvironment variable CP2K_OMP_TRACE=1.
104 !> \return Number of OpenMP issues encountered (negative if OMPT disabled).
105 !> \par History
106 !> 11.2024 created [Hans Pabst]
107 ! **********************************************************************************************
108 FUNCTION m_omp_trace_issues() BIND(C, name="openmp_trace_issues")
109 IMPORT :: c_int
110 INTEGER(C_INT) :: m_omp_trace_issues
111 END FUNCTION m_omp_trace_issues
112 END INTERFACE
113
114 ! Flushing is enabled by default because without it crash reports can get lost.
115 ! For performance reasons it can be disabled via the input in &GLOBAL.
116 LOGICAL, SAVE, PUBLIC :: flush_should_flush = .true.
117
118 INTEGER(KIND=int_8), SAVE, PUBLIC :: m_memory_max = 0
119
120CONTAINS
121
122! **************************************************************************************************
123!> \brief flushes units if the &GLOBAL flag is set accordingly
124!> \param lunit ...
125!> \par History
126!> 10.2008 created [Joost VandeVondele]
127!> \note
128!> flushing might degrade performance significantly (30% and more)
129! **************************************************************************************************
130 SUBROUTINE m_flush(lunit)
131 INTEGER, INTENT(IN) :: lunit
132
133 IF (flush_should_flush) FLUSH (lunit)
134
135 END SUBROUTINE
136
137! **************************************************************************************************
138!> \brief returns time from a real-time clock, protected against rolling
139!> early/easily
140!> \return ...
141!> \par History
142!> 03.2006 created [Joost VandeVondele]
143!> \note
144!> same implementation for all machines.
145!> might still roll, if not called multiple times per count_max/count_rate
146! **************************************************************************************************
147 FUNCTION m_walltime() RESULT(wt)
148 REAL(kind=dp) :: wt
149
150#if defined(__LIBXSMM)
151 wt = libxsmm_timer_duration(0_int_8, libxsmm_timer_tick())
152#else
153 wt = omp_get_wtime()
154#endif
155 END FUNCTION m_walltime
156
157! **************************************************************************************************
158!> \brief reads /proc/cpuinfo if it exists (i.e. Linux) to return relevant info
159!> \param model_name as obtained from the 'model name' field, UNKNOWN otherwise
160! **************************************************************************************************
161 SUBROUTINE m_cpuinfo(model_name)
162 CHARACTER(LEN=default_string_length), INTENT(OUT) :: model_name
163
164 INTEGER, PARAMETER :: bufferlen = 2048
165
166 CHARACTER(LEN=bufferlen) :: buffer
167 INTEGER :: i, icol, iline, stat
168
169 model_name = "UNKNOWN"
170 buffer = ""
171 OPEN (121245, file="/proc/cpuinfo", action="READ", status="OLD", access="STREAM", iostat=stat)
172 IF (stat == 0) THEN
173 DO i = 1, bufferlen
174 READ (121245, END=999) buffer(I:I)
175 END DO
176999 CLOSE (121245)
177 i = index(buffer, "model name")
178 IF (i > 0) THEN
179 icol = i - 1 + index(buffer(i:), ":")
180 iline = icol - 1 + index(buffer(icol:), new_line('A'))
181 IF (iline == icol - 1) iline = bufferlen + 1
182 model_name = buffer(icol + 1:iline - 1)
183 END IF
184 END IF
185 END SUBROUTINE m_cpuinfo
186
187! **************************************************************************************************
188!> \brief Target architecture or instruction set extension according to CPU-check at runtime.
189!> \return cpuid according to MACHINE_* integer-parameter.
190!> \par History
191!> 04.2019 created [Hans Pabst]
192!> 09.2024 update+arm [Hans Pabst]
193! **************************************************************************************************
194 PURE FUNCTION m_cpuid()
195 INTEGER :: m_cpuid
196#if defined(__LIBXSMM)
197 m_cpuid = libxsmm_get_target_archid()
198 IF (libxsmm_x86_sse4 <= m_cpuid .AND. m_cpuid < libxsmm_x86_avx) THEN
200 ELSE IF (libxsmm_x86_avx <= m_cpuid .AND. m_cpuid < libxsmm_x86_avx2) THEN
202 ELSE IF (libxsmm_x86_avx2 <= m_cpuid .AND. m_cpuid < libxsmm_x86_avx512_skx) THEN
204 ELSE IF (libxsmm_x86_avx512_skx <= m_cpuid .AND. m_cpuid <= 1999) THEN
206#if defined(__LIBXSMM2)
207 ELSE IF (libxsmm_aarch64_v81 <= m_cpuid .AND. m_cpuid < libxsmm_aarch64_sve128) THEN
209 ELSE IF (libxsmm_aarch64_sve128 <= m_cpuid .AND. m_cpuid < 2401) THEN ! LIBXSMM_AARCH64_SVE512
211 ELSE IF (2401 <= m_cpuid .AND. m_cpuid <= 2999) THEN
213#endif
214 ELSE IF (libxsmm_target_arch_generic <= m_cpuid .AND. m_cpuid <= 2999) THEN
216 ELSE
218 END IF
219#else
221#endif
222 END FUNCTION m_cpuid
223
224! **************************************************************************************************
225!> \brief Determine name of target architecture for a given CPUID.
226!> \param cpuid integer value (MACHINE_*)
227!> \return short name of ISA extension.
228!> \par History
229!> 06.2019 created [Hans Pabst]
230!> 09.2024 update+arm [Hans Pabst]
231! **************************************************************************************************
232 PURE FUNCTION m_cpuid_name(cpuid)
233 INTEGER, OPTIONAL, INTENT(IN) :: cpuid
234 CHARACTER(len=default_string_length) :: m_cpuid_name
235
236 INTEGER :: isa
237
238 IF (PRESENT(cpuid)) THEN
239 isa = cpuid
240 ELSE
241 isa = m_cpuid()
242 END IF
243
244 SELECT CASE (isa)
246 m_cpuid_name = "generic"
247 CASE (machine_x86_sse4)
248 m_cpuid_name = "x86_sse4"
249 CASE (machine_x86_avx)
250 m_cpuid_name = "x86_avx"
251 CASE (machine_x86_avx2)
252 m_cpuid_name = "x86_avx2"
253 CASE (machine_x86_avx512)
254 m_cpuid_name = "x86_avx512"
255 CASE (machine_arm_arch64)
256 m_cpuid_name = "arm_arch64"
257 CASE (machine_arm_sve128)
258 m_cpuid_name = "arm_sve128"
259 CASE (machine_arm_sve256)
260 m_cpuid_name = "arm_sve256"
261 CASE (machine_arm_sve512)
262 m_cpuid_name = "arm_sve512"
263 CASE DEFAULT
264 m_cpuid_name = "unknown"
265 END SELECT
266 END FUNCTION m_cpuid_name
267
268! **************************************************************************************************
269!> \brief Determine vector-length for a given CPUID.
270!> \param cpuid integer value (MACHINE_*)
271!> \param typesize number of bytes of scalar type
272!> \return vector-length in number of elements.
273!> \par History
274!> 12.2024 created [Hans Pabst]
275! **************************************************************************************************
276 PURE FUNCTION m_cpuid_vlen(cpuid, typesize)
277 INTEGER, OPTIONAL, INTENT(IN) :: cpuid, typesize
278
279 INTEGER :: isa, m_cpuid_vlen, nbytes
280
281 IF (PRESENT(typesize)) THEN
282 nbytes = typesize
283 ELSE
284 nbytes = 8 ! double-precision
285 END IF
286
287 IF (0 < nbytes .AND. nbytes <= 16) THEN ! sanity check
288 IF (PRESENT(cpuid)) THEN
289 isa = cpuid
290 ELSE
291 isa = m_cpuid()
292 END IF
293
294 SELECT CASE (isa)
295 CASE (machine_x86_sse4)
296 m_cpuid_vlen = 16/nbytes
297 CASE (machine_arm_arch64) ! NEON
298 m_cpuid_vlen = 16/nbytes
299 CASE (machine_arm_sve128)
300 m_cpuid_vlen = 16/nbytes
301 CASE (machine_x86_avx)
302 m_cpuid_vlen = 32/nbytes
303 CASE (machine_x86_avx2)
304 m_cpuid_vlen = 32/nbytes
305 CASE (machine_arm_sve256)
306 m_cpuid_vlen = 32/nbytes
307 CASE (machine_x86_avx512)
308 m_cpuid_vlen = 64/nbytes
309 CASE (machine_arm_sve512)
310 m_cpuid_vlen = 64/nbytes
311 CASE DEFAULT ! unknown or generic
312 m_cpuid_vlen = 1 ! scalar
313 END SELECT
314 ELSE ! fallback
315 m_cpuid_vlen = 1 ! scalar
316 END IF
317 END FUNCTION m_cpuid_vlen
318
319! **************************************************************************************************
320!> \brief returns the energy used since some time in the past.
321!> The precise meaning depends on the infrastructure is available.
322!> In the cray_pm_energy case, this is the energy used by the node in kJ.
323!> \return ...
324!> \par History
325!> 09.2013 created [Joost VandeVondele, Ole Schuett]
326! **************************************************************************************************
327 FUNCTION m_energy() RESULT(wt)
328 REAL(kind=dp) :: wt
329
330#if defined(__CRAY_PM_ENERGY)
331 wt = read_energy("/sys/cray/pm_counters/energy")
332#elif defined(__CRAY_PM_ACCEL_ENERGY)
333 wt = read_energy("/sys/cray/pm_counters/accel_energy")
334#else
335 wt = 0.0 ! fallback default
336#endif
337
338 END FUNCTION m_energy
339
340#if defined(__CRAY_PM_ACCEL_ENERGY) || defined(__CRAY_PM_ENERGY)
341! **************************************************************************************************
342!> \brief reads energy values from the sys-filesystem
343!> \param filename ...
344!> \return ...
345!> \par History
346!> 09.2013 created [Joost VandeVondele, Ole Schuett]
347! **************************************************************************************************
348 FUNCTION read_energy(filename) RESULT(wt)
349 CHARACTER(LEN=*) :: filename
350 REAL(kind=dp) :: wt
351
352 CHARACTER(LEN=80) :: data
353 INTEGER :: i, iostat
354 INTEGER(KIND=int_8) :: raw
355
356 OPEN (121245, file=filename, action="READ", status="OLD", access="STREAM")
357 DO i = 1, 80
358 READ (121245, END=999) DATA(I:I)
359 END DO
360999 CLOSE (121245)
361 DATA(i:80) = ""
362 READ (DATA, *, iostat=iostat) raw
363 IF (iostat .NE. 0) THEN
364 wt = 0.0_dp
365 ELSE
366 ! convert from J to kJ
367 wt = raw/1000.0_dp
368 END IF
369 END FUNCTION read_energy
370#endif
371
372! **************************************************************************************************
373!> \brief Returns a human readable timestamp
374!> \param timestamp Timestamp string
375!> \par History
376!> 10.2009 created [Joost VandeVondele]
377!> 08.2025 modified [Matthias Krack]
378! **************************************************************************************************
379 SUBROUTINE m_timestamp(timestamp)
380 CHARACTER(len=timestamp_length), INTENT(OUT) :: timestamp
381
382 CHARACTER(len=10) :: time
383 CHARACTER(len=8) :: date
384
385 CALL date_and_time(date=date, time=time)
386 timestamp = date(1:4)//"-"//date(5:6)//"-"//date(7:8)//" "// &
387 time(1:2)//":"//time(3:4)//":"//time(5:10)
388
389 END SUBROUTINE m_timestamp
390
391! **************************************************************************************************
392!> \brief Can be used to get a nice core
393! **************************************************************************************************
394 SUBROUTINE m_abort()
395 INTERFACE
396 SUBROUTINE abort() BIND(C, name="abort")
397 END SUBROUTINE
398 END INTERFACE
399
400 CALL abort()
401 END SUBROUTINE m_abort
402
403! **************************************************************************************************
404!> \brief Returns if a process is running on the local machine
405!> 1 if yes and 0 if not
406!> \param pid ...
407!> \return ...
408! **************************************************************************************************
409 FUNCTION m_procrun(pid) RESULT(run_on)
410 INTEGER, INTENT(IN) :: pid
411 INTEGER :: run_on
412#if defined(__MINGW)
413 run_on = 0
414#else
415 INTEGER :: istat
416
417 INTERFACE
418 FUNCTION kill(pid, sig) BIND(C, name="kill") RESULT(errno)
419 IMPORT
420 INTEGER(KIND=C_INT), VALUE :: pid, sig
421 INTEGER(KIND=C_INT) :: errno
422 END FUNCTION
423 END INTERFACE
424
425 ! If sig is 0, then no signal is sent, but error checking is still
426 ! performed; this can be used to check for the existence of a process
427 ! ID or process group ID.
428
429 istat = kill(pid=pid, sig=0)
430 IF (istat == 0) THEN
431 run_on = 1 ! no error, process exists
432 ELSE
433 run_on = 0 ! error, process probably does not exist
434 END IF
435#endif
436 END FUNCTION m_procrun
437
438! **************************************************************************************************
439!> \brief Returns the total amount of memory [bytes] in use, if known, zero otherwise
440!> \param mem ...
441! **************************************************************************************************
442 SUBROUTINE m_memory(mem)
443
444 INTEGER(KIND=int_8), OPTIONAL, INTENT(OUT) :: mem
445 INTEGER(KIND=int_8) :: mem_local
446
447 ! __NO_STATM_ACCESS can be used to disable the stuff, if getpagesize
448 ! lead to linking errors or /proc/self/statm can not be opened
449 !
450#if defined(__NO_STATM_ACCESS)
451 mem_local = 0
452#else
453 INTEGER(KIND=int_8) :: m1, m2, m3
454 CHARACTER(LEN=80) :: data
455 INTEGER :: iostat, i
456
457 ! the size of a page, might not be available everywhere
458 INTERFACE
459 FUNCTION getpagesize() BIND(C, name="getpagesize") RESULT(RES)
460 IMPORT
461 INTEGER(C_INT) :: res
462 END FUNCTION
463 END INTERFACE
464
465 ! reading from statm
466 !
467 mem_local = -1
468 DATA = ""
469 OPEN (121245, file="/proc/self/statm", action="READ", status="OLD", access="STREAM")
470 DO i = 1, 80
471 READ (121245, END=999) DATA(I:I)
472 END DO
473999 CLOSE (121245)
474 DATA(i:80) = ""
475 ! m1 = total
476 ! m2 = resident
477 ! m3 = shared
478 READ (DATA, *, iostat=iostat) m1, m2, m3
479 IF (iostat .NE. 0) THEN
480 mem_local = 0
481 ELSE
482 mem_local = m2
483#if defined(__STATM_TOTAL)
484 mem_local = m1
485#endif
486#if defined(__STATM_RESIDENT)
487 mem_local = m2
488#endif
489 mem_local = mem_local*getpagesize()
490 END IF
491#endif
492
493 m_memory_max = max(mem_local, m_memory_max)
494 IF (PRESENT(mem)) mem = mem_local
495
496 END SUBROUTINE m_memory
497
498! **************************************************************************************************
499!> \brief get more detailed memory info, all units are bytes.
500!> the only 'useful' option is MemLikelyFree which is an estimate of remaining memory
501!> assumed to give info like /proc/meminfo while MeMLikelyFree is the amount of
502!> memory we're likely to be able to allocate, but not necessarily in one chunk
503!> zero means not available...
504!> \param MemTotal ...
505!> \param MemFree ...
506!> \param Buffers ...
507!> \param Cached ...
508!> \param Slab ...
509!> \param SReclaimable ...
510!> \param MemLikelyFree ...
511! **************************************************************************************************
512 SUBROUTINE m_memory_details(MemTotal, MemFree, Buffers, Cached, Slab, SReclaimable, MemLikelyFree)
513
514 INTEGER(kind=int_8), OPTIONAL :: memtotal, memfree, buffers, cached, slab, sreclaimable, memlikelyfree
515
516 INTEGER, PARAMETER :: nbuffer = 10000
517 CHARACTER(LEN=Nbuffer) :: meminfo
518
519 INTEGER :: i
520
521 memtotal = 0
522 memfree = 0
523 buffers = 0
524 cached = 0
525 slab = 0
526 sreclaimable = 0
527 memlikelyfree = 0
528 meminfo = ""
529
530 OPEN (unit=8123, file="/proc/meminfo", access="STREAM", err=901)
531 i = 0
532 DO
533 i = i + 1
534 IF (i > nbuffer) EXIT
535 READ (8123, END=900, ERR=900) meminfo(i:i)
536 END DO
537900 CONTINUE
538 meminfo(i:nbuffer) = ""
539901 CONTINUE
540 CLOSE (8123, err=902)
541902 CONTINUE
542 memtotal = get_field_value_in_bytes('MemTotal:')
543 memfree = get_field_value_in_bytes('MemFree:')
544 buffers = get_field_value_in_bytes('Buffers:')
545 cached = get_field_value_in_bytes('Cached:')
546 slab = get_field_value_in_bytes('Slab:')
547 sreclaimable = get_field_value_in_bytes('SReclaimable:')
548 ! opinions here vary but this might work
549 memlikelyfree = memfree + buffers + cached + sreclaimable
550
551 CONTAINS
552
553! **************************************************************************************************
554!> \brief ...
555!> \param field ...
556!> \return ...
557! **************************************************************************************************
558 INTEGER(int_8) FUNCTION get_field_value_in_bytes(field)
559 CHARACTER(LEN=*) :: field
560
561 INTEGER :: start
562 INTEGER(KIND=int_8) :: value
563
564 get_field_value_in_bytes = 0
565 start = index(meminfo, field)
566 IF (start .NE. 0) THEN
567 start = start + len_trim(field)
568 IF (start .LT. nbuffer) THEN
569 READ (meminfo(start:), *, err=999, END=999) value
570 ! XXXXXXX convert from Kb to bytes XXXXXXXX
571 get_field_value_in_bytes = value*1024
572999 CONTINUE
573 END IF
574 END IF
575 END FUNCTION
576 END SUBROUTINE m_memory_details
577
578! **************************************************************************************************
579!> \brief ...
580!> \param hname ...
581! **************************************************************************************************
582 SUBROUTINE m_hostnm(hname)
583 CHARACTER(len=*), INTENT(OUT) :: hname
584#if defined(__MINGW)
585 ! While there is a gethostname in the Windows (POSIX) API, it requires that winsocks is
586 ! initialised prior to using it via WSAStartup(..), respectively cleaned up at the end via WSACleanup().
587 hname = "<unknown>"
588#else
589 INTEGER :: istat, i
590 CHARACTER(len=default_path_length) :: buf
591
592 INTERFACE
593 FUNCTION gethostname(buf, buflen) BIND(C, name="gethostname") RESULT(errno)
594 IMPORT
595 CHARACTER(KIND=C_CHAR), DIMENSION(*) :: buf
596 INTEGER(KIND=C_INT), VALUE :: buflen
597 INTEGER(KIND=C_INT) :: errno
598 END FUNCTION
599 END INTERFACE
600
601 istat = gethostname(buf, len(buf))
602 IF (istat /= 0) THEN
603 WRITE (*, *) "m_hostnm failed"
604 CALL m_abort()
605 END IF
606 i = index(buf, c_null_char) - 1
607 hname = buf(1:i)
608#endif
609 END SUBROUTINE m_hostnm
610
611! **************************************************************************************************
612!> \brief ...
613!> \param curdir ...
614! **************************************************************************************************
615 SUBROUTINE m_getcwd(curdir)
616 CHARACTER(len=*), INTENT(OUT) :: curdir
617 TYPE(c_ptr) :: stat
618 INTEGER :: i
619 CHARACTER(len=default_path_length), TARGET :: tmp
620
621 INTERFACE
622 FUNCTION getcwd(buf, buflen) BIND(C, name="getcwd") RESULT(stat)
623 IMPORT
624 CHARACTER(KIND=C_CHAR), DIMENSION(*) :: buf
625 INTEGER(KIND=C_INT), VALUE :: buflen
626 TYPE(c_ptr) :: stat
627 END FUNCTION
628 END INTERFACE
629
630 stat = getcwd(tmp, len(tmp))
631 IF (.NOT. c_associated(stat)) THEN
632 WRITE (*, *) "m_getcwd failed"
633 CALL m_abort()
634 END IF
635 i = index(tmp, c_null_char) - 1
636 curdir = tmp(1:i)
637 END SUBROUTINE m_getcwd
638
639! **************************************************************************************************
640!> \brief ...
641!> \param dir ...
642!> \param ierror ...
643! **************************************************************************************************
644 SUBROUTINE m_chdir(dir, ierror)
645 CHARACTER(len=*), INTENT(IN) :: dir
646 INTEGER, INTENT(OUT) :: ierror
647
648 INTERFACE
649 FUNCTION chdir(path) BIND(C, name="chdir") RESULT(errno)
650 IMPORT
651 CHARACTER(KIND=C_CHAR), DIMENSION(*) :: path
652 INTEGER(KIND=C_INT) :: errno
653 END FUNCTION
654 END INTERFACE
655
656 ierror = chdir(trim(dir)//c_null_char)
657 END SUBROUTINE m_chdir
658
659! **************************************************************************************************
660!> \brief ...
661!> \param pid ...
662! **************************************************************************************************
663 SUBROUTINE m_getpid(pid)
664 INTEGER, INTENT(OUT) :: pid
665
666 INTERFACE
667 FUNCTION getpid() BIND(C, name="getpid") RESULT(pid)
668 IMPORT
669 INTEGER(KIND=C_INT) :: pid
670 END FUNCTION
671 END INTERFACE
672
673 pid = getpid()
674 END SUBROUTINE m_getpid
675
676! **************************************************************************************************
677!> \brief ...
678!> \param path ...
679!> \return ...
680! **************************************************************************************************
681 FUNCTION m_unlink(path) RESULT(istat)
682
683 CHARACTER(LEN=*), INTENT(IN) :: path
684
685 INTEGER :: istat
686
687 INTERFACE
688 FUNCTION unlink(path) BIND(C, name="unlink") RESULT(errno)
689 IMPORT
690 CHARACTER(KIND=C_CHAR), DIMENSION(*) :: path
691 INTEGER(KIND=C_INT) :: errno
692 END FUNCTION
693 END INTERFACE
694
695 istat = unlink(trim(path)//c_null_char)
696 END FUNCTION m_unlink
697
698! **************************************************************************************************
699!> \brief ...
700!> \param source ...
701!> \param TARGET ...
702! **************************************************************************************************
703 SUBROUTINE m_mov(source, TARGET)
704
705 CHARACTER(LEN=*), INTENT(IN) :: source, target
706
707 INTEGER :: istat
708
709 INTERFACE
710 FUNCTION rename(src, dest) BIND(C, name="rename") RESULT(errno)
711 IMPORT
712 CHARACTER(KIND=C_CHAR), DIMENSION(*) :: src, dest
713 INTEGER(KIND=C_INT) :: errno
714 END FUNCTION
715 END INTERFACE
716
717 IF (TARGET == source) THEN
718 WRITE (*, *) "Warning: m_mov ", trim(TARGET), " equals ", trim(source)
719 RETURN
720 END IF
721
722 ! first remove target (needed on windows / mingw)
723 istat = m_unlink(TARGET)
724 ! ignore istat of unlink
725
726 ! now move
727 istat = rename(trim(source)//c_null_char, trim(TARGET)//c_null_char)
728 IF (istat .NE. 0) THEN
729 WRITE (*, *) "Trying to move "//trim(source)//" to "//trim(TARGET)//"."
730 WRITE (*, *) "rename returned status: ", istat
731 WRITE (*, *) "Problem moving file"
732 CALL m_abort()
733 END IF
734 END SUBROUTINE m_mov
735
736! **************************************************************************************************
737!> \brief ...
738!> \param user ...
739! **************************************************************************************************
740 SUBROUTINE m_getlog(user)
741
742 CHARACTER(LEN=*), INTENT(OUT) :: user
743
744 INTEGER :: istat
745
746 ! on a posix system LOGNAME should be defined
747 CALL get_environment_variable("LOGNAME", value=user, status=istat)
748 ! nope, check alternative
749 IF (istat /= 0) &
750 CALL get_environment_variable("USER", value=user, status=istat)
751 ! nope, check alternative
752 IF (istat /= 0) &
753 CALL get_environment_variable("USERNAME", value=user, status=istat)
754 ! fall back
755 IF (istat /= 0) &
756 user = "<unknown>"
757
758 END SUBROUTINE m_getlog
759
760! **************************************************************************************************
761!> \brief Retrieve environment variable OMP_STACKSIZE
762!> \param omp_stacksize Value of OMP_STACKSIZE
763! **************************************************************************************************
764 SUBROUTINE m_omp_get_stacksize(omp_stacksize)
765 CHARACTER(LEN=*), INTENT(OUT) :: omp_stacksize
766
767 INTEGER :: istat
768
769 omp_stacksize = ""
770 CALL get_environment_variable("OMP_STACKSIZE", value=omp_stacksize, status=istat)
771 ! Fall back, if OMP_STACKSIZE is not set
772 IF (istat /= 0) omp_stacksize = "default"
773
774 END SUBROUTINE m_omp_get_stacksize
775
776END MODULE machine
Target architecture or instruction set extension according to compiler target flags.
Definition machine.F:97
Trace OpenMP constructs if ennvironment variable CP2K_OMP_TRACE=1.
Definition machine.F:108
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public int_8
Definition kinds.F:54
integer, parameter, public dp
Definition kinds.F:34
integer, parameter, public default_string_length
Definition kinds.F:57
integer, parameter, public default_path_length
Definition kinds.F:58
Machine interface based on Fortran 2003 and POSIX.
Definition machine.F:17
integer, parameter, public machine_x86_avx
Definition machine.F:64
logical, save, public flush_should_flush
Definition machine.F:116
subroutine, public m_getpid(pid)
...
Definition machine.F:664
integer, parameter, public machine_arm_sve512
Definition machine.F:64
integer, parameter, public default_output_unit
Definition machine.F:53
integer, parameter, public machine_x86_sse4
Definition machine.F:64
subroutine, public m_memory(mem)
Returns the total amount of memory [bytes] in use, if known, zero otherwise.
Definition machine.F:443
integer, parameter, public machine_cpu_generic
Definition machine.F:64
integer, parameter, public default_input_unit
Definition machine.F:53
integer, parameter, public timestamp_length
Definition machine.F:53
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
Definition machine.F:131
integer, parameter, public machine_arm_sve256
Definition machine.F:64
integer, parameter, public machine_x86_avx2
Definition machine.F:64
subroutine, public m_abort()
Can be used to get a nice core.
Definition machine.F:395
subroutine, public m_timestamp(timestamp)
Returns a human readable timestamp.
Definition machine.F:380
integer function, public m_procrun(pid)
Returns if a process is running on the local machine 1 if yes and 0 if not.
Definition machine.F:410
subroutine, public m_memory_details(memtotal, memfree, buffers, cached, slab, sreclaimable, memlikelyfree)
get more detailed memory info, all units are bytes. the only 'useful' option is MemLikelyFree which i...
Definition machine.F:513
pure integer function, public m_cpuid()
Target architecture or instruction set extension according to CPU-check at runtime.
Definition machine.F:195
subroutine, public m_getcwd(curdir)
...
Definition machine.F:616
integer, parameter, public machine_x86
Definition machine.F:64
subroutine, public m_chdir(dir, ierror)
...
Definition machine.F:645
pure integer function, public m_cpuid_vlen(cpuid, typesize)
Determine vector-length for a given CPUID.
Definition machine.F:277
real(kind=dp) function, public m_energy()
returns the energy used since some time in the past. The precise meaning depends on the infrastructur...
Definition machine.F:328
integer, parameter, public machine_arm
Definition machine.F:64
subroutine, public m_cpuinfo(model_name)
reads /proc/cpuinfo if it exists (i.e. Linux) to return relevant info
Definition machine.F:162
subroutine, public m_mov(source, target)
...
Definition machine.F:704
pure character(len=default_string_length) function, public m_cpuid_name(cpuid)
Determine name of target architecture for a given CPUID.
Definition machine.F:233
integer, parameter, public machine_x86_avx512
Definition machine.F:64
integer, parameter, public machine_arm_arch64
Definition machine.F:64
subroutine, public m_omp_get_stacksize(omp_stacksize)
Retrieve environment variable OMP_STACKSIZE.
Definition machine.F:765
integer, parameter, public machine_cpu_unknown
Definition machine.F:64
integer(kind=int_8), save, public m_memory_max
Definition machine.F:118
integer, parameter, public machine_arm_sve128
Definition machine.F:64
subroutine, public m_getlog(user)
...
Definition machine.F:741
real(kind=dp) function, public m_walltime()
returns time from a real-time clock, protected against rolling early/easily
Definition machine.F:148
subroutine, public m_hostnm(hname)
...
Definition machine.F:583