!--------------------------------------------------------------------------------------------------!
!   CP2K: A general program to perform molecular dynamics simulations                              !
!   Copyright 2000-2025 CP2K developers group <https://cp2k.org>                                   !
!                                                                                                  !
!   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
!--------------------------------------------------------------------------------------------------!

! **************************************************************************************************
!> \brief Machine interface based on Fortran 2003 and POSIX
!> \par History
!>      JGH (05.07.2001) : added G95 interface
!>      - m_flush added (12.06.2002,MK)
!>      - Missing print_memory added (24.09.2002,MK)
!>      - Migrate to generic implementation based on F2003 + POSIX (2014, Ole Schuett)
!> \author APSI, JGH, Ole Schuett
! **************************************************************************************************
MODULE machine
   USE ISO_C_BINDING, ONLY: C_CHAR, &
                            C_INT, &
                            C_PTR, &
                            C_NULL_CHAR, &
                            C_ASSOCIATED
   USE ISO_FORTRAN_ENV, ONLY: input_unit, &
                              output_unit
   USE omp_lib, ONLY: omp_get_wtime
   USE kinds, ONLY: default_path_length, &
                    default_string_length, &
                    dp, &
                    int_8
#if defined(__LIBXSMM)
#include "libxsmm_version.h"
#if !defined(__LIBXSMM2) && (1 < __LIBXSMM || (1170000 < \
   (LIBXSMM_CONFIG_VERSION_MAJOR*1000000 + LIBXSMM_CONFIG_VERSION_MINOR*10000 + LIBXSMM_CONFIG_VERSION_UPDATE*100 + LIBXSMM_CONFIG_VERSION_PATCH)))
#define __LIBXSMM2
#endif
   USE libxsmm, ONLY: libxsmm_timer_tick, libxsmm_timer_duration, libxsmm_get_target_archid, &
                      LIBXSMM_TARGET_ARCH_GENERIC, LIBXSMM_X86_SSE4, LIBXSMM_X86_AVX, LIBXSMM_X86_AVX2, &
#if defined(__LIBXSMM2)
                      LIBXSMM_X86_AVX512_SKX, LIBXSMM_AARCH64_V81, LIBXSMM_AARCH64_SVE128
#else
   LIBXSMM_X86_AVX512_SKX => LIBXSMM_X86_AVX512_CORE
#endif
#endif

   IMPLICIT NONE

   ! Except for some error handling code, all code should
   ! get a unit number from the print keys or from the logger, in order
   ! to guarantee correct output behavior,
   ! for example in farming or path integral runs
   ! default_input_unit should never be used
   ! but we need to know what it is, as we should not try to open it for output
   INTEGER, PUBLIC, PARAMETER                   :: default_output_unit = output_unit, &
                                                   default_input_unit = input_unit

#include "machine_cpuid.h"
   ! Enumerates the target architectures or instruction set extensions.
   ! A feature is present if within range for the respective architecture.
   ! For example, to check for MACHINE_X86_AVX the following is true:
   ! MACHINE_X86_AVX <= m_cpuid() and MACHINE_X86 >= m_cpuid().
   ! For example, to check for MACHINE_ARM_SOME the following is true:
   ! MACHINE_ARM_SOME <= m_cpuid() and MACHINE_ARM >= m_cpuid().
   INTEGER, PUBLIC, PARAMETER :: &
      MACHINE_CPU_GENERIC = CP_MACHINE_CPU_GENERIC, &
      !
      MACHINE_X86_SSE4 = CP_MACHINE_X86_SSE4, &
      MACHINE_X86_AVX = CP_MACHINE_X86_AVX, &
      MACHINE_X86_AVX2 = CP_MACHINE_X86_AVX2, &
      MACHINE_X86_AVX512 = CP_MACHINE_X86_AVX512, &
      MACHINE_X86 = MACHINE_X86_AVX512, &
      !
      MACHINE_ARM_ARCH64 = CP_MACHINE_ARM_ARCH64, &
      MACHINE_ARM_SVE128 = CP_MACHINE_ARM_SVE128, &
      MACHINE_ARM_SVE256 = CP_MACHINE_ARM_SVE256, &
      MACHINE_ARM_SVE512 = CP_MACHINE_ARM_SVE512, &
      MACHINE_ARM = MACHINE_ARM_SVE512, &
      !
      ! other archs to be added as needed
      MACHINE_CPU_UNKNOWN = CP_MACHINE_UNKNOWN ! marks end of range

   PRIVATE

   PUBLIC :: m_walltime, m_datum, m_hostnm, m_flush, &
             m_getcwd, m_getlog, m_getpid, m_procrun, m_abort, &
             m_chdir, m_mov, m_memory, m_memory_details, m_energy, &
             m_cpuinfo, m_cpuid_static, m_cpuid, m_cpuid_name, &
             m_cpuid_vlen, m_omp_get_stacksize, m_omp_trace_issues

   INTERFACE
      ! **********************************************************************************************
      !> \brief Target architecture or instruction set extension according to compiler target flags.
      !> \return cpuid according to MACHINE_* integer-parameter.
      !> \par History
      !>      04.2019 created [Hans Pabst]
      ! **********************************************************************************************
      PURE FUNCTION m_cpuid_static() BIND(C)
         IMPORT :: C_INT
         INTEGER(C_INT) :: m_cpuid_static
      END FUNCTION m_cpuid_static

      ! **********************************************************************************************
      !> \brief Trace OpenMP constructs if ennvironment variable CP2K_OMP_TRACE=1.
      !> \return Number of OpenMP issues encountered (negative if OMPT disabled).
      !> \par History
      !>      11.2024 created [Hans Pabst]
      ! **********************************************************************************************
      FUNCTION m_omp_trace_issues() BIND(C, name="openmp_trace_issues")
         IMPORT :: C_INT
         INTEGER(C_INT) :: m_omp_trace_issues
      END FUNCTION m_omp_trace_issues
   END INTERFACE

   ! Flushing is enabled by default because without it crash reports can get lost.
   ! For performance reasons it can be disabled via the input in &GLOBAL.
   LOGICAL, SAVE, PUBLIC :: flush_should_flush = .TRUE.

   INTEGER(KIND=int_8), SAVE, PUBLIC :: m_memory_max = 0

CONTAINS

! **************************************************************************************************
!> \brief flushes units if the &GLOBAL flag is set accordingly
!> \param lunit ...
!> \par History
!>      10.2008 created [Joost VandeVondele]
!> \note
!>      flushing might degrade performance significantly (30% and more)
! **************************************************************************************************
   SUBROUTINE m_flush(lunit)
      INTEGER, INTENT(IN)                                :: lunit

      IF (flush_should_flush) FLUSH (lunit)

   END SUBROUTINE

! **************************************************************************************************
!> \brief returns time from a real-time clock, protected against rolling
!>      early/easily
!> \return ...
!> \par History
!>      03.2006 created [Joost VandeVondele]
!> \note
!>      same implementation for all machines.
!>      might still roll, if not called multiple times per count_max/count_rate
! **************************************************************************************************
   FUNCTION m_walltime() RESULT(wt)
      REAL(KIND=dp)                                      :: wt

#if defined(__LIBXSMM)
      wt = libxsmm_timer_duration(0_int_8, libxsmm_timer_tick())
#else
      wt = omp_get_wtime()
#endif
   END FUNCTION m_walltime

! **************************************************************************************************
!> \brief reads /proc/cpuinfo if it exists (i.e. Linux) to return relevant info
!> \param model_name as obtained from the 'model name' field, UNKNOWN otherwise
! **************************************************************************************************
   SUBROUTINE m_cpuinfo(model_name)
      CHARACTER(LEN=default_string_length), INTENT(OUT)  :: model_name

      INTEGER, PARAMETER                                 :: bufferlen = 2048

      CHARACTER(LEN=bufferlen)                           :: buffer
      INTEGER                                            :: i, icol, iline, stat

      model_name = "UNKNOWN"
      buffer = ""
      OPEN (121245, FILE="/proc/cpuinfo", ACTION="READ", STATUS="OLD", ACCESS="STREAM", IOSTAT=stat)
      IF (stat == 0) THEN
         DO i = 1, bufferlen
            READ (121245, END=999) buffer(I:I)
         END DO
999      CLOSE (121245)
         i = INDEX(buffer, "model name")
         IF (i > 0) THEN
            icol = i - 1 + INDEX(buffer(i:), ":")
            iline = icol - 1 + INDEX(buffer(icol:), NEW_LINE('A'))
            IF (iline == icol - 1) iline = bufferlen + 1
            model_name = buffer(icol + 1:iline - 1)
         END IF
      END IF
   END SUBROUTINE m_cpuinfo

! **************************************************************************************************
!> \brief Target architecture or instruction set extension according to CPU-check at runtime.
!> \return cpuid according to MACHINE_* integer-parameter.
!> \par History
!>      04.2019 created [Hans Pabst]
!>      09.2024 update+arm [Hans Pabst]
! **************************************************************************************************
   PURE FUNCTION m_cpuid()
      INTEGER :: m_cpuid
#if defined(__LIBXSMM)
      m_cpuid = libxsmm_get_target_archid()
      IF (LIBXSMM_X86_SSE4 <= m_cpuid .AND. m_cpuid < LIBXSMM_X86_AVX) THEN
         m_cpuid = MACHINE_X86_SSE4
      ELSE IF (LIBXSMM_X86_AVX <= m_cpuid .AND. m_cpuid < LIBXSMM_X86_AVX2) THEN
         m_cpuid = MACHINE_X86_AVX
      ELSE IF (LIBXSMM_X86_AVX2 <= m_cpuid .AND. m_cpuid < LIBXSMM_X86_AVX512_SKX) THEN
         m_cpuid = MACHINE_X86_AVX2
      ELSE IF (LIBXSMM_X86_AVX512_SKX <= m_cpuid .AND. m_cpuid <= 1999) THEN
         m_cpuid = MACHINE_X86_AVX512
#if defined(__LIBXSMM2)
      ELSE IF (LIBXSMM_AARCH64_V81 <= m_cpuid .AND. m_cpuid < LIBXSMM_AARCH64_SVE128) THEN
         m_cpuid = MACHINE_ARM_ARCH64
      ELSE IF (LIBXSMM_AARCH64_SVE128 <= m_cpuid .AND. m_cpuid < 2401) THEN ! LIBXSMM_AARCH64_SVE512
         m_cpuid = MACHINE_ARM_SVE256
      ELSE IF (2401 <= m_cpuid .AND. m_cpuid <= 2999) THEN
         m_cpuid = MACHINE_ARM_SVE512
#endif
      ELSE IF (LIBXSMM_TARGET_ARCH_GENERIC <= m_cpuid .AND. m_cpuid <= 2999) THEN
         m_cpuid = MACHINE_CPU_GENERIC
      ELSE
         m_cpuid = MACHINE_CPU_UNKNOWN
      END IF
#else
      m_cpuid = m_cpuid_static()
#endif
   END FUNCTION m_cpuid

! **************************************************************************************************
!> \brief Determine name of target architecture for a given CPUID.
!> \param cpuid integer value (MACHINE_*)
!> \return short name of ISA extension.
!> \par History
!>      06.2019 created [Hans Pabst]
!>      09.2024 update+arm [Hans Pabst]
! **************************************************************************************************
   PURE FUNCTION m_cpuid_name(cpuid)
      INTEGER, OPTIONAL, INTENT(IN)         :: cpuid
      CHARACTER(len=default_string_length)  :: m_cpuid_name

      INTEGER                               :: isa

      IF (PRESENT(cpuid)) THEN
         isa = cpuid
      ELSE
         isa = m_cpuid()
      END IF

      SELECT CASE (isa)
      CASE (MACHINE_CPU_GENERIC)
         m_cpuid_name = "generic"
      CASE (MACHINE_X86_SSE4)
         m_cpuid_name = "x86_sse4"
      CASE (MACHINE_X86_AVX)
         m_cpuid_name = "x86_avx"
      CASE (MACHINE_X86_AVX2)
         m_cpuid_name = "x86_avx2"
      CASE (MACHINE_X86_AVX512)
         m_cpuid_name = "x86_avx512"
      CASE (MACHINE_ARM_ARCH64)
         m_cpuid_name = "arm_arch64"
      CASE (MACHINE_ARM_SVE128)
         m_cpuid_name = "arm_sve128"
      CASE (MACHINE_ARM_SVE256)
         m_cpuid_name = "arm_sve256"
      CASE (MACHINE_ARM_SVE512)
         m_cpuid_name = "arm_sve512"
      CASE DEFAULT
         m_cpuid_name = "unknown"
      END SELECT
   END FUNCTION m_cpuid_name

! **************************************************************************************************
!> \brief Determine vector-length for a given CPUID.
!> \param cpuid integer value (MACHINE_*)
!> \param typesize number of bytes of scalar type
!> \return vector-length in number of elements.
!> \par History
!>      12.2024 created [Hans Pabst]
! **************************************************************************************************
   PURE FUNCTION m_cpuid_vlen(cpuid, typesize)
      INTEGER, OPTIONAL, INTENT(IN) :: cpuid, typesize

      INTEGER                       :: isa, m_cpuid_vlen, nbytes

      IF (PRESENT(typesize)) THEN
         nbytes = typesize
      ELSE
         nbytes = 8 ! double-precision
      END IF

      IF (0 < nbytes .AND. nbytes <= 16) THEN ! sanity check
         IF (PRESENT(cpuid)) THEN
            isa = cpuid
         ELSE
            isa = m_cpuid()
         END IF

         SELECT CASE (isa)
         CASE (MACHINE_X86_SSE4)
            m_cpuid_vlen = 16/nbytes
         CASE (MACHINE_ARM_ARCH64) ! NEON
            m_cpuid_vlen = 16/nbytes
         CASE (MACHINE_ARM_SVE128)
            m_cpuid_vlen = 16/nbytes
         CASE (MACHINE_X86_AVX)
            m_cpuid_vlen = 32/nbytes
         CASE (MACHINE_X86_AVX2)
            m_cpuid_vlen = 32/nbytes
         CASE (MACHINE_ARM_SVE256)
            m_cpuid_vlen = 32/nbytes
         CASE (MACHINE_X86_AVX512)
            m_cpuid_vlen = 64/nbytes
         CASE (MACHINE_ARM_SVE512)
            m_cpuid_vlen = 64/nbytes
         CASE DEFAULT ! unknown or generic
            m_cpuid_vlen = 1 ! scalar
         END SELECT
      ELSE ! fallback
         m_cpuid_vlen = 1 ! scalar
      END IF
   END FUNCTION m_cpuid_vlen

! **************************************************************************************************
!> \brief returns the energy used since some time in the past.
!>        The precise meaning depends on the infrastructure is available.
!>        In the cray_pm_energy case, this is the energy used by the node in kJ.
!> \return ...
!> \par History
!>      09.2013 created [Joost VandeVondele, Ole Schuett]
! **************************************************************************************************
   FUNCTION m_energy() RESULT(wt)
      REAL(KIND=dp)                            :: wt

#if defined(__CRAY_PM_ENERGY)
      wt = read_energy("/sys/cray/pm_counters/energy")
#elif defined(__CRAY_PM_ACCEL_ENERGY)
      wt = read_energy("/sys/cray/pm_counters/accel_energy")
#else
      wt = 0.0 ! fallback default
#endif

   END FUNCTION m_energy

#if defined(__CRAY_PM_ACCEL_ENERGY) || defined(__CRAY_PM_ENERGY)
! **************************************************************************************************
!> \brief reads energy values from the sys-filesystem
!> \param filename ...
!> \return ...
!> \par History
!>      09.2013 created [Joost VandeVondele, Ole Schuett]
! **************************************************************************************************
   FUNCTION read_energy(filename) RESULT(wt)
      CHARACTER(LEN=*)                                   :: filename
      REAL(KIND=dp)                                      :: wt

      CHARACTER(LEN=80)                                  :: DATA
      INTEGER                                            :: i, iostat
      INTEGER(KIND=int_8)                                :: raw

      OPEN (121245, FILE=filename, ACTION="READ", STATUS="OLD", ACCESS="STREAM")
      DO I = 1, 80
         READ (121245, END=999) DATA(I:I)
      END DO
999   CLOSE (121245)
      DATA(I:80) = ""
      READ (DATA, *, IOSTAT=iostat) raw
      IF (iostat .NE. 0) THEN
         wt = 0.0_dp
      ELSE
         ! convert from J to kJ
         wt = raw/1000.0_dp
      END IF
   END FUNCTION read_energy
#endif

! **************************************************************************************************
!> \brief returns a datum in human readable format using a standard Fortran routine
!> \param cal_date ...
!> \par History
!>      10.2009 created [Joost VandeVondele]
! **************************************************************************************************
   SUBROUTINE m_datum(cal_date)
      CHARACTER(len=*), INTENT(OUT)                      :: cal_date

      CHARACTER(len=10)                                  :: time
      CHARACTER(len=8)                                   :: date

      CALL DATE_AND_TIME(date=date, time=time)
      cal_date = date(1:4)//"-"//date(5:6)//"-"//date(7:8)//" "//time(1:2)//":"//time(3:4)//":"//time(5:10)

   END SUBROUTINE m_datum

! **************************************************************************************************
!> \brief Can be used to get a nice core
! **************************************************************************************************
   SUBROUTINE m_abort()
      INTERFACE
         SUBROUTINE abort() BIND(C, name="abort")
         END SUBROUTINE
      END INTERFACE

      CALL abort()
   END SUBROUTINE m_abort

! **************************************************************************************************
!> \brief Returns if a process is running on the local machine
!>        1 if yes and 0 if not
!> \param pid ...
!> \return ...
! **************************************************************************************************
   FUNCTION m_procrun(pid) RESULT(run_on)
      INTEGER, INTENT(IN)       ::   pid
      INTEGER                   ::   run_on
#if defined(__MINGW)
      run_on = 0
#else
      INTEGER                   ::   istat

      INTERFACE
         FUNCTION kill(pid, sig) BIND(C, name="kill") RESULT(errno)
            IMPORT
            INTEGER(KIND=C_INT), VALUE                :: pid, sig
            INTEGER(KIND=C_INT)                      :: errno
         END FUNCTION
      END INTERFACE

      ! If sig is 0, then no signal is sent, but error checking is still
      ! performed; this can be used to check for the existence of a process
      ! ID or process group ID.

      istat = kill(pid=pid, sig=0)
      IF (istat == 0) THEN
         run_on = 1 ! no error, process exists
      ELSE
         run_on = 0 ! error, process probably does not exist
      END IF
#endif
   END FUNCTION m_procrun

! **************************************************************************************************
!> \brief Returns the total amount of memory [bytes] in use, if known, zero otherwise
!> \param mem ...
! **************************************************************************************************
   SUBROUTINE m_memory(mem)

      INTEGER(KIND=int_8), OPTIONAL, INTENT(OUT)         :: mem
      INTEGER(KIND=int_8)                      :: mem_local

      ! __NO_STATM_ACCESS can be used to disable the stuff, if getpagesize
      ! lead to linking errors or /proc/self/statm can not be opened
      !
#if defined(__NO_STATM_ACCESS)
      mem_local = 0
#else
      INTEGER(KIND=int_8)                      :: m1, m2, m3
      CHARACTER(LEN=80) :: DATA
      INTEGER :: iostat, i

      ! the size of a page, might not be available everywhere
      INTERFACE
         FUNCTION getpagesize() BIND(C, name="getpagesize") RESULT(RES)
            IMPORT
            INTEGER(C_INT) :: RES
         END FUNCTION
      END INTERFACE

      ! reading from statm
      !
      mem_local = -1
      DATA = ""
      OPEN (121245, FILE="/proc/self/statm", ACTION="READ", STATUS="OLD", ACCESS="STREAM")
      DO I = 1, 80
         READ (121245, END=999) DATA(I:I)
      END DO
999   CLOSE (121245)
      DATA(I:80) = ""
      ! m1 = total
      ! m2 = resident
      ! m3 = shared
      READ (DATA, *, IOSTAT=iostat) m1, m2, m3
      IF (iostat .NE. 0) THEN
         mem_local = 0
      ELSE
         mem_local = m2
#if defined(__STATM_TOTAL)
         mem_local = m1
#endif
#if defined(__STATM_RESIDENT)
         mem_local = m2
#endif
         mem_local = mem_local*getpagesize()
      END IF
#endif

      m_memory_max = MAX(mem_local, m_memory_max)
      IF (PRESENT(mem)) mem = mem_local

   END SUBROUTINE m_memory

! **************************************************************************************************
!> \brief get more detailed memory info, all units are bytes.
!>         the only 'useful' option is MemLikelyFree which is an estimate of remaining memory
!>         assumed to give info like /proc/meminfo while MeMLikelyFree is the amount of
!>         memory we're likely to be able to allocate, but not necessarily in one chunk
!>         zero means not available...
!> \param MemTotal ...
!> \param MemFree ...
!> \param Buffers ...
!> \param Cached ...
!> \param Slab ...
!> \param SReclaimable ...
!> \param MemLikelyFree ...
! **************************************************************************************************
   SUBROUTINE m_memory_details(MemTotal, MemFree, Buffers, Cached, Slab, SReclaimable, MemLikelyFree)

      INTEGER(kind=int_8), OPTIONAL :: MemTotal, MemFree, Buffers, Cached, Slab, SReclaimable, MemLikelyFree

      INTEGER, PARAMETER :: Nbuffer = 10000
      CHARACTER(LEN=Nbuffer) :: meminfo

      INTEGER :: i

      MemTotal = 0
      MemFree = 0
      Buffers = 0
      Cached = 0
      Slab = 0
      SReclaimable = 0
      MemLikelyFree = 0
      meminfo = ""

      OPEN (UNIT=8123, file="/proc/meminfo", ACCESS="STREAM", ERR=901)
      i = 0
      DO
         i = i + 1
         IF (i > Nbuffer) EXIT
         READ (8123, END=900, ERR=900) meminfo(i:i)
      END DO
900   CONTINUE
      meminfo(i:Nbuffer) = ""
901   CONTINUE
      CLOSE (8123, ERR=902)
902   CONTINUE
      MemTotal = get_field_value_in_bytes('MemTotal:')
      MemFree = get_field_value_in_bytes('MemFree:')
      Buffers = get_field_value_in_bytes('Buffers:')
      Cached = get_field_value_in_bytes('Cached:')
      Slab = get_field_value_in_bytes('Slab:')
      SReclaimable = get_field_value_in_bytes('SReclaimable:')
      ! opinions here vary but this might work
      MemLikelyFree = MemFree + Buffers + Cached + SReclaimable

   CONTAINS

! **************************************************************************************************
!> \brief ...
!> \param field ...
!> \return ...
! **************************************************************************************************
      INTEGER(int_8) FUNCTION get_field_value_in_bytes(field)
         CHARACTER(LEN=*)                                   :: field

         INTEGER                                            :: start
         INTEGER(KIND=int_8)                                :: value

         get_field_value_in_bytes = 0
         start = INDEX(meminfo, field)
         IF (start .NE. 0) THEN
            start = start + LEN_TRIM(field)
            IF (start .LT. Nbuffer) THEN
               READ (meminfo(start:), *, ERR=999, END=999) value
               ! XXXXXXX convert from Kb to bytes XXXXXXXX
               get_field_value_in_bytes = value*1024
999            CONTINUE
            END IF
         END IF
      END FUNCTION
   END SUBROUTINE m_memory_details

! **************************************************************************************************
!> \brief ...
!> \param hname ...
! **************************************************************************************************
   SUBROUTINE m_hostnm(hname)
      CHARACTER(len=*), INTENT(OUT)            :: hname
#if defined(__MINGW)
      ! While there is a gethostname in the Windows (POSIX) API, it requires that winsocks is
      ! initialised prior to using it via WSAStartup(..), respectively cleaned up at the end via WSACleanup().
      hname = "<unknown>"
#else
      INTEGER                                  :: istat, i
      CHARACTER(len=default_path_length)       :: buf

      INTERFACE
         FUNCTION gethostname(buf, buflen) BIND(C, name="gethostname") RESULT(errno)
            IMPORT
            CHARACTER(KIND=C_CHAR), DIMENSION(*)     :: buf
            INTEGER(KIND=C_INT), VALUE               :: buflen
            INTEGER(KIND=C_INT)                      :: errno
         END FUNCTION
      END INTERFACE

      istat = gethostname(buf, LEN(buf))
      IF (istat /= 0) THEN
         WRITE (*, *) "m_hostnm failed"
         CALL m_abort()
      END IF
      i = INDEX(buf, c_null_char) - 1
      hname = buf(1:i)
#endif
   END SUBROUTINE m_hostnm

! **************************************************************************************************
!> \brief ...
!> \param curdir ...
! **************************************************************************************************
   SUBROUTINE m_getcwd(curdir)
      CHARACTER(len=*), INTENT(OUT)            :: curdir
      TYPE(C_PTR)                              :: stat
      INTEGER                                  :: i
      CHARACTER(len=default_path_length), TARGET  :: tmp

      INTERFACE
         FUNCTION getcwd(buf, buflen) BIND(C, name="getcwd") RESULT(stat)
            IMPORT
            CHARACTER(KIND=C_CHAR), DIMENSION(*)     :: buf
            INTEGER(KIND=C_INT), VALUE               :: buflen
            TYPE(C_PTR)                              :: stat
         END FUNCTION
      END INTERFACE

      stat = getcwd(tmp, LEN(tmp))
      IF (.NOT. C_ASSOCIATED(stat)) THEN
         WRITE (*, *) "m_getcwd failed"
         CALL m_abort()
      END IF
      i = INDEX(tmp, c_null_char) - 1
      curdir = tmp(1:i)
   END SUBROUTINE m_getcwd

! **************************************************************************************************
!> \brief ...
!> \param dir ...
!> \param ierror ...
! **************************************************************************************************
   SUBROUTINE m_chdir(dir, ierror)
      CHARACTER(len=*), INTENT(IN)             :: dir
      INTEGER, INTENT(OUT)                     :: ierror

      INTERFACE
         FUNCTION chdir(path) BIND(C, name="chdir") RESULT(errno)
            IMPORT
            CHARACTER(KIND=C_CHAR), DIMENSION(*)     :: path
            INTEGER(KIND=C_INT)                      :: errno
         END FUNCTION
      END INTERFACE

      ierror = chdir(TRIM(dir)//c_null_char)
   END SUBROUTINE m_chdir

! **************************************************************************************************
!> \brief ...
!> \param pid ...
! **************************************************************************************************
   SUBROUTINE m_getpid(pid)
      INTEGER, INTENT(OUT)                     :: pid

      INTERFACE
         FUNCTION getpid() BIND(C, name="getpid") RESULT(pid)
            IMPORT
            INTEGER(KIND=C_INT)              :: pid
         END FUNCTION
      END INTERFACE

      pid = getpid()
   END SUBROUTINE m_getpid

! **************************************************************************************************
!> \brief ...
!> \param path ...
!> \return ...
! **************************************************************************************************
   FUNCTION m_unlink(path) RESULT(istat)

      CHARACTER(LEN=*), INTENT(IN)             :: path

      INTEGER                                  :: istat

      INTERFACE
         FUNCTION unlink(path) BIND(C, name="unlink") RESULT(errno)
            IMPORT
            CHARACTER(KIND=C_CHAR), DIMENSION(*)     :: path
            INTEGER(KIND=C_INT)                      :: errno
         END FUNCTION
      END INTERFACE

      istat = unlink(TRIM(path)//c_null_char)
   END FUNCTION m_unlink

! **************************************************************************************************
!> \brief ...
!> \param source ...
!> \param TARGET ...
! **************************************************************************************************
   SUBROUTINE m_mov(source, TARGET)

      CHARACTER(LEN=*), INTENT(IN)             :: source, TARGET

      INTEGER                                  :: istat

      INTERFACE
         FUNCTION rename(src, dest) BIND(C, name="rename") RESULT(errno)
            IMPORT
            CHARACTER(KIND=C_CHAR), DIMENSION(*)     :: src, dest
            INTEGER(KIND=C_INT)                      :: errno
         END FUNCTION
      END INTERFACE

      IF (TARGET == source) THEN
         WRITE (*, *) "Warning: m_mov ", TRIM(TARGET), " equals ", TRIM(source)
         RETURN
      END IF

      ! first remove target (needed on windows / mingw)
      istat = m_unlink(TARGET)
      ! ignore istat of unlink

      ! now move
      istat = rename(TRIM(source)//c_null_char, TRIM(TARGET)//c_null_char)
      IF (istat .NE. 0) THEN
         WRITE (*, *) "Trying to move "//TRIM(source)//" to "//TRIM(TARGET)//"."
         WRITE (*, *) "rename returned status: ", istat
         WRITE (*, *) "Problem moving file"
         CALL m_abort()
      END IF
   END SUBROUTINE m_mov

! **************************************************************************************************
!> \brief ...
!> \param user ...
! **************************************************************************************************
   SUBROUTINE m_getlog(user)

      CHARACTER(LEN=*), INTENT(OUT) :: user

      INTEGER                       :: istat

      ! on a posix system LOGNAME should be defined
      CALL get_environment_variable("LOGNAME", value=user, status=istat)
      ! nope, check alternative
      IF (istat /= 0) &
         CALL get_environment_variable("USER", value=user, status=istat)
      ! nope, check alternative
      IF (istat /= 0) &
         CALL get_environment_variable("USERNAME", value=user, status=istat)
      ! fall back
      IF (istat /= 0) &
         user = "<unknown>"

   END SUBROUTINE m_getlog

! **************************************************************************************************
!> \brief Retrieve environment variable OMP_STACKSIZE
!> \param omp_stacksize Value of OMP_STACKSIZE
! **************************************************************************************************
   SUBROUTINE m_omp_get_stacksize(omp_stacksize)
      CHARACTER(LEN=*), INTENT(OUT)                      :: omp_stacksize

      INTEGER                                            :: istat

      omp_stacksize = ""
      CALL get_environment_variable("OMP_STACKSIZE", value=omp_stacksize, status=istat)
      ! Fall back, if OMP_STACKSIZE is not set
      IF (istat /= 0) omp_stacksize = "default"

   END SUBROUTINE m_omp_get_stacksize

END MODULE machine
