diff --git a/.helix/config.toml b/.helix/config.toml
new file mode 100644
index 000000000..a6232d4a2
--- /dev/null
+++ b/.helix/config.toml
@@ -0,0 +1,2 @@
+[editor]
+workspace-lsp-roots = ["CMakeLists.txt", ".git"]
diff --git a/FORDsetup.md b/FORDsetup.md
index ffa9af860..a18d004bb 100644
--- a/FORDsetup.md
+++ b/FORDsetup.md
@@ -1,8 +1,8 @@
---
project: easifemBase
-summary: easifemBase is part of easifem library, which is a framework for Expandable And Scalable Infrastructure for Finite Element Methods.
-project_download: https://github.com/vickysharma0812/easifem-base
-project_github: https://github.com/vickysharma0812/easifem-base
+summary: easifemBase is part of easifem library, which is a platform for Expandable And Scalable Infrastructure for Finite Element Methods.
+project_download: https://github.com/easifem/base
+project_github: https://github.com/easifem/base
project_website: https://www.easifem.com
license: gfdl
project_dir: ./src/modules/Utility
@@ -41,5 +41,3 @@ preprocesses: true
---
{!./README.md!}
-
-
diff --git a/fortitude.toml b/fortitude.toml
index f3f158533..b7dd015fd 100644
--- a/fortitude.toml
+++ b/fortitude.toml
@@ -1,10 +1,14 @@
[check]
preview = true
-select = ["C", "E", "S", "MOD", "OB"]
-# ignore = []
+select = ["C", "E", "S", "MOD"]
+ignore = [
+ "superfluous-implicit-none",
+ "implicit-external-procedures",
+ "interface-implicit-typing",
+]
file-extensions = ["f90", "F90"]
line-length = 78
-fix = false
+fix = true
# output-format = "full"
# show-fixes = false
# unsafe-fixes = true
diff --git a/src/modules/ARPACK/src/ARPACK_SAUPD.F90 b/src/modules/ARPACK/src/ARPACK_SAUPD.F90
index 22340fb10..f09368a77 100644
--- a/src/modules/ARPACK/src/ARPACK_SAUPD.F90
+++ b/src/modules/ARPACK/src/ARPACK_SAUPD.F90
@@ -15,16 +15,30 @@
! along with this program. If not, see
!
+!> author: Vikas Sharma, Ph. D.
+! date: 2022-12-09
+! summary: Reverse communication interface (RCI) for the Implicitly
+! Restarted Arnoldi Iteration.
+
MODULE ARPACK_SAUPD
USE GlobalData, ONLY: I4B, DFP, LGT
USE String_Class, ONLY: String
IMPLICIT NONE
PRIVATE
+PUBLIC :: SAUPD_ErrorMsg
+PUBLIC :: SEUPD_ErrorMsg
+PUBLIC :: SymLargestEigenVal
+PUBLIC :: SymSmallestEigenVal
+
!----------------------------------------------------------------------------
! SAUPD_ErrorMsg
!----------------------------------------------------------------------------
+!> author: Vikas Sharma, Ph. D.
+! date: 2022-12-09
+! summary: error message for SAUPD
+
INTERFACE
MODULE FUNCTION SAUPD_ErrorMsg(INFO) RESULT(ans)
INTEGER(I4B), INTENT(IN) :: INFO
@@ -32,12 +46,14 @@ MODULE FUNCTION SAUPD_ErrorMsg(INFO) RESULT(ans)
END FUNCTION SAUPD_ErrorMsg
END INTERFACE
-PUBLIC :: SAUPD_ErrorMsg
-
!----------------------------------------------------------------------------
! SAUPD_ErrorMsg
!----------------------------------------------------------------------------
+!> author: Vikas Sharma, Ph. D.
+! date: 2022-12-09
+! summary: error message for SEUPD
+
INTERFACE
MODULE FUNCTION SEUPD_ErrorMsg(INFO) RESULT(ans)
INTEGER(I4B), INTENT(IN) :: INFO
@@ -45,8 +61,6 @@ MODULE FUNCTION SEUPD_ErrorMsg(INFO) RESULT(ans)
END FUNCTION SEUPD_ErrorMsg
END INTERFACE
-PUBLIC :: SEUPD_ErrorMsg
-
!----------------------------------------------------------------------------
!
!----------------------------------------------------------------------------
@@ -59,10 +73,10 @@ END FUNCTION SEUPD_ErrorMsg
!
!- This routine calculates the largest eigenvalue of a real sym dense matrix.
!- It calls ARPACK SSAUPD or DSAUPD routine
-
-INTERFACE
+!
+INTERFACE SymLargestEigenVal
MODULE FUNCTION SymLargestEigenVal1(mat, which, NCV, maxIter, tol) &
- & RESULT(ans)
+ RESULT(ans)
REAL(DFP), INTENT(IN) :: mat(:, :)
!! dense matrix
CHARACTER(*), OPTIONAL, INTENT(IN) :: which
@@ -80,30 +94,24 @@ MODULE FUNCTION SymLargestEigenVal1(mat, which, NCV, maxIter, tol) &
REAL(DFP) :: ans
!! maximum eigenvalue
END FUNCTION SymLargestEigenVal1
-END INTERFACE
-
-INTERFACE SymLargestEigenVal
- MODULE PROCEDURE SymLargestEigenVal1
END INTERFACE SymLargestEigenVal
-PUBLIC :: SymLargestEigenVal
-
!----------------------------------------------------------------------------
!
!----------------------------------------------------------------------------
!> author: Vikas Sharma, Ph. D.
! date: 2022-12-10
-! summary: Calculate the `nev` smallest eigenvalue of a real sym dense matrix
+! summary: Calculate the smallest eigenvalue of a real sym dense matrix
!
!# Introduction
!
!- This routine calculates the smallest eigenvalue of a real sym dense matrix.
!- It calls ARPACK SSAUPD or DSAUPD routine
-
-INTERFACE
+!
+INTERFACE SymLargestEigenVal
MODULE FUNCTION SymLargestEigenVal2(mat, nev, which, NCV, maxIter, tol) &
- & RESULT(ans)
+ RESULT(ans)
REAL(DFP), INTENT(IN) :: mat(:, :)
!! dense matrix
INTEGER(I4B), INTENT(IN) :: nev
@@ -123,10 +131,6 @@ MODULE FUNCTION SymLargestEigenVal2(mat, nev, which, NCV, maxIter, tol) &
REAL(DFP) :: ans(nev)
!! first k, largest eigenvalue
END FUNCTION SymLargestEigenVal2
-END INTERFACE
-
-INTERFACE SymLargestEigenVal
- MODULE PROCEDURE SymLargestEigenVal2
END INTERFACE SymLargestEigenVal
!----------------------------------------------------------------------------
@@ -156,9 +160,9 @@ END FUNCTION SymLargestEigenVal2
! decomposition of mat0.
!@endnote
-INTERFACE
+INTERFACE SymSmallestEigenVal
MODULE FUNCTION SymSmallestEigenVal1(mat, sigma, which, NCV, maxIter, tol) &
- & RESULT(ans)
+ RESULT(ans)
REAL(DFP), INTENT(IN) :: mat(:, :)
!! dense matrix
REAL(DFP), OPTIONAL, INTENT(IN) :: sigma
@@ -178,14 +182,8 @@ MODULE FUNCTION SymSmallestEigenVal1(mat, sigma, which, NCV, maxIter, tol) &
REAL(DFP) :: ans
!! maximum eigenvalue
END FUNCTION SymSmallestEigenVal1
-END INTERFACE
-
-INTERFACE SymSmallestEigenVal
- MODULE PROCEDURE SymSmallestEigenVal1
END INTERFACE SymSmallestEigenVal
-PUBLIC :: SymSmallestEigenVal
-
!----------------------------------------------------------------------------
!
!----------------------------------------------------------------------------
@@ -205,19 +203,15 @@ END FUNCTION SymSmallestEigenVal1
!
!- [ ] TODO use Cholsky factorization instead of LU as mat is
! symmetric.
-!
-INTERFACE
+INTERFACE SymSmallestEigenVal
MODULE FUNCTION SymSmallestEigenVal2(mat, isFactor, ipiv, sigma, which, &
- & NCV, maxIter, tol) &
- & RESULT(ans)
+ NCV, maxIter, tol) RESULT(ans)
REAL(DFP), INTENT(INOUT) :: mat(:, :)
- !!
!! Dense matrix
!! If isFactor is false, then this matrix will change on return
!! in this case, it will contain LU decomposition of `A-sigma*I`
!! If isFactor is true, then this matrix will not change
- !!
LOGICAL(LGT), INTENT(INOUT) :: isFactor
!! if mat is already factorized, the set isFactor to true
!! if mat is not factorized, then set isFactor to false
@@ -244,10 +238,6 @@ MODULE FUNCTION SymSmallestEigenVal2(mat, isFactor, ipiv, sigma, which, &
REAL(DFP) :: ans
!! smallest eigenvalue
END FUNCTION SymSmallestEigenVal2
-END INTERFACE
-
-INTERFACE SymSmallestEigenVal
- MODULE PROCEDURE SymSmallestEigenVal2
END INTERFACE SymSmallestEigenVal
END MODULE ARPACK_SAUPD
diff --git a/src/modules/Display/src/Display_Method.F90 b/src/modules/Display/src/Display_Method.F90
index 7db090a23..81a8dc642 100755
--- a/src/modules/Display/src/Display_Method.F90
+++ b/src/modules/Display/src/Display_Method.F90
@@ -1642,9 +1642,9 @@ SUBROUTINE EqualLine(unitNo)
INTEGER(I4B), INTENT(IN), OPTIONAL :: unitNo
IF (PRESENT(unitNo)) THEN
- WRITE (unitNo, "(A)") equal
+ WRITE (unitNo, '(80("="))')
ELSE
- WRITE (stdout, "(A)") equal
+ WRITE (stdout, '(80("="))')
END IF
END SUBROUTINE EqualLine
diff --git a/src/modules/String/src/String_Class.F90 b/src/modules/String/src/String_Class.F90
index cc89858e7..b962fc2ac 100644
--- a/src/modules/String/src/String_Class.F90
+++ b/src/modules/String/src/String_Class.F90
@@ -29,10 +29,10 @@ MODULE String_Class
! INTEGER, PARAMETER, PUBLIC :: CK = SELECTED_CHAR_KIND('DEFAULT')
INTEGER, PARAMETER :: CK = SELECTED_CHAR_KIND('DEFAULT')
! internal parameters
-CHARACTER(kind=CK, len=26), PARAMETER :: UPPER_ALPHABET = &
- & 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
-CHARACTER(kind=CK, len=26), PARAMETER :: LOWER_ALPHABET = &
- & 'abcdefghijklmnopqrstuvwxyz'
+CHARACTER(kind=CK, len=26), PARAMETER :: UPPER_ALPHABET = &
+ 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+CHARACTER(kind=CK, len=26), PARAMETER :: LOWER_ALPHABET = &
+ 'abcdefghijklmnopqrstuvwxyz'
CHARACTER(kind=CK, len=1), PARAMETER :: SPACE = ' '
CHARACTER(kind=CK, len=1), PARAMETER :: TAB = ACHAR(9)
CHARACTER(kind=CK, len=1), PARAMETER :: UIX_DIR_SEP = CHAR(47)
@@ -44,7 +44,7 @@ MODULE String_Class
INTERFACE strjoin
MODULE PROCEDURE strjoin_strings, strjoin_characters, &
- & strjoin_strings_array, strjoin_characters_array
+ strjoin_strings_array, strjoin_characters_array
END INTERFACE strjoin
PUBLIC :: strjoin
@@ -89,7 +89,7 @@ MODULE String_Class
INTERFACE index
MODULE PROCEDURE sindex_string_string, sindex_string_character, &
- & sindex_character_string
+ sindex_character_string
END INTERFACE index
!----------------------------------------------------------------------------
@@ -150,7 +150,7 @@ MODULE String_Class
INTERFACE verify
MODULE PROCEDURE sverify_string_string, sverify_string_character, &
- & sverify_character_string
+ sverify_character_string
END INTERFACE verify
PUBLIC :: verify
diff --git a/src/modules/System/CMakeLists.txt b/src/modules/System/CMakeLists.txt
index 801f528f7..4b7ddadaf 100644
--- a/src/modules/System/CMakeLists.txt
+++ b/src/modules/System/CMakeLists.txt
@@ -16,8 +16,19 @@
#
set(src_path "${CMAKE_CURRENT_LIST_DIR}/src/")
-target_sources(${PROJECT_NAME} PRIVATE ${src_path}/System_Method.F90)
-
+target_sources(
+ ${PROJECT_NAME}
+ PRIVATE
+ ${src_path}/SystemInterface.F90
+ ${src_path}/SystemOptions.F90
+ ${src_path}/System_Method.F90
+ ${src_path}/SystemSignal_Method.F90
+ ${src_path}/SystemFile_Method.F90
+ ${src_path}/SystemEnvironment_Method.F90
+ ${src_path}/SystemEnquiry_Method.F90
+ ${src_path}/SystemProcess_Method.F90
+ ${src_path}/System_Utility.F90
+)
set(subproject_name "easifemSystem")
@@ -28,16 +39,17 @@ target_link_libraries(${PROJECT_NAME} PUBLIC ${subproject_name})
# target properties
set_target_properties(
- ${subproject_name}
- PROPERTIES POSITION_INDEPENDENT_CODE 1
- SOVERSION ${VERSION_MAJOR}
- # OUTPUT_NAME ${PROJECT_NAME}
- LIBRARY_OUTPUT_DIRECTORY ${CMAKE_LIBRARY_OUTPUT_DIRECTORY}
- ARCHIVE_OUTPUT_DIRECTORY ${CMAKE_LIBRARY_OUTPUT_DIRECTORY}
- RUNTIME_OUTPUT_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}
- MACOSX_RPATH ON
- WINDOWS_EXPORT_ALL_SYMBOLS ON
- LINKER_LANGUAGE C)
-
+ ${subproject_name}
+ PROPERTIES
+ POSITION_INDEPENDENT_CODE 1
+ SOVERSION ${VERSION_MAJOR}
+ # OUTPUT_NAME ${PROJECT_NAME}
+ LIBRARY_OUTPUT_DIRECTORY ${CMAKE_LIBRARY_OUTPUT_DIRECTORY}
+ ARCHIVE_OUTPUT_DIRECTORY ${CMAKE_LIBRARY_OUTPUT_DIRECTORY}
+ RUNTIME_OUTPUT_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}
+ MACOSX_RPATH ON
+ WINDOWS_EXPORT_ALL_SYMBOLS ON
+ LINKER_LANGUAGE C
+)
list(APPEND C_PROJECTS ${subproject_name})
diff --git a/src/modules/System/src/SystemEnquiry_Method.F90 b/src/modules/System/src/SystemEnquiry_Method.F90
new file mode 100755
index 000000000..19d6523ea
--- /dev/null
+++ b/src/modules/System/src/SystemEnquiry_Method.F90
@@ -0,0 +1,293 @@
+! This module is mainly taken from the source:
+! https://github.com/urbanjost/M_system.
+! The original name of the program has been changed
+! from M_SYSTEM to System_Method.
+! This is to confirm to the coding sytles of easifem.
+! Original program has been re-organized into module and submodule.
+! If you are using easifem for getting methods defined in this
+! module, then please use M_System module by using the above link.
+! We would like to thank the original author Urban Jost for creating
+! This useful module.
+
+!> author: John S. Urban
+! date: 2026-02-04
+! summary: Fortran interface to C system interface
+!
+!# System_Method
+!
+! M_system(3fm) is a collection of Fortran procedures that call C
+! or a C wrapper using the ISO_C_BINDING interface to access system calls.
+! System calls are a special set of functions used by programs to communicate
+! directly with an operating system.
+!
+! Generally, system calls are slower than normal function calls because
+! when you make a call control is relinquished to the operating system
+! to perform the system call. In addition, depending on the nature of the
+! system call, your program may be blocked by the OS until the system call
+! has finished, thus making the execution time of your program even longer.
+!
+! One rule-of-thumb that should always be followed when calling a system
+! call -- Always check the return value.
+
+MODULE SystemEnquiry_Method
+USE ISO_C_BINDING, ONLY: C_FLOAT, C_INT, C_CHAR
+USE ISO_C_BINDING, ONLY: C_PTR, C_F_POINTER, C_NULL_CHAR, C_NULL_PTR
+USE ISO_C_BINDING, ONLY: C_LONG, C_SHORT, C_FUNPTR
+
+IMPLICIT NONE
+
+PRIVATE
+
+PUBLIC :: System_Access
+!! determine filename access or existence
+PUBLIC :: System_Isdir
+!! determine if filename is a directory
+PUBLIC :: System_Islnk
+!! determine if filename is a link
+PUBLIC :: System_Isreg
+!! determine if filename is a regular file
+PUBLIC :: System_Isblk
+!! determine if filename is a block device
+PUBLIC :: System_Ischr
+!! determine if filename is a character device
+PUBLIC :: System_Isfifo
+!! determine if filename is a fifo - named pipe
+PUBLIC :: System_Issock
+!! determine if filename is a socket
+
+!----------------------------------------------------------------------------
+! System_Access@EnquiryMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: Check accessibility or existence of a pathname
+!
+!# System_Access
+!
+! The system_access(3f) function checks pathname existence and access
+! permissions. The function checks the pathname for accessibility
+! according to the bit pattern contained in amode, using the real user
+! ID in place of the effective user ID and the real group ID in place
+! of the effective group ID.
+!
+! The value of amode is either the bitwise-inclusive OR of the access
+! permissions to be checked (R_OK, W_OK, X_OK) or the existence test (F_OK).
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Access_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE ELEMENTAL IMPURE FUNCTION System_Access(pathname, amode)
+ CHARACTER(len=*), INTENT(IN) :: pathname
+ !! a character string representing a directory pathname.
+ !! Trailing spaces are ignored.
+ INTEGER, INTENT(IN) :: amode
+ !! bitwise-inclusive OR of the values R_OK, W_OK, X_OK, or F_OK.
+ LOGICAL :: System_Access
+ !! Return value: If not true an error occurred or
+ !! the requested access is not granted
+ END FUNCTION System_Access
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Issock@EnquiryMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: checks if argument is a socket
+!
+!# System_Issock
+!
+! The issock(3f) function checks if path is a path to a socket
+
+INTERFACE
+ MODULE FUNCTION System_Issock(pathname)
+ CHARACTER(*), INTENT(IN) :: pathname
+ !! a character string representing a socket pathname.
+ !! Trailing spaces are ignored.
+ LOGICAL :: System_Issock
+ !! The system_issock() function should always be successful and no
+ !! return value is reserved to indicate an error.
+ END FUNCTION System_Issock
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Isfifo@EnquiryMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: check if argument is a fifo named pipe
+!
+!# System_Isfifo
+!
+! Check if argument is a fifo named pipe.
+
+INTERFACE
+ MODULE ELEMENTAL IMPURE FUNCTION System_Isfifo(pathname)
+ CHARACTER(len=*), INTENT(in) :: pathname
+ !! a character string representing a fifo - named pipe pathname.
+ !! Trailing spaces are ignored.
+ LOGICAL :: System_Isfifo
+ !! The system_isfifo() function should always be successful and no
+ !! return value is reserved to indicate an error.
+ END FUNCTION System_Isfifo
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Ischr@EnquiryMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: checks if argument is a character device
+!
+!# System_Ischr
+!
+! The ischr(3f) function checks if path is a path to a character device.
+
+INTERFACE
+ MODULE ELEMENTAL IMPURE FUNCTION System_Ischr(pathname)
+ CHARACTER(*), INTENT(IN) :: pathname
+ !! a character string representing a character device pathname.
+ !! Trailing spaces are ignored.
+ LOGICAL :: System_Ischr
+ !! The system_ischr() function should always be successful and no
+ !! return value is reserved to indicate an error.
+ END FUNCTION System_Ischr
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Isreg@EnquiryMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: checks if argument is a regular file
+!
+!# System_Isreg
+!
+! The isreg(3f) function checks if path is a regular file
+!
+!## Examples 1
+!
+!```fortran
+! {{% fortran-code file="examples/System_Isreg_test_1.F90" %}}
+!```
+!
+!## Examples 2
+!
+!```fortran
+! {{% fortran-code file="examples/System_Isreg_test_2.F90" %}}
+!```
+
+INTERFACE
+ MODULE ELEMENTAL impure FUNCTION System_Isreg(pathname)
+ CHARACTER(*), INTENT(IN) :: pathname
+ !! a character string representing a pathname.
+ !! Trailing spaces are ignored.
+ LOGICAL :: System_Isreg
+ !! The system_isreg() function should always be successful and no
+ !! return value is reserved to indicate an error.
+ END FUNCTION System_Isreg
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Islnk@EnquiryMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: checks if argument is a link
+!
+!# System_Islnk
+!
+! The islnk(3f) function checks if path is a path to a link.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Islink_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE ELEMENTAL IMPURE FUNCTION System_Islnk(pathname)
+ CHARACTER(len=*), INTENT(in) :: pathname
+ !! a character string representing a link
+ !! pathname. Trailing spaces are ignored.
+ LOGICAL :: System_Islnk
+ !! The system_islnk() function should always be
+ !! successful and no return value is reserved to
+ !! indicate an error.
+ END FUNCTION System_Islnk
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Isblk@EnquiryMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: Check if argument is a block device
+!
+!# System_Isblk
+!
+! The isblk(3f) function checks if path is a path to a block device.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Isblk_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE ELEMENTAL IMPURE FUNCTION System_Isblk(pathname)
+ CHARACTER(*), INTENT(IN) :: pathname
+ !! a character string representing a block device pathname.
+ !! Trailing spaces are ignored.
+ LOGICAL :: System_Isblk
+ !! The system_isblk() function should always be successful and no
+ !! return value is reserved to indicate an error.
+ END FUNCTION System_Isblk
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Isdir@EnquiryMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: checks if argument is a directory of not
+!
+!# System_Isdir
+!
+! The system_isdir(3f) function checks if path is a directory.
+!
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Isdir_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE ELEMENTAL IMPURE FUNCTION System_Isdir(dirname)
+ CHARACTER(len=*), INTENT(in) :: dirname
+ !! a character string representing a directory pathname.
+ !! Trailing spaces are ignored.
+ LOGICAL :: System_Isdir
+ !! The system_isdir() function should always be successful and no
+ !! return value is reserved to indicate an error.
+ END FUNCTION System_Isdir
+END INTERFACE
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+END MODULE SystemEnquiry_Method
diff --git a/src/modules/System/src/SystemEnvironment_Method.F90 b/src/modules/System/src/SystemEnvironment_Method.F90
new file mode 100755
index 000000000..aadcb97ba
--- /dev/null
+++ b/src/modules/System/src/SystemEnvironment_Method.F90
@@ -0,0 +1,258 @@
+! This module is mainly taken from the source:
+! https://github.com/urbanjost/M_system.
+! The original name of the program has been changed
+! from M_SYSTEM to System_Method.
+! This is to confirm to the coding sytles of easifem.
+! Original program has been re-organized into module and submodule.
+! If you are using easifem for getting methods defined in this
+! module, then please use M_System module by using the above link.
+! We would like to thank the original author Urban Jost for creating
+! This useful module.
+
+!> author: John S. Urban
+! date: 2026-02-04
+! summary: Fortran interface to C system interface
+!
+!# System_Method
+!
+! M_system(3fm) is a collection of Fortran procedures that call C
+! or a C wrapper using the ISO_C_BINDING interface to access system calls.
+! System calls are a special set of functions used by programs to communicate
+! directly with an operating system.
+!
+! Generally, system calls are slower than normal function calls because
+! when you make a call control is relinquished to the operating system
+! to perform the system call. In addition, depending on the nature of the
+! system call, your program may be blocked by the OS until the system call
+! has finished, thus making the execution time of your program even longer.
+!
+! One rule-of-thumb that should always be followed when calling a system
+! call -- Always check the return value.
+
+MODULE SystemEnvironment_Method
+USE ISO_C_BINDING, ONLY: C_LONG
+IMPLICIT NONE
+
+PRIVATE
+PUBLIC :: System_Putenv
+PUBLIC :: System_Getenv
+PUBLIC :: Set_Environment_Variable
+PUBLIC :: System_Unsetenv
+PUBLIC :: System_Readenv
+PUBLIC :: System_Clearenv
+
+INTEGER(C_LONG), BIND(c, name="longest_env_variable") :: &
+ LONGEST_ENV_VARIABLE
+
+!----------------------------------------------------------------------------
+! System_Putenv@Methods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: Set environment variable from Fortran
+!
+!# System_Putenv
+!
+! The system_putenv() function adds or changes the value
+! of environment variables.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Putenv_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE SUBROUTINE System_Putenv(string, err)
+ CHARACTER(*), INTENT(IN) :: string
+ !! string of format "NAME=value".
+ !! If name does not already exist in the environment,
+ !! then string is added to the environment.
+ !! If name does exist, then the value of name in the environment is
+ !! changed to value.
+ !! The string passed to putenv(3c) becomes part of the environment,
+ !! so this routine creates a string each time it is called that
+ !! increases the amount of
+ !! memory the program uses.
+ INTEGER, OPTIONAL, INTENT(OUT) :: err
+ !! The system_putenv() function returns zero on success,
+ !! or nonzero if an error occurs.
+ !! A non-zero error usually indicates sufficient memory
+ !! does not exist to store the
+ !! variable.
+ END SUBROUTINE System_Putenv
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Getenv@Methods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: get environment variable
+!
+!# System_Getenv
+!
+! The system_getenv() function gets the value of an environment variable.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Getenv_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE FUNCTION System_Getenv(name, default) RESULT(VALUE)
+ CHARACTER(*), INTENT(IN) :: name
+ !! Return the value of the specified environment variable or
+ !! blank if the variable is not defined.
+ CHARACTER(*), INTENT(IN), OPTIONAL :: default
+ !! If the value returned would be blank this value will be used
+ !! instead.
+ CHARACTER(:), ALLOCATABLE :: VALUE
+ END FUNCTION System_Getenv
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! Set_Environment_Variable@Methods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: call setenv(3c) to set environment variable
+!
+!# Set_Environment
+!
+! The set_environment_variable() procedure adds or changes the value of
+! environment variables.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/Set_Environment_Variable_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE SUBROUTINE Set_Environment_Variable(NAME, VALUE, STATUS)
+ CHARACTER(*), INTENT(IN) :: NAME
+ !! If name does not already exist in the environment,
+ !! then string is added to the environment.
+ !! If name does exist, then the value of name in the environment
+ !! is changed to value.
+ CHARACTER(*), INTENT(IN) :: VALUE
+ !! Value to assign to environment variable NAME
+ INTEGER, OPTIONAL, INTENT(OUT) :: STATUS
+ !! returns zero on success, or nonzero if an error occurs.
+ !! A non-zero error usually indicates sufficient memory does
+ !! not exist to store the
+ !! variable.
+ END SUBROUTINE Set_Environment_Variable
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Clearenv@Methods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: Clear environment by calling clearenv(3c)
+!
+!# System_Clearenv
+!
+! The System_Clearenv() procedure clears the environment of all name-value
+! pairs. Typically used in security-conscious applications or ones where
+! configuration control requires ensuring specific variables are set.
+!
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Clearenv_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE SUBROUTINE System_Clearenv(ierr)
+ INTEGER, INTENT(OUT), OPTIONAL :: ierr
+ !! returns zero on success, and a nonzero value on failure. Optional.
+ !! If not present and an error occurs the program stops.
+ END SUBROUTINE System_Clearenv
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Unsetenv@Methods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: delete an environment variable by calling unsetenv(3c)
+!
+!# System_Unsetenv
+!
+! The System_Unsetenv(3f) function deletes the variable name from the
+! environment.
+
+INTERFACE
+ MODULE SUBROUTINE System_Unsetenv(name, ierr)
+ CHARACTER(*), INTENT(IN) :: name
+ !! name of variable to delete.
+ !! If name does not exist in the environment, then the
+ !! function succeeds, and the environment is unchanged.
+ INTEGER, INTENT(OUT), OPTIONAL :: ierr
+ !! The system_unsetenv(3f) function returns zero on success,
+ !! or -1 on error.
+ !! name is NULL, points to a string of length 0, or
+ !! contains an '=' character.
+ !! Insufficient memory to add a new variable to the environment.
+ END SUBROUTINE System_Unsetenv
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Readenv@Methods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: step thru and read environment table
+!
+! ## System_Readenv
+!
+! This routine provides a simple interface for reading the environment
+! variable table of the current process.
+!
+! The recommended usage pattern is as follows:
+!
+! - Call `system_initenv(3f)` to initialize access to the environment
+! table.
+!
+! - Repeatedly call `system_readenv(3f)` to read entries from the
+! environment table.
+!
+! - Reading terminates when a blank line is returned.
+!
+! ### Notes
+!
+! - If more than one thread reads the environment simultaneously, the
+! results are undefined.
+!
+! - If the environment is modified while it is being read, the results
+! are also undefined.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Readenv_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE FUNCTION System_Readenv() RESULT(string)
+ CHARACTER(:), ALLOCATABLE :: string
+ !! the string returned from the environment of the form "NAME=VALUE"
+ END FUNCTION System_Readenv
+END INTERFACE
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+END MODULE SystemEnvironment_Method
diff --git a/src/modules/System/src/SystemFile_Method.F90 b/src/modules/System/src/SystemFile_Method.F90
new file mode 100755
index 000000000..d160fbf88
--- /dev/null
+++ b/src/modules/System/src/SystemFile_Method.F90
@@ -0,0 +1,1079 @@
+! This module is mainly taken from the source:
+! https://github.com/urbanjost/M_system.
+! The original name of the program has been changed
+! from M_SYSTEM to System_Method.
+! This is to confirm to the coding sytles of easifem.
+! Original program has been re-organized into module and submodule.
+! If you are using easifem for getting methods defined in this
+! module, then please use M_System module by using the above link.
+! We would like to thank the original author Urban Jost for creating
+! This useful module.
+
+!> author: John S. Urban
+! date: 2026-02-04
+! summary: Fortran interface to C system interface
+!
+!# SystemFile_Method
+!
+! SystemFile_Method is a collection of Fortran procedures that call C
+! or a C wrapper using the ISO_C_BINDING interface to access system calls.
+! System calls are a special set of functions used by programs to communicate
+! directly with an operating system.
+!
+! Generally, system calls are slower than normal function calls because
+! when you make a call control is relinquished to the operating system
+! to perform the system call. In addition, depending on the nature of the
+! system call, your program may be blocked by the OS until the system call
+! has finished, thus making the execution time of your program even longer.
+!
+! One rule-of-thumb that should always be followed when calling a system
+! call -- Always check the return value.
+
+MODULE SystemFile_Method
+USE ISO_C_BINDING, ONLY: C_INT
+USE ISO_C_BINDING, ONLY: C_PTR
+IMPLICIT NONE
+
+PRIVATE
+
+!----------------------------------------------------------------------------
+! System_Utime@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: Set file access and modification times
+!
+!# System_Utime
+!
+! The system_utime(3f) function sets the access and modification
+! times of the file named by the path argument by calling utime(3c).
+!
+! If times() is not present the access and modification times of
+! the file shall be set to the current time.
+!
+! To use system_utime(3f) the effective user ID of the process must
+! match the owner of the file, or the process has to have write
+! permission to the file or have appropriate privileges,
+!
+!## Errors
+!
+!The underlying utime(3c) function fails if:
+!
+!### EACCES
+!
+! Search permission is denied by a component of the path
+! prefix; or the times argument is a null pointer and the
+! effective user ID of the process does not match the owner
+! of the file, the process does not have write permission
+! for the file, and the process does not have appropriate
+! privileges.
+!
+!### ELOOP
+!
+! A loop exists in symbolic links encountered during
+! resolution of the path argument.
+!
+!### ENAMETOOLONG
+!
+! The length of a component of a pathname is longer than {NAME_MAX}.
+!
+!### ENOENT
+!
+! A component of path does not name an existing file or path is an
+! empty string.
+!
+!### ENOTDIR
+!
+! A component of the path prefix names an existing file
+! that is neither a directory nor a symbolic link to a
+! directory, or the path argument contains at least one
+! non- character and ends with one or more trailing
+! characters and the last pathname component
+! names an existing file that is neither a directory nor
+! a symbolic link to a directory.
+!
+!### EPERM
+!
+! The times argument is not a null pointer and the effective
+! user ID of the calling process does not match the owner
+! of the file and the calling process does not have
+! appropriate privileges.
+!
+!### EROFS
+!
+! The file system containing the file is read-only.
+!
+!## Note
+!
+! The utime() function may fail if:
+!
+!- ELOOP More than {SYMLOOP_MAX} symbolic links were encountered
+!during resolution of the path argument.
+!
+!- ENAMETOOLONG The length of a pathname exceeds {PATH_MAX}, or
+! pathname resolution of a symbolic link produced
+! an intermediate result with a length that exceeds
+! {PATH_MAX}.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Utime_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE FUNCTION System_Utime(pathname, times)
+ CHARACTER(len=*), INTENT(in) :: pathname
+ !!name of the file whose access and modification times are to be updated.
+ INTEGER, INTENT(in), OPTIONAL :: times(2)
+ !! If present, the values will be interpreted as the access
+ !! and modification times as Unix Epoch values. That is,
+ !! they are times measured in seconds since the Unix Epoch.
+ LOGICAL :: System_Utime
+ !! Upon successful completion .TRUE. is returned. Otherwise,
+ !! .FALSE. is returned and errno shall be set to indicate the error,
+ !! and the file times remain unaffected.
+ END FUNCTION System_Utime
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_RealPath@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: Resolve the relative path
+!
+!# System_Realpath
+!
+! system_realpath(3f) calls the C routine realpath(3c) to obtain
+! the absolute pathname of given path
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Realpath_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE FUNCTION System_Realpath(input) RESULT(string)
+ CHARACTER(*), INTENT(in) :: input
+ !! pathname to resolve
+ CHARACTER(:), ALLOCATABLE :: string
+ !! The absolute pathname of the given input pathname.
+ !! The pathname shall contain no components that are dot
+ !! or dot-dot, or are symbolic links. It is equal to the
+ !! NULL character if an error occurred.
+ END FUNCTION System_Realpath
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Chown@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: change file owner and group
+!
+!# System_Chown
+!
+! Elemental impure logical function system_chown(path,owner,group)
+!
+! The chown(3f) function changes owner and group of a file
+!
+! The path argument points to a pathname naming a file. The
+! user ID and group ID of the named file shall be set to the numeric
+! values contained in owner and group, respectively.
+!
+! Only processes with an effective user ID equal to the user ID of
+! the file or with appropriate privileges may change the ownership
+! of a file.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Chown_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE ELEMENTAL IMPURE FUNCTION System_Chown(dirname, owner, group)
+ CHARACTER(*), INTENT(IN) :: dirname
+ !! A character string representing a file pathname.
+ !! Trailing spaces are ignored.
+ INTEGER, INTENT(IN) :: owner
+ !! UID of owner that ownership is to be changed to
+ INTEGER, INTENT(IN) :: group
+ !! GID of group that ownership is to be changed to
+ LOGICAL :: System_Chown
+ !! The system_chown(3f) function should return zero 0 if successful.
+ !! Otherwise, these functions shall return 1 and set errno to
+ !! indicate the error. If 1 is returned, no changes are made in
+ !! the user ID and group ID of the file.
+ END FUNCTION System_Chown
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Link@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: link one file to another file relative to two directory
+! descriptors
+!
+!# System_Link
+!
+! The link() function shall create a new link (directory entry)
+! for the existing file, path1.
+!
+! The path1 argument points to a pathname naming an existing
+! file. The path2 argument points to a pathname naming the
+! new directory entry to be created. The link() function shall
+! atomically create a new link for the existing file and the link
+! count of the file shall be incremented by one.
+!
+! If path1 names a directory, link() shall fail unless the process
+! has appropriate privileges and the implementation supports using
+! link() on directories.
+!
+! If path1 names a symbolic link, it is implementation-defined
+! whether link() follows the symbolic link, or creates a new link
+! to the symbolic link itself.
+!
+! Upon successful completion, link() shall mark for update the
+! last file status change timestamp of the file. Also, the last
+! data modification and last file status change timestamps of the
+! directory that contains the new entry shall be marked for update.
+!
+! If link() fails, no link shall be created and the link count of
+! the file shall remain unchanged.
+!
+! The implementation may require that the calling process has
+! permission to access the existing file.
+!
+! The linkat() function shall be equivalent to the link() function
+! except that symbolic links shall be handled as specified by the
+! value of flag (see below) and except in the case where either path1
+! or path2 or both are relative paths. In this case a relative path
+! path1 is interpreted relative to the directory associated with
+! the file descriptor fd1 instead of the current working directory
+! and similarly for path2 and the file descriptor fd2. If the
+! file descriptor was opened without O_SEARCH, the function shall
+! check whether directory searches are permitted using the current
+! permissions of the directory underlying the file descriptor. If
+! the file descriptor was opened with O_SEARCH, the function shall
+! not perform the check.
+!
+! Values for flag are constructed by a bitwise-inclusive OR of
+! flags from the following list, defined in :
+!
+! AT_SYMLINK_FOLLOW
+! If path1 names a symbolic link, a new link for the target
+! of the symbolic link is created.
+!
+! If linkat() is passed the special value AT_FDCWD in the fd1 or
+! fd2 parameter, the current working directory shall be used for the
+! respective path argument. If both fd1 and fd2 have value AT_FDCWD,
+! the behavior shall be identical to a call to link(), except that
+! symbolic links shall be handled as specified by the value of flag.
+!
+! Some implementations do allow links between file systems.
+!
+! If path1 refers to a symbolic link, application developers should
+! use linkat() with appropriate flags to select whether or not the
+! symbolic link should be resolved.
+!
+! If the AT_SYMLINK_FOLLOW flag is clear in the flag argument and
+! the path1 argument names a symbolic link, a new link is created
+! for the symbolic link path1 and not its target.
+
+INTERFACE
+ MODULE ELEMENTAL IMPURE FUNCTION System_Link(oldname, newname) RESULT(ierr)
+ CHARACTER(len=*), INTENT(IN) :: oldname
+ CHARACTER(len=*), INTENT(IN) :: newname
+ INTEGER :: ierr
+ !! Upon successful completion, these functions shall return
+ !! 0. Otherwise, these functions shall return -1 and set errno to
+ !! indicate the error.
+ END FUNCTION System_Link
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Unlink@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: remove a directory entry relative to directory file descriptor
+!
+!# System_Unlink
+!
+! The unlink() function shall remove a link to a file. If path names a
+! symbolic link, unlink() shall remove the symbolic link named by path
+! and shall not affect any file or directory named by the contents of
+! the symbolic link. Otherwise, unlink() shall remove the link named by
+! the pathname pointed to by path and shall decrement the link count of
+! the file referenced by the link.
+!
+! When the files link count becomes 0 and no process has the file open,
+! the space occupied by the file shall be freed and the file shall no
+! longer be accessible. If one or more processes have the file open when
+! the last link is removed, the link shall be removed before unlink()
+! returns, but the removal of the file contents shall be postponed until
+! all references to the file are closed.
+!
+! The path argument shall not name a directory unless the process has
+! appropriate privileges and the implementation supports using unlink()
+! on directories.
+!
+! Upon successful completion, unlink() shall mark for update the last
+! data modification and last file status change timestamps of the parent
+! directory. Also, if the file link count is not 0, the last file status
+! change timestamp of the file shall be marked for update.
+!
+! Values for flag are constructed by a bitwise-inclusive OR of flags from
+! the following list, defined in :
+!
+! AT_REMOVEDIR
+!
+! Remove the directory entry specified by fd and path as a
+! directory, not a normal file.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Unlink_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE ELEMENTAL IMPURE FUNCTION System_Unlink(fname) RESULT(ierr)
+ CHARACTER(len=*), INTENT(in) :: fname
+ INTEGER :: ierr
+ !! Upon successful completion, these functions shall return 0. Otherwise,
+ !! these functions shall return -1 and set errno to indicate the error.
+ !! If -1 is returned, the named file shall not be changed.
+ END FUNCTION System_Unlink
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Setumask@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: Set the file mode creation umask
+!
+!# System_Setumask
+!
+! The `system_umask(3f)` function sets the file mode creation mask of
+! the calling process to `cmask` and returns the previous value of
+! the mask.
+!
+! Only the file permission bits of `cmask` (see ``) are
+! used. The interpretation of any other bits is
+! implementation-defined.
+!
+!### Effect of the file creation mask
+!
+! The file mode creation mask is applied to the `mode` argument
+! supplied to the following functions:
+!
+! - `open()`, `openat()`, `creat()`
+! - `mkdir()`, `mkdirat()`, `mkfifo()`, `mkfifoat()`
+! - `mknod()`, `mknodat()`
+! - `mq_open()`
+! - `sem_open()`
+!
+!## Semantics
+!
+! - Bit positions that are set in `cmask` are cleared in the `mode`
+! of any subsequently created file or object.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Setumask_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE FUNCTION System_Setumask(Umask_Value) RESULT(Old_Umask)
+ INTEGER, INTENT(in) :: Umask_Value
+ INTEGER :: Old_Umask
+ !! The file permission bits in the value returned by umask() shall be
+ !! the previous value of the file mode creation mask. The state of any
+ !! other bits in that value is unspecified, except that a subsequent
+ !! call to umask() with the returned value as cmask shall leave the
+ !! state of the mask the same as its state before the first call,
+ !! including any unspecified use of those bits.
+ END FUNCTION System_Setumask
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Chdir@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: change working directory
+!
+!# System_Chdir
+!
+! The `system_chdir(3f)` procedure changes the current working directory
+! of the calling process to the directory specified by `path`.
+!
+! The current working directory is used as the starting point for
+! interpreting relative pathnames (those not beginning with `/`).
+!
+!## Errors
+!
+! On failure, an error condition is reported as described below. The
+! specific error returned may depend on the underlying file system.
+!
+! The following errors correspond to the C `chdir()` definitions:
+!
+! - `EACCES`
+! Search permission is denied for one of the components of `path`.
+! See also `path_resolution(7)`.
+!
+! - `EFAULT`
+! `path` points outside the accessible address space.
+!
+! - `EIO`
+! An I/O error occurred.
+!
+! - `ELOOP`
+! Too many symbolic links were encountered while resolving `path`.
+!
+! - `ENAMETOOLONG`
+! `path` is too long.
+!
+! - `ENOENT`
+! The specified file does not exist.
+!
+! - `ENOMEM`
+! Insufficient kernel memory was available.
+!
+! - `ENOTDIR`
+! A component of `path` is not a directory.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Chdir_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE SUBROUTINE System_Chdir(path, err)
+ CHARACTER(len=*), INTENT(IN) :: path
+ INTEGER, OPTIONAL, INTENT(OUT) :: err
+ !! On success, zero is returned. On error, -1 is returned, and errno is
+ !! set appropriately.
+ END SUBROUTINE System_Chdir
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Remove@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: remove a file
+!
+!# System_Remove
+!
+! Fortran supports scratch files via the OPEN(3c) command; but does
+! not otherwise allow for removing files. The system_remove(3f) command
+! allows for removing files by name that the user has the authority to
+! remove by calling the C remove(3c) function.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Remove_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE ELEMENTAL IMPURE FUNCTION System_Remove(path) RESULT(err)
+ CHARACTER(*), INTENT(in) :: path
+ INTEGER(C_INT) :: err
+ END FUNCTION System_Remove
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Rename@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: rename a system file
+!
+!# System_Rename
+!
+! Rename a file by calling rename(3c). It is not recommended that the
+! rename occur while either filename is being used on a file currently
+! OPEN(3f) by the program.
+! Both the old and new names must be on the same device.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Rename_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE FUNCTION System_Rename(input, output) RESULT(ierr)
+ CHARACTER(*), INTENT(IN) :: input, output
+ !! system filename of an existing file to rename
+ !! system filename to be created or overwritten by INPUT file.
+ !! Must be on the same device as the INPUT file.
+ INTEGER :: ierr
+ !! zero (0) if no error occurs. If not zero a call to
+ !! system_errno(3f) or system_perror(3f) is supported
+ !! to diagnose error
+ END FUNCTION System_Rename
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Chmod@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: call chmod to change permission mode of a file
+! relative to directory file descriptor
+!
+!# System_Chmod
+!
+! The `system_chmod(3f)` function changes the `S_ISUID`, `S_ISGID`,
+! `S_ISVTX`, and file permission bits of the file specified by `path`
+! to the corresponding bits in the `mode` argument.
+!
+! The application shall ensure that the effective user ID of the
+! calling process matches the owner of the file, or that the process
+! has sufficient privileges.
+!
+! The constants `S_ISUID`, `S_ISGID`, `S_ISVTX`, and the file
+! permission bits are defined in ``.
+!
+!## Privilege and group semantics
+!
+! - If the calling process lacks appropriate privileges, and
+! the group ID of the file does not match the effective group ID
+! or any supplementary group ID, then `S_ISGID` is cleared on
+! successful return when the file is a regular file.
+!
+! - Additional implementation-defined restrictions may cause the
+! `S_ISUID` and `S_ISGID` bits in `mode` to be ignored.
+!
+!## Timestamps
+!
+! - Upon successful completion, `system_chmod()` marks the last
+! file status change timestamp of the file for update.
+!
+!## Flags
+!
+! Values for `flag` are constructed using a bitwise-inclusive OR of
+! the following values defined in ``:
+!
+! - `AT_SYMLINK_NOFOLLOW`
+! If `path` names a symbolic link, the mode of the symbolic link
+! itself is changed rather than the target.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Chmod_test_1.F90" %}}
+!```
+!
+INTERFACE
+ MODULE FUNCTION System_Chmod(filename, mode) RESULT(ierr)
+ CHARACTER(*), INTENT(IN) :: filename
+ INTEGER, VALUE, INTENT(IN) :: mode
+ INTEGER :: ierr
+ !! Upon successful completion, system_chmod(3f) returns 0.
+ !! Otherwise, it returns -1 and sets errno to indicate the error. If
+ !! -1 is returned, no change to the file mode occurs.
+ END FUNCTION System_Chmod
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Getcwd@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: Get current working directory
+!
+!# System_Getcwd
+!
+! Get current working directory
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Getcwd_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE SUBROUTINE System_Getcwd(output, ierr)
+ CHARACTER(len=:), ALLOCATABLE, INTENT(out) :: output
+ !! The absolute pathname of the current working directory
+ !! The pathname shall contain no components that are dot or dot-dot,
+ !! or are symbolic links.
+ INTEGER, INTENT(out) :: ierr
+ !! ierr is not zero if an error occurs.
+ END SUBROUTINE System_Getcwd
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Rmdir@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: remove empty directories
+!
+!# System_Rmdir
+!
+! Remove empty directories.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Rmdir_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE FUNCTION System_Rmdir(dirname) RESULT(err)
+ CHARACTER(*), INTENT(IN) :: dirname
+ !! The name of a directory to remove if it is empty
+ INTEGER(C_INT) :: err
+ !! zero (0) if no error occurred
+ END FUNCTION System_Rmdir
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Mkfifo@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: make a FIFO special file relative to directory file descriptor
+!
+!# System_Mkfifo
+!
+! A regular pipe can only connect two related processes. It is created
+! by a process and vanishes when the last process closes it.
+!
+! A named pipe, also known as a FIFO, can connect two unrelated
+! processes and exists independently of the processes using it.
+! A FIFO is created using the `mkfifo()` library function.
+!
+!## Behavior and semantics
+!
+! - `mkfifo()` creates a new FIFO special file specified by `pathname`.
+! - The file permission bits of the new FIFO are initialized from
+! `mode`.
+! - The permission bits specified in `mode` are modified by the
+! process file creation mask.
+! - If bits other than file permission bits are set in `mode`,
+! the effect is implementation-defined.
+! - If `pathname` names a symbolic link, `mkfifo()` fails and sets
+! `errno` to `EEXIST`.
+! - The FIFO user ID is set to the effective user ID of the process.
+! - The FIFO group ID is set either to the group ID of the parent
+! directory or to the effective group ID of the process.
+! - Implementations shall provide a method to initialize the FIFO
+! group ID from the parent directory.
+! - Implementations may optionally provide a method to initialize
+! the FIFO group ID from the effective group ID of the caller.
+! - Upon successful completion, the FIFO last access, modification,
+! and status change timestamps are marked for update.
+! - The directory containing the new FIFO also has its modification
+! and status change timestamps updated.
+!
+!## Permission modes
+!
+! Predefined variables are typically used to specify permission modes.
+! These variables may be combined using a bytewise OR operation.
+!
+! Permission bits by category:
+!
+! - **User**
+! - `R_USR` : read
+! - `W_USR` : write
+! - `X_USR` : execute
+!
+! - **Group**
+! - `R_GRP` : read
+! - `W_GRP` : write
+! - `X_GRP` : execute
+!
+! - **Others**
+! - `R_OTH` : read
+! - `W_OTH` : write
+! - `X_OTH` : execute
+!
+!## Shortcut constants
+!
+! The following predefined constants represent common combinations:
+!
+! - `RWX_U` : read, write, execute for user
+! - `RWX_G` : read, write, execute for group
+! - `RWX_O` : read, write, execute for others
+! - `DEFFILEMODE`
+! Equivalent to octal `0666` (`rw-rw-rw-`)
+! - `ACCESSPERMS`
+! Equivalent to octal `0777` (`rwxrwxrwx`)
+!
+!## Examples
+!
+! To grant read, write, and execute permissions only to the user:
+!
+! - `ierr = mkfifo("myfile", IANY([R_USR, W_USR, X_USR]))`
+! - `ierr = mkfifo("myfile", RWX_U)`
+!
+! To grant full permissions to all users (mode `0777`):
+!
+! - `ierr = mkfifo("myfile", IANY([R_USR, W_USR, X_USR, R_GRP, W_GRP, &
+! X_GRP, R_OTH, W_OTH, X_OTH]))`
+! - `ierr = mkfifo("myfile", IANY([RWX_U, RWX_G, RWX_O]))`
+! - `ierr = mkfifo("myfile", ACCESSPERMS)`
+!
+!```fortran
+! {{% fortran-code file="examples/System_Mkfifo_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE FUNCTION System_Mkfifo(pathname, mode) RESULT(err)
+ CHARACTER(*), INTENT(IN) :: pathname
+ INTEGER, INTENT(IN) :: mode
+ INTEGER :: err
+ !! Upon successful completion, return 0.
+ !! Otherwise, return -1 and set errno to indicate the error.
+ !! If -1 is returned, no FIFO is created.
+ END FUNCTION System_Mkfifo
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Mkdir@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: call mkdir(3c) to create a new directory
+!
+!# System_Mkdir
+!
+! Predefined variables are typically used to set permission modes.
+! These variables can be combined using a bytewise OR operation to
+! create commonly used permission settings.
+!
+! Permission bits by category:
+!
+! - **User**
+! - `R_USR` : read
+! - `W_USR` : write
+! - `X_USR` : execute
+!
+! - **Group**
+! - `R_GRP` : read
+! - `W_GRP` : write
+! - `X_GRP` : execute
+!
+! - **Others**
+! - `R_OTH` : read
+! - `W_OTH` : write
+! - `X_OTH` : execute
+!
+! Additional shortcut constants are provided. These are predefined
+! bitwise-OR combinations of the permission flags listed above:
+!
+! - `RWX_U` : read, write, and execute for user
+! - `RWX_G` : read, write, and execute for group
+! - `RWX_O` : read, write, and execute for others
+! - `DEFFILEMODE`
+! Equivalent to octal `0666` (`rw-rw-rw-`)
+! - `ACCESSPERMS`
+! Equivalent to octal `0777` (`rwxrwxrwx`)
+!
+! To grant only the user read, write, and execute permissions, while
+! denying all permissions to group members and others, any of the
+! following `mkdir()` calls may be used equivalently:
+!
+! - `ierr = mkdir("mydir", IANY([R_USR, W_USR, X_USR]))`
+! - `ierr = mkdir("mydir", RWX_U)`
+!
+! To grant full permissions to all users (mode `0777`, `rwxrwxrwx`),
+! any of the following calls may be used equivalently:
+!
+! - `ierr = mkdir("mydir", IANY([R_USR, W_USR, X_USR, R_GRP, W_GRP, X_GRP, &
+! R_OTH, W_OTH, X_OTH]))`
+! - `ierr = mkdir("mydir", IANY([RWX_U, RWX_G, RWX_O]))`
+! - `ierr = mkdir("mydir", ACCESSPERMS)`
+!
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Mkdir_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE FUNCTION System_Mkdir(dirname, mode) RESULT(ierr)
+ CHARACTER(len=*), INTENT(in) :: dirname
+ INTEGER, INTENT(in) :: mode
+ INTEGER :: ierr
+ END FUNCTION System_Mkdir
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Opendir@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: open directory stream by calling opendir
+!
+!# System_Opendir
+!
+! The `system_opendir(3f)` procedure opens a directory stream that
+! corresponds to the directory specified by the `dirname` argument.
+!
+! The directory stream is positioned at the first directory entry.
+!
+!## Return value
+!
+! - Upon successful completion, a pointer to a C `DIR` type is returned.
+!
+! - On failure, a null pointer is returned and `IERR` is set to indicate
+! the error condition.
+!
+!## Errors
+!
+! Errors correspond to the conditions described for `opendir(3c)`,
+! including the following:
+!
+! - `EACCES`
+! Search permission is denied for a component of the path prefix of
+! `dirname`, or read permission is denied for `dirname`.
+!
+! - `ELOOP`
+! A loop exists in symbolic links encountered during resolution of
+! the `dirname` argument.
+!
+! - `ENAMETOOLONG`
+! The length of a pathname component exceeds `{NAME_MAX}`.
+!
+! - `ENOENT`
+! A component of `dirname` does not name an existing directory, or
+! `dirname` is an empty string.
+!
+! - `ENOTDIR`
+! A component of `dirname` names an existing file that is neither a
+! directory nor a symbolic link to a directory.
+!
+! - `ELOOP`
+! More than `{SYMLOOP_MAX}` symbolic links were encountered during
+! resolution of the `dirname` argument.
+!
+! - `EMFILE`
+! All file descriptors available to the process are currently open.
+!
+! - `ENAMETOOLONG`
+! The length of a pathname exceeds `{PATH_MAX}`, or pathname
+! resolution of a symbolic link produced an intermediate result whose
+! length exceeds `{PATH_MAX}`.
+!
+! - `ENFILE`
+! Too many files are currently open in the system.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Opendir_test_1.F90" %}}
+!```
+!
+INTERFACE
+ MODULE SUBROUTINE System_Opendir(dirname, dir, ierr)
+ CHARACTER(len=*), INTENT(IN) :: dirname
+ !! name of directory to open a directory stream for
+ TYPE(C_PTR), INTENT(INOUT) :: dir
+ !! pointer to directory stream. If an
+ !! error occurred, it will not be associated.
+ INTEGER, INTENT(OUT) :: ierr
+ !! ierr 0 indicates no error occurred
+ END SUBROUTINE System_Opendir
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Readdir@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: Read a directory
+!
+!# System_Readdir
+!
+! system_readdir(3f) returns the name of the directory entry at the
+! current position in the directory stream specified by the argument
+! DIR, and positions the directory stream at the next entry. It returns
+! a null name upon reaching the end of the directory stream.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Readdir_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE SUBROUTINE System_Readdir(dir, filename, ierr)
+ TYPE(C_PTR), VALUE :: dir
+ !! A pointer to the directory opened by system_opendir(3f).
+ CHARACTER(len=:), INTENT(out), ALLOCATABLE :: filename
+ !! the name of the directory entry at the current position in
+ !! the directory stream specified by the argument DIR, and
+ !! positions the directory stream at the next entry.
+ !! The readdir() function does not return directory entries
+ !! containing empty names. If entries for dot or dot-dot exist,
+ !! one entry is returned for dot and one entry is returned
+ !! for dot-dot.
+ !! The entry is marked for update of the last data access
+ !! timestamp each time it is read.
+ !! reaching the end of the directory stream, the name is a blank name.
+ INTEGER, INTENT(out) :: ierr
+ !! If IERR is set to non-zero on return, an error occurred.
+ END SUBROUTINE System_Readdir
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Rewinddir@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: Rewind directory stream
+!
+!# System_Rewinddir
+!
+! Return to pointer to the beginning of the list for a currently open
+! directory list.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Rewinddir_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE SUBROUTINE System_Rewinddir(dir)
+ TYPE(C_PTR), VALUE :: dir
+ !! A C_Pointer assumed to have been allocated by a
+ !! call to SYSTEM_OPENDIR(3f).
+ END SUBROUTINE System_Rewinddir
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Closedir@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: Close a directory stream by calling closedir
+!
+!# System_Closedir
+!
+! The SYSTEM_CLOSEDIR(3f) function closes the directory stream
+! referred to by the argument DIR. Upon return, the value of DIR may no
+! longer point to an accessible object.
+!
+! system_closedir(3f) may fail if:
+!
+!- EBADF: The dirp argument does not refer to an open directory stream.
+!- EINTR: The closedir() function was interrupted by a signal.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Closedir_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE SUBROUTINE System_Closedir(dir, ierr)
+ TYPE(C_PTR), VALUE :: dir
+ !! directory stream pointer opened by SYSTEM_OPENDIR(3f).
+ INTEGER, INTENT(out), OPTIONAL :: ierr
+ !! Upon successful completion, SYSTEM_CLOSEDIR(3f) returns 0;
+ !! otherwise, an error has occurred.
+ END SUBROUTINE System_Closedir
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! Fileglob@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: Read output of an ls(1) command from Fortran
+!
+!# Fileglob
+!
+! Non-portable procedure uses the shell and the ls(1) command
+! to expand a filename
+! and returns a pointer to a list of expanded filenames.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/Fileglob_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE SUBROUTINE Fileglob(glob, list)
+ CHARACTER(*), INTENT(IN) :: glob
+ !! Pattern for the filenames (like: *.txt)
+ CHARACTER(*), POINTER, INTENT(INOUT) :: list(:)
+ !! Allocated list of filenames (returned), the caller must deallocate it.
+ END SUBROUTINE Fileglob
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Dir@FileMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: Return filenames in a directory matching specific wildcard strings
+!
+!# System_Dir
+!
+! returns an array of filenames in the specified directory matching
+! the wildcard string (which defaults to "*").
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Dir_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE FUNCTION System_Dir(directory, pattern)
+ CHARACTER(*), INTENT(IN), OPTIONAL :: directory
+ !! name of directory to match filenames in. Defaults to ".".
+ CHARACTER(*), INTENT(IN), OPTIONAL :: pattern
+ !! wildcard string matching the rules of the matchw(3f) function.
+ !! Basically "*" matches anything, "?" matches any single character
+ CHARACTER(:), ALLOCATABLE :: System_Dir(:)
+ !!System_Dir An array right-padded to the length of the longest
+ !!filename. Note that this means filenames actually containing
+ !!trailing spaces in their names may be incorrect.
+ END FUNCTION System_Dir
+END INTERFACE
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+END MODULE SystemFile_Method
diff --git a/src/modules/System/src/SystemInterface.F90 b/src/modules/System/src/SystemInterface.F90
new file mode 100644
index 000000000..17383e16b
--- /dev/null
+++ b/src/modules/System/src/SystemInterface.F90
@@ -0,0 +1,1202 @@
+! This program is a part of EASIFEM library
+! Expandable And Scalable Infrastructure for Finite Element Methods
+! htttps://www.easifem.com
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see
+
+MODULE SystemInterface
+USE ISO_C_BINDING, ONLY: C_INT, C_SIZE_T, C_INTPTR_T, C_LONG, C_FLOAT
+USE ISO_C_BINDING, ONLY: C_LONG_LONG, C_PTR, C_FUNPTR, C_CHAR, C_LONG
+IMPLICIT NONE
+
+PRIVATE
+PUBLIC :: System_Alarm
+PUBLIC :: System_Calloc
+PUBLIC :: System_Clock
+PUBLIC :: System_Memcpy
+PUBLIC :: System_Free
+PUBLIC :: System_Malloc
+PUBLIC :: System_Realloc
+PUBLIC :: System_Time
+PUBLIC :: System_Srand
+PUBLIC :: System_Kill
+PUBLIC :: System_Errno
+PUBLIC :: System_Geteuid
+PUBLIC :: System_Getuid
+PUBLIC :: System_Getegid
+PUBLIC :: System_Getgid
+PUBLIC :: System_Setsid
+PUBLIC :: System_Getsid
+PUBLIC :: System_Getpid
+PUBLIC :: System_Getppid
+PUBLIC :: System_Umask
+PUBLIC :: System_Rand
+PUBLIC :: System_Initenv
+
+PUBLIC :: C_Flush
+PUBLIC :: C_Signal
+PUBLIC :: C_Access
+PUBLIC :: C_Utime
+PUBLIC :: C_RealPath
+PUBLIC :: C_Issock
+PUBLIC :: C_Time
+PUBLIC :: C_Chown
+PUBLIC :: C_Link
+PUBLIC :: C_Unlink
+PUBLIC :: C_Chdir
+PUBLIC :: C_Remove
+PUBLIC :: C_Rename
+PUBLIC :: C_Chmod
+PUBLIC :: C_Setenv
+PUBLIC :: C_Unsetenv
+PUBLIC :: C_Readenv
+PUBLIC :: C_Putenv
+PUBLIC :: C_Isfifo
+PUBLIC :: C_Ischr
+PUBLIC :: C_Isreg
+PUBLIC :: C_Islnk
+PUBLIC :: C_Isblk
+PUBLIC :: C_Isdir
+PUBLIC :: C_CPU_Time
+PUBLIC :: C_Perror
+PUBLIC :: C_Uname
+PUBLIC :: C_Gethostname
+PUBLIC :: C_Getlogin
+PUBLIC :: C_Perm
+PUBLIC :: C_Getgrgid
+PUBLIC :: C_Getpwuid
+PUBLIC :: C_Stat
+
+!----------------------------------------------------------------------------
+! System_Alarm
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION System_Alarm(seconds) BIND(c, name="alarm")
+ IMPORT :: C_INT
+ INTEGER(kind=C_INT), VALUE :: seconds
+ INTEGER(kind=C_INT) :: System_Alarm
+ END FUNCTION System_Alarm
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Calloc
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION System_Calloc(nelem, elsize) BIND(c, name="calloc")
+ IMPORT :: C_SIZE_T, C_INTPTR_T
+ INTEGER(C_SIZE_T), VALUE :: nelem, elsize
+ INTEGER(C_INTPTR_T) :: System_Calloc
+ END FUNCTION System_Calloc
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! SYSTEM_CLOCK
+!----------------------------------------------------------------------------
+
+INTERFACE
+ PURE FUNCTION SYSTEM_CLOCK() BIND(c, name="clock")
+ IMPORT :: C_LONG
+ INTEGER(C_LONG) :: system_clock
+ END FUNCTION SYSTEM_CLOCK
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Memcpy
+!----------------------------------------------------------------------------
+
+! Copy N bytes of SRC to DEST, no aliasing or overlapping allowed.
+! extern void *memcpy (void *dest, const void *src, size_t n);
+INTERFACE
+ SUBROUTINE System_Memcpy(dest, src, n) BIND(C, name='memcpy')
+ IMPORT :: C_INTPTR_T, C_SIZE_T
+ INTEGER(C_INTPTR_T), VALUE :: dest
+ INTEGER(C_INTPTR_T), VALUE :: src
+ INTEGER(C_SIZE_T), VALUE :: n
+ END SUBROUTINE System_Memcpy
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Free
+!----------------------------------------------------------------------------
+
+INTERFACE
+ SUBROUTINE System_Free(ptr) BIND(c, name="free")
+ IMPORT :: C_INTPTR_T
+ INTEGER(C_INTPTR_T), VALUE :: ptr
+ END SUBROUTINE System_Free
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Malloc
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION System_Malloc(size) BIND(c, name="malloc")
+ IMPORT :: C_SIZE_T, C_INTPTR_T
+ INTEGER(C_SIZE_T), VALUE :: size
+ INTEGER(C_INTPTR_T) :: System_Malloc
+ END FUNCTION System_Malloc
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Realloc
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION System_Realloc(ptr, size) BIND(c, name="realloc")
+ IMPORT :: C_SIZE_T, C_INTPTR_T
+ INTEGER(C_INTPTR_T), VALUE :: ptr
+ INTEGER(C_SIZE_T), VALUE :: size
+ INTEGER(C_INTPTR_T) :: System_Realloc
+ END FUNCTION System_Realloc
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Time
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION System_Time(tloc) BIND(c, name="time")
+ ! tloc argument should be loaded via C_LOC from iso_c_binding
+ IMPORT :: C_PTR, C_LONG
+ TYPE(C_PTR), VALUE :: tloc
+ INTEGER(C_LONG) :: System_Time
+ END FUNCTION System_Time
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Srand
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: Set seed for pseudo-random number generator system_rand(3f)
+!
+!# System_Srand
+!
+! System_Srand(3f) calls the C routine srand(3c) The
+! srand(3c)/System_Srand(3f) function uses its argument as the seed
+! for a new sequence of pseudo-random integers to be returned by
+! system_rand(3f)/rand(3c). These sequences are repeatable by calling
+! System_Srand(3f) with the same seed value. If no seed value is
+! provided, the system_rand(3f) function is automatically seeded with
+! a value of 1.
+!
+!
+!## Usage
+!
+!```fortran
+! program System_Srand
+! use M_system, only : System_Srand, system_rand
+! implicit none
+! integer :: i,j
+! do j=1,2
+! call System_Srand(1001)
+! do i=1,10
+! write(*,*)system_rand()
+! enddo
+! write(*,*)
+! enddo
+! end program System_Srand
+!```
+
+INTERFACE
+ SUBROUTINE System_Srand(seed) BIND(c, name='srand')
+ IMPORT C_INT
+ INTEGER(kind=C_INT), INTENT(in) :: seed
+ END SUBROUTINE System_Srand
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Kill
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-04
+! summary: sends a signal to a process or a group of processes
+!
+!# System_Kill
+!
+! The kill() function shall send a signal to a process or a group of
+! processes specified by pid. The signal to be sent is specified by sig
+! and is either one from the list given in or 0. If sig is 0
+! (the null signal), error checking is performed but no signal is actually
+! sent. The null signal can be used to check the validity of pid.
+!
+! For a process to have permission to send a signal to a process designated
+! by pid, unless the sending process has appropriate privileges, the real
+! or effective user ID of the sending process shall match the real or
+! saved set-user-ID of the receiving process.
+!
+! If pid is greater than 0, sig shall be sent to the process whose process
+! ID is equal to pid.
+!
+! If pid is 0, sig shall be sent to all processes (excluding an unspecified
+! set of system processes) whose process group ID is equal to the process
+! group ID of the sender, and for which the process has permission to send
+! a signal.
+!
+! If pid is -1, sig shall be sent to all processes (excluding an unspecified
+! set of system processes) for which the process has permission to send
+! that signal.
+!
+! If pid is negative, but not -1, sig shall be sent to all processes
+! (excluding an unspecified set of system processes) whose process group
+! ID is equal to the absolute value of pid, and for which the process has
+! permission to send a signal.
+!
+! If the value of pid causes sig to be generated for the sending process,
+! and if sig is not blocked for the calling thread and if no other thread
+! has sig unblocked or is waiting in a sigwait() function for sig, either
+! sig or at least one pending unblocked signal shall be delivered to the
+! sending thread before kill() returns.
+!
+! The user ID tests described above shall not be applied when sending
+! SIGCONT to a process that is a member of the same session as the sending
+! process.
+!
+! An implementation that provides extended security controls may impose
+! further implementation-defined restrictions on the sending of signals,
+! including the null signal. In particular, the system may deny the
+! existence of some or all of the processes specified by pid.
+!
+! The kill() function is successful if the process has permission to send
+! sig to any of the processes specified by pid. If kill() fails, no signal
+! shall be sent.
+!
+!
+! Upon successful completion, 0 shall be returned. Otherwise, -1 shall be
+! returned and errno set to indicate the error.
+!
+!## ERRORS
+!
+! The kill() function shall fail if:
+!
+! EINVAL The value of the sig argument is an invalid or unsupported signal
+! number.
+!
+! EPERM The process does not have permission to send the signal to
+! any receiving process.
+!
+! ESRCH No process or process group can be found corresponding to
+! that specified by pid. The following sections are informative.
+!
+!## Examples
+!
+!```fortran
+! program demo_system_kill
+! use M_system, only : system_kill
+! use M_system, only : system_perror
+! implicit none
+! integer :: i,pid,ios,ierr,signal=9
+! character(len=80) :: argument
+!
+! do i=1,command_argument_count()
+! ! get arguments from command line
+! call get_command_argument(i, argument)
+! ! convert arguments to integers assuming they are PID numbers
+! read(argument,'(i80)',iostat=ios) pid
+! if(ios.ne.0)then
+! write(*,*)'bad PID=',trim(argument)
+! else
+! write(*,*)'kill SIGNAL=',signal,' PID=',pid
+! ! send signal SIGNAL to pid PID
+! ierr=system_kill(pid,signal)
+! ! write message if an error was detected
+! if(ierr.ne.0)then
+! call system_perror('*demo_system_kill*')
+! endif
+! endif
+! enddo
+! end program demo_system_kill
+!```
+
+INTERFACE
+ FUNCTION System_Kill(pid, signal) BIND(c, name="kill") RESULT(c_ierr)
+ IMPORT C_INT
+ INTEGER(kind=C_INT), VALUE, INTENT(in) :: pid
+ INTEGER(kind=C_INT), VALUE, INTENT(in) :: signal
+ INTEGER(kind=C_INT) :: c_ierr
+ END FUNCTION System_Kill
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Errno
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-04
+! summary: C error return value
+!
+!# System_Errno
+!
+! Many C routines return an error code which can be queried by errno.
+! The M_system(3fm) is primarily composed of Fortran routines that call
+! C routines. In the cases where an error code is returned vi
+! system_errno(3f) these routines will indicate it.
+!
+!## Examples
+!
+! Sample program:
+!
+!```fortran
+! program demo_system_errno
+! use M_system, only : system_errno, system_unlink, system_perror
+! implicit none
+! integer :: stat
+! stat=system_unlink('not there/OR/anywhere')
+! if(stat.ne.0)then
+! write(*,*)'err=',system_errno()
+! call system_perror('*demo_system_errno*')
+! endif
+! end program demo_system_errno
+!```
+!
+!```txt
+! Typical Results:
+! err= 2
+! *demo_system_errno*: No such file or directory
+!```
+
+INTERFACE
+ INTEGER(kind=C_INT) FUNCTION System_Errno() BIND(C, name="my_errno")
+ IMPORT C_INT
+ END FUNCTION System_Errno
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Geteuid
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: Get effective UID of current process from Fortran
+!
+!# System_Geteuid
+!
+! The system_geteuid(3f) function shall return the effective user
+! ID of the calling process. The geteuid() function shall always be
+! successful and no return value is reserved to indicate the error.
+!
+!## Examples
+!
+!```fortran
+! program demo_system_geteuid
+! use M_system, only : system_geteuid
+! implicit none
+! write(*,*)'EFFECTIVE UID=',system_geteuid()
+! end program demo_system_geteuid
+!```
+
+INTERFACE
+ INTEGER(kind=C_INT) FUNCTION System_Geteuid() BIND(C, name="geteuid")
+ IMPORT C_INT
+ END FUNCTION System_Geteuid
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Getuid
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: get real UID of current process from Fortran
+!
+!# System_Getuid
+!
+! The system_getuid(3f) function shall return the real user ID
+! of the calling process. The getuid() function shall always be
+! successful and no return value is reserved to indicate the error.
+!
+!## Examples
+!
+!```fortran
+! program demo_system_getuid
+! use M_system, only : system_getuid
+! implicit none
+! write(*,*)'UID=',system_getuid()
+! end program demo_system_getuid
+!```
+
+INTERFACE
+ INTEGER(kind=C_INT) FUNCTION System_Getuid() BIND(C, name="getuid")
+ IMPORT C_INT
+ END FUNCTION System_Getuid
+END INTERFACE
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: get the effective group ID (GID) of current process from Fortran
+!
+!# System_Getegid
+!
+! The getegid() function returns the effective group ID of the
+! calling process.
+!
+! The getegid() should always be successful and no return value is
+! reserved to indicate an error.
+!
+!## Examples
+!
+!```fortran
+! program demo_system_getegid
+! use M_system, only : system_getegid
+! implicit none
+! write(*,*)'GID=',system_getegid()
+! end program demo_system_getegid
+!```
+
+INTERFACE
+ INTEGER(kind=C_INT) FUNCTION System_Getegid() BIND(C, name="getegid")
+ IMPORT C_INT
+ END FUNCTION System_Getegid
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Getgid
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: get the real group ID (GID) of current process from Fortran
+!
+!# System_Getgid
+!
+! The getgid() function returns the real group ID of the calling process.
+!
+! The getgid() should always be successful and no return value is
+! reserved to indicate an error.
+!
+!## Examples
+!
+!```fortran
+! program demo_system_getgid
+! use M_system, only : system_getgid
+! implicit none
+! write(*,*)'GID=',system_getgid()
+! end program demo_system_getgid
+!```
+
+INTERFACE
+ INTEGER(kind=C_INT) FUNCTION System_Getgid() BIND(C, name="getgid")
+ IMPORT C_INT
+ END FUNCTION System_Getgid
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Setsid
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: create session and set the process group ID of a session leader
+!
+!# System_Setsid
+!
+! The setsid() function creates a new session, if the calling process
+! is not a process group leader. Upon return the
+! calling process shall be the session leader of this new session,
+! shall be the process group leader of a new process
+! group, and shall have no controlling terminal.
+! The process group ID of the calling process shall be set equal to the
+! process ID of the calling process.
+! The calling process shall be the only process in the new process group
+! and the only process in the new session.
+!
+! Upon successful completion, setsid() shall return the value of
+! the new process group ID of the calling process. Otherwise,
+! it shall return �-1 and set errno to indicate the error.
+!
+!## Errors
+!
+! The setsid() function shall fail if:
+!
+!- The calling process is already a process group leader
+!- the process group ID of a process other than the calling
+! process matches the process ID of the calling process.
+!
+!## Examples
+!
+!```fortran
+! program demo_system_setsid
+! use M_system, only : system_setsid
+! implicit none
+! write(*,*)'SID=',system_setsid()
+! end program demo_system_setsid
+!```
+
+INTERFACE
+ INTEGER(kind=C_INT) FUNCTION System_Setsid() BIND(C, name="setsid")
+ IMPORT C_INT
+ END FUNCTION System_Setsid
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Getsid
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: Get the process group ID of a session leader
+!
+!# System_Getsid
+!
+! The system_getsid() function obtains the process group ID of the
+! process that is the session leader of the process specified by pid.
+! If pid is 0, it specifies the calling process.
+!
+! Upon successful completion, system_getsid() shall return the process group
+! ID of the session leader of the specified process. Otherwise,
+! it shall return -1 and set errno to indicate the error.
+!
+!
+!## Usage
+!
+!```fortran
+! program demo_system_getsid
+! use M_system, only : system_getsid
+! use ISO_C_BINDING, only : c_int
+! implicit none
+! write(*,*)'SID=',system_getsid(0_c_int)
+! end program demo_system_getsid
+!```
+
+INTERFACE
+ INTEGER(kind=C_INT) FUNCTION System_Getsid(c_pid) BIND(C, name="getsid")
+ IMPORT C_INT
+ INTEGER(kind=C_INT) :: c_pid
+ END FUNCTION System_Getsid
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Getpid
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: Get PID (process ID) of current process from Fortran
+!
+!# System_Getpid
+!
+! The system_getpid() function returns the process ID of the
+! calling process.
+!
+! The value returned is the integer process ID. The system_getpid()
+! function shall always be successful and no return value is reserved
+! to indicate an error.
+!
+!
+!## Usage
+!
+!```fortran
+! program demo_system_getpid
+! use M_system, only : system_getpid
+! implicit none
+! write(*,*)'PID=',system_getpid()
+! end program demo_system_getpid
+!```
+
+INTERFACE
+ PURE INTEGER(kind=C_INT) FUNCTION System_Getpid() BIND(C, name="getpid")
+ IMPORT C_INT
+ END FUNCTION System_Getpid
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Getppid
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: get parent process ID (PPID) of current process from Fortran
+!
+!# System_Getppid
+!
+! The system_getppid() function returns the parent process ID of
+! the calling process.
+!
+! The system_getppid() function should always be successful and no
+! return value is reserved to indicate an error.
+!
+!## Examples
+!
+!```fortran
+! program demo_system_getppid
+! use M_system, only : system_getppid
+! implicit none
+! write(*,*)'PPID=',system_getppid()
+! end program demo_system_getppid
+!```
+
+INTERFACE
+ INTEGER(kind=C_INT) FUNCTION System_Getppid() BIND(C, name="getppid")
+ IMPORT C_INT
+ END FUNCTION System_Getppid
+END INTERFACE
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: Set and get the file mode creation mask
+!
+!# System_Umask
+!
+! The system_umask() function shall set the file mode creation mask of the
+! process to cmask and return the previous value of the mask. Only
+! the file permission bits of cmask (see ) are used;
+! the meaning of the other bits is implementation-defined.
+!
+! The file mode creation mask of the process is used to turn off
+! permission bits in the mode argument supplied during calls to
+! the following functions:
+!
+! Bit positions that are set in cmask are cleared in the mode of
+! the created file.
+!
+! The file permission bits in the value returned by umask() shall be
+! the previous value of the file mode creation mask. The state of any
+! other bits in that value is unspecified, except that a subsequent
+! call to umask() with the returned value as cmask shall leave the
+! state of the mask the same as its state before the first call,
+! including any unspecified use of those bits.
+!
+!
+!## Examples
+!
+!```fortran
+! program demo_system_umask
+! use M_system, only : system_getumask, system_setumask
+! implicit none
+! integer value
+! integer mask
+! mask=O'002'
+! value=system_setumask(mask)
+! write(*,'(a,"octal=",O4.4," decimal=",i0)')'OLD VALUE=',value,value
+! value=system_getumask()
+! write(*,'(a,"octal=",O4.4," decimal=",i0)')'MASK=',mask,mask
+! write(*,'(a,"octal=",O4.4," decimal=",i0)')'NEW VALUE=',value,value
+! end program demo_system_umask
+!```
+
+INTERFACE
+ INTEGER(kind=C_INT) FUNCTION System_Umask(umask_value) BIND(C, name="umask")
+ IMPORT C_INT
+ INTEGER(kind=C_INT), VALUE :: umask_value
+ END FUNCTION System_Umask
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Rand
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: Call pseudo-random number generator rand(3c)
+!
+!# System_Rand
+!
+! Use rand(3c) to generate pseudo-random numbers.
+!
+!## Examples
+!
+!## Usage
+!
+!```fortran
+! program demo_system_rand
+! use M_system, only : system_srand, system_rand
+! implicit none
+! integer :: i
+!
+! call system_srand(1001)
+! do i=1,10
+! write(*,*)system_rand()
+! enddo
+! write(*,*)
+! end program demo_system_rand
+!```
+
+INTERFACE
+ INTEGER(kind=C_INT) FUNCTION System_Rand() BIND(C, name="rand")
+ IMPORT C_INT
+ END FUNCTION System_Rand
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Initenv
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: Initialize environment table pointer and size
+! so table can be read by readenv(3f)
+!
+!# System_Initenv
+!
+! A simple interface allows reading the environment variable table
+! of the process. Call system_initenv(3f) to initialize reading the
+! environment table, then call system_readenv(3f) until a blank line
+! is returned. If more than one thread reads the environment or the
+! environment is changed while being read the results are undefined.
+!
+!
+!## Examples
+!
+!```fortran
+! program demo_system_initenv
+! use M_system, only : system_initenv, system_readenv
+! character(len=:),allocatable :: string
+! call system_initenv()
+! do
+! string=system_readenv()
+! if(string.eq.'')then
+! exit
+! else
+! write(*,'(a)')string
+! endif
+! enddo
+! end program demo_system_initenv
+!```
+
+INTERFACE
+ SUBROUTINE System_Initenv() BIND(C, NAME='my_initenv')
+ END SUBROUTINE System_Initenv
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Flush
+!----------------------------------------------------------------------------
+
+INTERFACE
+ SUBROUTINE C_Flush() BIND(C, name="my_flush")
+ END SUBROUTINE C_Flush
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Signal
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Signal(signal, sighandler) BIND(c, name='signal')
+ IMPORT :: C_INT, C_FUNPTR
+ INTEGER(C_INT), VALUE, INTENT(in) :: signal
+ TYPE(C_FUNPTR), VALUE, INTENT(in) :: sighandler
+ TYPE(C_FUNPTR) :: C_Signal
+ END FUNCTION C_Signal
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Access
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Access(c_pathname, c_amode) BIND(C, name="my_access") &
+ RESULT(c_ierr)
+ IMPORT :: C_CHAR, C_INT
+ CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: c_pathname(*)
+ INTEGER(kind=C_INT), VALUE :: c_amode
+ INTEGER(kind=C_INT) :: c_ierr
+ END FUNCTION C_Access
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Utime
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Utime(c_pathname, c_times) BIND(C, name="my_utime") RESULT(c_ierr)
+ IMPORT C_CHAR, C_INT
+ CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: c_pathname(*)
+ INTEGER(kind=C_INT), INTENT(in) :: c_times(2)
+ INTEGER(kind=C_INT) :: c_ierr
+ END FUNCTION C_Utime
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_RealPath
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_RealPath(c_input) BIND(c, name="my_realpath") RESULT(c_buffer)
+ IMPORT C_CHAR, C_SIZE_T, C_PTR, C_INT
+ CHARACTER(kind=C_CHAR), INTENT(in) :: c_input(*)
+ TYPE(C_PTR) :: c_buffer
+ END FUNCTION C_RealPath
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Issock
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Issock(pathname) BIND(C, name="my_issock") RESULT(c_ierr)
+ IMPORT :: C_CHAR, C_INT
+ CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: pathname(*)
+ INTEGER(kind=C_INT) :: c_ierr
+ END FUNCTION C_Issock
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Time
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Time(tloc) BIND(c, name='time')
+ IMPORT :: C_LONG
+ INTEGER(kind=C_LONG), INTENT(in), VALUE :: tloc
+ INTEGER(kind=C_LONG) :: C_Time
+ END FUNCTION C_Time
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Chown
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Chown(c_dirname, c_owner, c_group) &
+ BIND(C, name="my_chown") RESULT(c_ierr)
+ IMPORT :: C_CHAR, C_INT
+ CHARACTER(kind=C_CHAR, len=1), INTENT(IN) :: c_dirname(*)
+ INTEGER(kind=C_INT), INTENT(IN), VALUE :: c_owner
+ INTEGER(kind=C_INT), INTENT(IN), VALUE :: c_group
+ INTEGER(kind=C_INT) :: c_ierr
+ END FUNCTION C_Chown
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Link
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Link(C_Oldname, C_Newname) &
+ BIND(C, name="link") RESULT(c_ierr)
+ IMPORT C_CHAR, C_INT
+ CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: c_oldname(*)
+ CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: c_newname(*)
+ INTEGER(kind=C_INT) :: c_ierr
+ END FUNCTION C_Link
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Unlink
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Unlink(C_Fname) &
+ BIND(C, name="unlink") RESULT(c_ierr)
+ IMPORT C_CHAR, C_INT
+ CHARACTER(kind=C_CHAR, len=1) :: c_fname(*)
+ INTEGER(kind=C_INT) :: c_ierr
+ END FUNCTION C_Unlink
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Chdir
+!----------------------------------------------------------------------------
+
+INTERFACE
+ INTEGER(kind=C_INT) FUNCTION C_Chdir(C_Path) &
+ BIND(C, name="chdir")
+ IMPORT C_CHAR, C_INT
+ CHARACTER(kind=C_CHAR) :: c_path(*)
+ END FUNCTION C_Chdir
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Remove
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Remove(C_Path) BIND(c, name="remove") RESULT(c_err)
+ IMPORT C_CHAR, C_INT
+ CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: C_Path(*)
+ INTEGER(C_INT) :: c_err
+ END FUNCTION C_Remove
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Rename
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Rename(C_Input, C_Output) BIND(c, name="rename") RESULT(C_Err)
+ IMPORT C_CHAR, C_INT
+ CHARACTER(kind=C_CHAR), INTENT(in) :: C_Input(*)
+ CHARACTER(kind=C_CHAR), INTENT(in) :: C_Output(*)
+ INTEGER(C_INT) :: C_Err
+ END FUNCTION C_Rename
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Chmod
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Chmod(filename, mode) BIND(c, name="chmod") RESULT(ierr)
+ IMPORT C_CHAR, C_INT
+ CHARACTER(kind=C_CHAR), INTENT(IN) :: filename(*)
+ INTEGER(C_INT), VALUE, INTENT(IN) :: mode
+ INTEGER(C_INT) :: ierr
+ END FUNCTION C_Chmod
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Setenv
+!----------------------------------------------------------------------------
+
+INTERFACE
+ INTEGER(kind=C_INT) FUNCTION C_Setenv(C_Name, C_VALUE) &
+ BIND(C, NAME="setenv")
+ IMPORT C_INT, C_CHAR
+ CHARACTER(kind=C_CHAR) :: C_Name(*)
+ CHARACTER(kind=C_CHAR) :: C_VALUE(*)
+ END FUNCTION C_Setenv
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Unsetenv
+!----------------------------------------------------------------------------
+
+INTERFACE
+ INTEGER(kind=C_INT) FUNCTION C_Unsetenv(C_Name) &
+ BIND(C, NAME="unsetenv")
+ IMPORT C_INT, C_CHAR
+ CHARACTER(len=1, kind=C_CHAR) :: C_Name(*)
+ END FUNCTION C_Unsetenv
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Readenv
+!----------------------------------------------------------------------------
+
+INTERFACE
+ SUBROUTINE C_Readenv(C_String) &
+ BIND(C, NAME='my_readenv')
+ IMPORT C_CHAR, C_INT, C_PTR, C_SIZE_T
+ CHARACTER(kind=C_CHAR), INTENT(OUT) :: c_string(*)
+ END SUBROUTINE C_Readenv
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Putenv
+!----------------------------------------------------------------------------
+
+INTERFACE
+ INTEGER(kind=C_INT) FUNCTION C_Putenv(C_String) &
+ BIND(C, name="putenv")
+ IMPORT C_INT, C_CHAR
+ CHARACTER(kind=C_CHAR) :: C_String(*)
+ END FUNCTION C_Putenv
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Isfifo
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Isfifo(pathname) &
+ BIND(C, name="my_isfifo") RESULT(c_ierr)
+ IMPORT C_CHAR, C_INT
+ CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: pathname(*)
+ INTEGER(kind=C_INT) :: c_ierr
+ END FUNCTION C_Isfifo
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Ischr
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Ischr(pathname) &
+ BIND(C, name="my_ischr") RESULT(c_ierr)
+ IMPORT C_CHAR, C_INT
+ CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: pathname(*)
+ INTEGER(kind=C_INT) :: c_ierr
+ END FUNCTION C_Ischr
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Isreg
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Isreg(pathname) &
+ BIND(C, name="my_isreg") RESULT(c_ierr)
+ IMPORT :: C_CHAR, C_INT
+ CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: pathname(*)
+ INTEGER(kind=C_INT) :: c_ierr
+ END FUNCTION C_Isreg
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Islnk
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Islnk(pathname) &
+ BIND(C, name="my_islnk") RESULT(c_ierr)
+ IMPORT C_CHAR, C_INT
+ CHARACTER(kind=C_CHAR, len=1), INTENT(IN) :: pathname(*)
+ INTEGER(kind=C_INT) :: c_ierr
+ END FUNCTION C_Islnk
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Isblk
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Isblk(pathname) &
+ BIND(C, name="my_isblk") RESULT(c_ierr)
+ IMPORT :: C_CHAR, C_INT
+ CHARACTER(kind=C_CHAR, len=1), INTENT(IN) :: pathname(*)
+ INTEGER(kind=C_INT) :: c_ierr
+ END FUNCTION C_Isblk
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Isdir
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Isdir(dirname) &
+ BIND(C, name="my_isdir") RESULT(c_ierr)
+ IMPORT :: C_CHAR, C_INT
+ CHARACTER(kind=C_CHAR, len=1), INTENT(IN) :: dirname(*)
+ INTEGER(kind=C_INT) :: c_ierr
+ END FUNCTION C_Isdir
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_CPU_Time
+!----------------------------------------------------------------------------
+
+INTERFACE
+ SUBROUTINE C_CPU_Time(total, user, system) &
+ BIND(C, NAME='my_cpu_time')
+ IMPORT :: C_FLOAT
+ REAL(C_FLOAT) :: total, user, system
+ END SUBROUTINE C_CPU_Time
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Perror
+!----------------------------------------------------------------------------
+
+INTERFACE
+ SUBROUTINE C_Perror(prefix) BIND(C, name="perror")
+ IMPORT C_CHAR
+ CHARACTER(kind=C_CHAR) :: prefix(*)
+ END SUBROUTINE C_Perror
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Uname
+!----------------------------------------------------------------------------
+
+INTERFACE
+ SUBROUTINE C_Uname(WHICH, BUF, BUFLEN) BIND(C, NAME='my_uname')
+ IMPORT :: C_CHAR, C_INT
+ IMPLICIT NONE
+ CHARACTER(KIND=C_CHAR), INTENT(in) :: WHICH
+ CHARACTER(KIND=C_CHAR), INTENT(out) :: BUF(*)
+ INTEGER(C_INT), INTENT(in) :: BUFLEN
+ END SUBROUTINE C_Uname
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Gethostname
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Gethostname(c_buf, c_buflen) BIND(C, NAME='gethostname')
+ IMPORT :: C_CHAR, C_INT
+ INTEGER(kind=C_INT) :: C_Gethostname
+ CHARACTER(KIND=C_CHAR), INTENT(out) :: c_buf(*)
+ INTEGER(C_INT), INTENT(in), VALUE :: c_buflen
+ END FUNCTION C_Gethostname
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Getlogin
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Getlogin() &
+ BIND(c, name="getlogin") RESULT(c_username)
+ IMPORT C_INT, C_PTR
+ TYPE(C_PTR) :: c_username
+ END FUNCTION C_Getlogin
+END INTERFACE
+
+INTERFACE
+ FUNCTION C_Perm(c_mode) &
+ BIND(c, name="my_get_perm") RESULT(c_permissions)
+ IMPORT C_INT, C_PTR, C_LONG
+ INTEGER(kind=C_LONG), VALUE :: c_mode
+ TYPE(C_PTR) :: c_permissions
+ END FUNCTION C_Perm
+END INTERFACE
+
+INTERFACE
+ FUNCTION C_Getgrgid(C_Gid, C_Groupname) &
+ BIND(c, name="my_getgrgid") RESULT(c_ierr)
+ IMPORT C_INT, C_PTR, C_CHAR, C_LONG_LONG
+ INTEGER(kind=C_LONG_LONG), VALUE, INTENT(in) :: c_gid
+ CHARACTER(kind=C_CHAR), INTENT(out) :: c_groupname(*)
+ INTEGER(kind=C_INT) :: c_ierr
+ END FUNCTION C_Getgrgid
+END INTERFACE
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+INTERFACE
+ FUNCTION C_Getpwuid(C_Uid, C_Username) &
+ BIND(c, name="my_getpwuid") RESULT(c_ierr)
+ IMPORT C_INT, C_PTR, C_CHAR, C_LONG_LONG
+ INTEGER(kind=C_LONG_LONG), VALUE, INTENT(in) :: c_uid
+ CHARACTER(kind=C_CHAR), INTENT(out) :: c_username(*)
+ INTEGER(kind=C_INT) :: c_ierr
+ END FUNCTION C_Getpwuid
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C_Stat
+!----------------------------------------------------------------------------
+
+INTERFACE
+ SUBROUTINE C_Stat(buffer, cvalues, cierr, cdebug) &
+ BIND(c, name="my_stat")
+ IMPORT :: C_CHAR, C_SIZE_T, C_PTR, C_INT, C_LONG
+ CHARACTER(kind=C_CHAR), INTENT(IN) :: buffer(*)
+ INTEGER(C_LONG), INTENT(OUT) :: cvalues(*)
+ INTEGER(C_INT) :: cierr
+ INTEGER(C_INT), INTENT(in) :: cdebug
+ END SUBROUTINE C_Stat
+END INTERFACE
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+END MODULE SystemInterface
diff --git a/src/modules/System/src/SystemOptions.F90 b/src/modules/System/src/SystemOptions.F90
new file mode 100755
index 000000000..13bc1c67e
--- /dev/null
+++ b/src/modules/System/src/SystemOptions.F90
@@ -0,0 +1,105 @@
+! This module is mainly taken from the source:
+! https://github.com/urbanjost/M_system.
+! The original name of the program has been changed
+! from M_SYSTEM to System_Method.
+! This is to confirm to the coding sytles of easifem.
+! Original program has been re-organized into module and submodule.
+! If you are using easifem for getting methods defined in this
+! module, then please use M_System module by using the above link.
+! We would like to thank the original author Urban Jost for creating
+! This useful module.
+
+!> author: John S. Urban
+! date: 2026-02-04
+! summary: Fortran interface to C system interface
+!
+!# SystemOptions
+!
+! System_Method is a collection of Fortran procedures that call C
+! or a C wrapper using the ISO_C_BINDING interface to access system calls.
+! System calls are a special set of functions used by programs to communicate
+! directly with an operating system.
+!
+! Generally, system calls are slower than normal function calls because
+! when you make a call control is relinquished to the operating system
+! to perform the system call. In addition, depending on the nature of the
+! system call, your program may be blocked by the OS until the system call
+! has finished, thus making the execution time of your program even longer.
+!
+! One rule-of-thumb that should always be followed when calling a system
+! call -- Always check the return value.
+
+MODULE SystemOptions
+USE ISO_C_BINDING, ONLY: C_INT
+USE ISO_C_BINDING, ONLY: C_CHAR
+USE ISO_C_BINDING, ONLY: C_LONG
+USE ISO_C_BINDING, ONLY: C_SHORT
+USE GlobalData, ONLY: I4B
+USE GlobalData, ONLY: INT32
+IMPLICIT NONE
+
+PRIVATE
+
+INTEGER(I4B), PARAMETER, PUBLIC :: System_mode_t = INT32
+!! mode_t: This is a specific data type (usually an unsigned integer) used in
+!! POSIX systems to store file mode information, such as permissions.
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+INTEGER(System_mode_t), PUBLIC, BIND(c, name="FS_IRGRP") :: R_GRP
+INTEGER(System_mode_t), PUBLIC, BIND(c, name="FS_IROTH") :: R_OTH
+INTEGER(System_mode_t), PUBLIC, BIND(c, name="FS_IRUSR") :: R_USR
+INTEGER(System_mode_t), PUBLIC, BIND(c, name="FS_IRWXG") :: RWX_G
+INTEGER(System_mode_t), PUBLIC, BIND(c, name="FS_IRWXO") :: RWX_O
+INTEGER(System_mode_t), PUBLIC, BIND(c, name="FS_IRWXU") :: RWX_U
+INTEGER(System_mode_t), PUBLIC, BIND(c, name="FS_IWGRP") :: W_GRP
+INTEGER(System_mode_t), PUBLIC, BIND(c, name="FS_IWOTH") :: W_OTH
+INTEGER(System_mode_t), PUBLIC, BIND(c, name="FS_IWUSR") :: W_USR
+INTEGER(System_mode_t), PUBLIC, BIND(c, name="FS_IXGRP") :: X_GRP
+INTEGER(System_mode_t), PUBLIC, BIND(c, name="FS_IXOTH") :: X_OTH
+INTEGER(System_mode_t), PUBLIC, BIND(c, name="FS_IXUSR") :: X_USR
+INTEGER(System_mode_t), PUBLIC, BIND(c, name="FDEFFILEMODE") :: DEFFILEMODE
+INTEGER(System_mode_t), PUBLIC, BIND(c, name="FACCESSPERMS") :: ACCESSPERMS
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+INTEGER(C_INT), PUBLIC, PARAMETER :: F_OK = 0
+INTEGER(C_INT), PUBLIC, PARAMETER :: R_OK = 4
+INTEGER(C_INT), PUBLIC, PARAMETER :: W_OK = 2
+INTEGER(C_INT), PUBLIC, PARAMETER :: X_OK = 1
+
+INTEGER(I4B), PARAMETER :: MAX_STR_LEN = 256
+
+!----------------------------------------------------------------------------
+! dirent_SYSTEMA
+!----------------------------------------------------------------------------
+
+TYPE, BIND(C) :: dirent_SYSTEMA
+ INTEGER(C_LONG) :: d_ino
+ INTEGER(C_LONG) :: d_off
+ INTEGER(C_SHORT) :: d_reclen
+ CHARACTER(len=1, kind=C_CHAR) :: d_name(MAX_STR_LEN)
+END TYPE dirent_SYSTEMA
+
+!----------------------------------------------------------------------------
+! dirent_CYGWIN
+!----------------------------------------------------------------------------
+
+TYPE, BIND(C) :: dirent_CYGWIN
+ INTEGER(C_INT) :: d_version
+ INTEGER(C_LONG) :: d_ino
+ CHARACTER(kind=C_CHAR) :: d_type
+ CHARACTER(kind=C_CHAR) :: d_unused1(3)
+ INTEGER(C_INT) :: d_internal1
+ CHARACTER(len=1, kind=C_CHAR) :: d_name(MAX_STR_LEN)
+END TYPE dirent_CYGWIN
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+END MODULE SystemOptions
diff --git a/src/modules/System/src/SystemProcess_Method.F90 b/src/modules/System/src/SystemProcess_Method.F90
new file mode 100755
index 000000000..936b435f6
--- /dev/null
+++ b/src/modules/System/src/SystemProcess_Method.F90
@@ -0,0 +1,399 @@
+! This module is mainly taken from the source:
+! https://github.com/urbanjost/M_system.
+! The original name of the program has been changed
+! from M_SYSTEM to System_Method.
+! This is to confirm to the coding sytles of easifem.
+! Original program has been re-organized into module and submodule.
+! If you are using easifem for getting methods defined in this
+! module, then please use M_System module by using the above link.
+! We would like to thank the original author Urban Jost for creating
+! This useful module.
+
+!> author: John S. Urban
+! date: 2026-02-04
+! summary: Fortran interface to C system interface
+!
+!# SystemProcess_Method
+!
+! M_system(3fm) is a collection of Fortran procedures that call C
+! or a C wrapper using the ISO_C_BINDING interface to access system calls.
+! System calls are a special set of functions used by programs to communicate
+! directly with an operating system.
+!
+! Generally, system calls are slower than normal function calls because
+! when you make a call control is relinquished to the operating system
+! to perform the system call. In addition, depending on the nature of the
+! system call, your program may be blocked by the OS until the system call
+! has finished, thus making the execution time of your program even longer.
+!
+! One rule-of-thumb that should always be followed when calling a system
+! call -- Always check the return value.
+
+MODULE SystemProcess_Method
+USE ISO_C_BINDING, ONLY: C_FLOAT, C_INT, C_CHAR
+USE ISO_C_BINDING, ONLY: C_PTR, C_F_POINTER, C_NULL_CHAR, C_NULL_PTR
+USE ISO_C_BINDING, ONLY: C_LONG, C_SHORT, C_FUNPTR
+USE GlobalData, ONLY: INT32, INT64
+IMPLICIT NONE
+
+PRIVATE
+
+PUBLIC :: System_Perror
+PUBLIC :: System_Stat
+!! call stat(3c) to determine system information of file by name
+PUBLIC :: System_Perm
+!! create string representing file permission and type
+PUBLIC :: System_Getumask
+PUBLIC :: System_cpu_Time
+PUBLIC :: System_Uname
+PUBLIC :: System_Gethostname
+PUBLIC :: System_Getlogin
+PUBLIC :: System_Getpwuid
+PUBLIC :: System_Getgrgid
+
+! C types. Might be platform dependent
+INTEGER, PARAMETER, PUBLIC :: mode_t = INT32
+! Host names are limited to {HOST_NAME_MAX} bytes.
+INTEGER(kind=mode_t), BIND(c, name="FHOST_NAME_MAX") :: HOST_NAME_MAX
+
+!----------------------------------------------------------------------------
+! System_Cpu_Time@GetMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: Get processor time by calling times
+!
+!# System_Cpu_Time
+!
+! Get processor time by calling times
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Cpu_Time" %}}
+!```
+
+INTERFACE
+ MODULE SUBROUTINE System_Cpu_Time(total, user, system)
+ REAL, INTENT(OUT) :: user, system, total
+ !! C_Total total processor time ( C_User + C_System )
+ !! C_User processor user time
+ !! C_System processor system time
+ END SUBROUTINE System_Cpu_Time
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Getumask@GetMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: Get current umask
+!
+!# System_Getumask
+!
+! The return value from getumask(3f) is the value of the file
+! creation mask, obtained by using umask(3c).
+!
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Getumask_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE FUNCTION System_Getumask() RESULT(Umask_Value)
+ INTEGER :: Umask_Value
+ !! The return value from umask() is just the previous value of the file
+ !! creation mask, so that this system call can be used both to get and
+ !! set the required values. Sadly, however,
+ !! there is no way to get the old
+ !! umask value without setting a new value at the same time.
+ !! This means that in order just to see the current value,
+ !! it is necessary
+ !! to execute a piece of code like the following function:
+ END FUNCTION System_Getumask
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Perror@GetMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: print error message for last C error on stderr
+!
+!# System_Perror
+!
+! Use system_perror(3f) to print an error message on stderr
+! corresponding to the current value of the C global variable errno.
+! Unless you use NULL as the argument prefix, the error message will
+! begin with the prefix string, followed by a colon and a space
+! (:). The remainder of the error message produced is one of the
+! strings described for strerror(3c).
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Perror_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE SUBROUTINE System_Perror(prefix)
+ CHARACTER(len=*), INTENT(IN) :: prefix
+ END SUBROUTINE System_Perror
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Getuname@GetMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: Get current system information
+!
+! ## System_Getuname
+!
+! Given a single-character selector, this routine returns the corresponding
+! description of the current operating system.
+!
+! The `NAMEOUT` variable is assumed to be sufficiently large to hold the
+! returned value.
+!
+! The following selector values are supported:
+!
+! - `s` Returns the kernel name.
+! - `r` Returns the kernel release.
+! - `v` Returns the kernel version.
+! - `n` Returns the network node hostname.
+! - `m` Returns the machine hardware name.
+! - `T` Test mode: prints all information in the following order:
+! `s r v n m`.
+
+INTERFACE
+ MODULE SUBROUTINE System_Uname(WHICH, NAMEOUT)
+ CHARACTER(KIND=C_CHAR), INTENT(IN) :: WHICH
+ CHARACTER(*), INTENT(OUT) :: NAMEOUT
+ END SUBROUTINE System_Uname
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Gethostname@Getmethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: Get name of current host
+!
+!# System_Gethostname
+!
+! The system_gethostname(3f) procedure returns the standard host
+! name for the current machine.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Gethostname_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE SUBROUTINE System_Gethostname(NAME, IERR)
+ CHARACTER(:), ALLOCATABLE, INTENT(OUT) :: NAME
+ !! string returns the hostname.
+ INTEGER, INTENT(OUT) :: IERR
+ !! Upon successful completion, 0 shall be returned; otherwise, -1
+ !! shall be returned.
+ END SUBROUTINE System_Gethostname
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Getlogin@GetMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: Get login name
+!
+!## System_Getlogin
+!
+! The `system_getlogin(3f)` function returns a string containing the user
+! name associated with the login activity of the controlling terminal of the
+! current process.
+!
+! If the user name cannot be determined, the function returns a null string
+! and sets `errno` to indicate the error.
+!
+! The following three user names associated with the current process can be
+! determined:
+!
+! - `system_getpwuid(system_getuid())`
+! Returns the name associated with the real user ID of the process.
+!
+! - `system_getpwuid(system_geteuid())`
+! Returns the name associated with the effective user ID of the process.
+!
+! - `system_getlogin()`
+! Returns the name associated with the current login activity.!!
+!!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Getlogin_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE FUNCTION System_Getlogin() RESULT(fname)
+ CHARACTER(:), ALLOCATABLE :: fname
+ END FUNCTION System_Getlogin
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Perm@GetMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: Get file type and permission as a string
+!
+!# System_Perm
+!
+! The system_perm(3f) function returns a string containing the type
+! and permission of a file implied by the value of the mode value.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Perm_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE FUNCTION System_Perm(mode) RESULT(perms)
+ CLASS(*), INTENT(IN) :: mode
+ CHARACTER(len=:), ALLOCATABLE :: perms
+ !! returns the permission string in a format similar to that
+ !! used by Unix commands such as ls(1).
+ END FUNCTION System_Perm
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Getgrgid@GetMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-06
+! summary: Get groupd name associated with a GID
+!
+!# System_Getgrgid
+!
+! The System_Getgrgid() function returns a string containing the group
+! name associated with the given GID. If no match is found
+! it returns a null string and sets errno to indicate the error.
+!
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Getgrgid_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE FUNCTION System_Getgrgid(gid) RESULT(gname)
+ CLASS(*), INTENT(IN) :: gid
+ !! GID to try to look up associated group for. Can be of any
+ !! INTEGER type.
+ CHARACTER(len=:), ALLOCATABLE :: gname
+ !! returns the group name. Blank if an error occurs
+ END FUNCTION System_Getgrgid
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Getpwuid@GetMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: Get login name associated with a UID
+!
+!# System_Getpwuid
+!
+! The system_getpwuid() function returns a string containing the user
+! name associated with the given UID. If no match is found it returns
+! a null string and sets errno to indicate the error.
+!
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Getpwuid_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE FUNCTION System_Getpwuid(uid) RESULT(uname)
+ CLASS(*), INTENT(IN) :: uid
+ !! UID to try to look up associated username for. Can be of any
+ !! INTEGER type.
+ CHARACTER(:), ALLOCATABLE :: uname
+ !! returns the login name.
+ END FUNCTION System_Getpwuid
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Stat@GetMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: Get file status information
+!
+!# System_Stat
+!
+! This function returns information about a file. No permissions are
+! required on the file itself, but execute (search) permission is required
+! on all of the directories in path that lead to the file. The elements
+! that are obtained and stored in the array VALUES:
+!
+! | Index | VALUES(n) | Description |
+! |-------|-----------|-------------|
+! | 1 | VALUES(1) | Device ID |
+! | 2 | VALUES(2) | Inode number |
+! | 3 | VALUES(3) | File mode |
+! | 4 | VALUES(4) | Number of links |
+! | 5 | VALUES(5) | Owner UID |
+! | 6 | VALUES(6) | Owner GID |
+! | 7 | VALUES(7) | ID of device containing dir entry for file |
+! | 8 | VALUES(8) | File size (bytes) |
+! | 9 | VALUES(9) | Last access time as a Unix Epoch time (seconds) |
+! | 10 | VALUES(10) | Last modification time as a Unix Epoch time (seconds) |
+! | 11 | VALUES(11) | Last file status change time as a Unix Epoch time |
+! | 12 | VALUES(12) | Preferred I/O block size (-1 if not available) |
+! | 13 | VALUES(13) | Number of blocks allocated (-1 if not available) |
+!
+! > [!NOTE]
+! > Not all these elements are relevant on all systems.
+! > If an element is not relevant, it is returned as `0`.!!
+!
+!
+!## Examples
+!
+! ```fortran
+! {{% fortran-code file="examples/System_Stat_test_1.F90" %}}
+! ```
+
+INTERFACE
+ MODULE SUBROUTINE System_Stat(pathname, values, ierr)
+ CHARACTER(*), INTENT(IN) :: pathname
+ !! The type shall be CHARACTER, of the default kind and a valid
+ !! path within the file system.
+ INTEGER(INT64), INTENT(OUT) :: values(13)
+ !! VALUES The type shall be INTEGER(8), DIMENSION(13).
+ INTEGER, OPTIONAL, INTENT(OUT) :: ierr
+ END SUBROUTINE System_Stat
+END INTERFACE
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+END MODULE SystemProcess_Method
diff --git a/src/modules/System/src/SystemSignal_Method.F90 b/src/modules/System/src/SystemSignal_Method.F90
new file mode 100755
index 000000000..013533c39
--- /dev/null
+++ b/src/modules/System/src/SystemSignal_Method.F90
@@ -0,0 +1,127 @@
+! This module is mainly taken from the source:
+! https://github.com/urbanjost/M_system.
+! The original name of the program has been changed
+! from M_SYSTEM to System_Method.
+! This is to confirm to the coding sytles of easifem.
+! Original program has been re-organized into module and submodule.
+! If you are using easifem for getting methods defined in this
+! module, then please use M_System module by using the above link.
+! We would like to thank the original author Urban Jost for creating
+! This useful module.
+
+!> author: John S. Urban
+! date: 2026-02-04
+! summary: Fortran interface to C system interface
+!
+!# System_Signal
+!
+! M_system(3fm) is a collection of Fortran procedures that call C
+! or a C wrapper using the ISO_C_BINDING interface to access system calls.
+! System calls are a special set of functions used by programs to communicate
+! directly with an operating system.
+!
+! Generally, system calls are slower than normal function calls because
+! when you make a call control is relinquished to the operating system
+! to perform the system call. In addition, depending on the nature of the
+! system call, your program may be blocked by the OS until the system call
+! has finished, thus making the execution time of your program even longer.
+!
+! One rule-of-thumb that should always be followed when calling a system
+! call -- Always check the return value.
+
+MODULE SystemSignal_Method
+USE ISO_C_BINDING, ONLY: C_FUNPTR
+USE ISO_C_BINDING, ONLY: C_INT
+IMPLICIT NONE
+
+PRIVATE
+PUBLIC :: System_Signal
+PUBLIC :: handler
+PUBLIC :: handler_ptr_array
+PUBLIC :: f_handler
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+ABSTRACT INTERFACE
+ ! mold for signal handler to be installed by system_signal
+ SUBROUTINE handler(signum)
+ IMPORT :: C_INT
+ INTEGER(C_INT), INTENT(IN) :: signum
+ END SUBROUTINE handler
+END INTERFACE
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+TYPE handler_pointer
+ PROCEDURE(handler), POINTER, NOPASS :: sub
+END TYPE handler_pointer
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+INTEGER, PARAMETER :: NO_OF_SIGNALS = 64
+!! obtained with command: kill -l
+TYPE(handler_pointer) :: handler_ptr_array(NO_OF_SIGNALS)
+
+!----------------------------------------------------------------------------
+! f_handler@Methods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: handler
+
+INTERFACE
+ MODULE SUBROUTINE f_handler(signum) BIND(c)
+ INTEGER(C_INT), INTENT(IN), VALUE :: signum
+ END SUBROUTINE f_handler
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! System_Signal@Methods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: Install a signal handler
+!
+!# System_Signal
+!
+! Calling system_signal(NUMBER, HANDLER) causes user-defined
+! subroutine HANDLER to be executed when the signal NUMBER is
+! caught. The same subroutine HANDLER maybe installed to handle
+! different signals. HANDLER takes only one integer argument which
+! is assigned the signal number that is caught. See sample program
+! below for illustration.
+!
+! Calling system_signal(NUMBER) installs a do-nothing handler. This
+! is not equivalent to ignoring the signal NUMBER though, because
+! the signal can still interrupt any sleep or idle-wait.
+!
+! Note that the signals SIGKILL and SIGSTOP cannot be handled
+! this way.
+!
+!## Examples
+!
+!```fortran
+! {{% fortran-code file="examples/System_Signal_test_1.F90" %}}
+!```
+
+INTERFACE
+ MODULE SUBROUTINE System_Signal(signum, handler_routine)
+ INTEGER, INTENT(IN) :: signum
+ PROCEDURE(handler), OPTIONAL :: handler_routine
+ TYPE(C_FUNPTR) :: ret, c_handler
+ END SUBROUTINE System_Signal
+END INTERFACE
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+END MODULE SystemSignal_Method
diff --git a/src/modules/System/src/System_Method.F90 b/src/modules/System/src/System_Method.F90
index a39ca633f..7b7d7ab43 100755
--- a/src/modules/System/src/System_Method.F90
+++ b/src/modules/System/src/System_Method.F90
@@ -1,5427 +1,45 @@
-! This program is a part of EASIFEM library.
-! This program is directly taken from the
-! source: https://github.com/urbanjost/M_system.
+! This module is mainly taken from the source:
+! https://github.com/urbanjost/M_system.
+! The Author's name is John S. Urban
+!
! The original name of the program has been changed
! from M_SYSTEM to System_Method.
-! This is to confirm to the coding sytles of easifem.
-!
-! Copyright (C) 2020-2021 Vikas Sharma, Ph.D
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see
+! The routine is divided into Modules and Submodules.
!
+! This is to confirm to the coding sytles of easifem.
+! Original program has been re-organized into module and submodule.
+! If you are using easifem for getting methods defined in this
+! module, then please use M_System module by using the above link.
+! We would like to thank the original author Urban Jost for creating
+! This useful module.
-!>
-!##NAME
-! M_system(3fm) - [M_system::INTRO] Fortran interface to C system interface
-! (LICENSE:PD)
-!##SYNOPSIS
-!
-! Public objects:
-!
-! ! ENVIRONMENT
-! use M_system, only : set_environment_variable, system_unsetenv, &
-! system_putenv, system_getenv
-!
-! use M_system, only : system_intenv, system_readenv, system_clearenv
-! ! FILE SYSTEM
-! use M_system, only : system_getcwd, system_link, &
-! system_mkfifo, system_remove, system_rename, &
-! system_umask, system_unlink, fileglob, &
-! system_rmdir, system_chdir, system_mkdir, &
-! system_stat, system_isdir, system_islnk, system_isreg, &
-! system_isblk, system_ischr, system_isfifo, &
-! system_realpath, &
-! system_access, &
-! system_utime, &
-! system_issock, system_perm, &
-! system_dir, &
-! system_memcpy
-!
-! !!use M_system, only : system_getc, system_putc
-! ! ERROR PROCESSING
-! use M_system, only : system_errno, system_perror
-! ! INFO
-! use M_system, only : system_getegid, system_geteuid, system_getgid, &
-! system_gethostname, system_getpid, system_getppid, system_setsid, &
-! system_getsid, system_getuid, system_uname
-! ! SIGNALS
-! use M_system, only : system_kill,system_signal
-! ! RANDOM NUMBERS
-! use M_system, only : system_rand, system_srand
-! ! PROCESS INFORMATION
-! use M_system, only : system_cpu_time
-!
-!##DESCRIPTION
-! M_system(3fm) is a collection of Fortran procedures that call C
-! or a C wrapper using the ISO_C_BINDING interface to access system calls.
-! System calls are a special set of functions used by programs to communicate
-! directly with an operating system.
-!
-! Generally, system calls are slower than normal function calls because
-! when you make a call control is relinquished to the operating system
-! to perform the system call. In addition, depending on the nature of the
-! system call, your program may be blocked by the OS until the system call
-! has finished, thus making the execution time of your program even longer.
-!
-! One rule-of-thumb that should always be followed when calling a system
-! call -- Always check the return value.
-!##ENVIRONMENT ACCESS
-! o system_putenv(3f): call putenv(3c)
-! o system_getenv(3f): function call to get_environment_variable(3f)
-! o system_unsetenv(3f): call unsetenv(3c) to remove variable from environment
-! o set_environment_variable(3f): set environment variable by calling setenv(3c)
-!
-! o system_initenv(3f): initialize environment table for reading
-! o system_readenv(3f): read next entry from environment table
-! o system_clearenv(3f): emulate clearenv(3c) to clear environment
-!##FILE SYSTEM
-! o system_chdir(3f): call chdir(3c) to change current directory of a process
-! o system_getcwd(3f): call getcwd(3c) to get pathname of current working directory
-!
-! o system_stat(3f): determine system information of file by name
-! o system_perm(3f): create string representing file permission and type
-! o system_access(3f): determine filename access or existence
-! o system_isdir(3f): determine if filename is a directory
-! o system_islnk(3f): determine if filename is a link
-! o system_isreg(3f): determine if filename is a regular file
-! o system_isblk(3f): determine if filename is a block device
-! o system_ischr(3f): determine if filename is a character device
-! o system_isfifo(3f): determine if filename is a fifo - named pipe
-! o system_issock(3f): determine if filename is a socket
-! o system_realpath(3f): resolve a pathname
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-07
+! summary: Fortran interface to C system interface
!
-! o system_chmod(3f): call chmod(3c) to set file permission mode
-! o system_chown(3f): call chown(3c) to set file owner
-! o system_getumask(3f): call umask(3c) to get process permission mask
-! o system_setumask(3f): call umask(3c) to set process permission mask
+!# System_Method
!
-! o system_mkdir(3f): call mkdir(3c) to create empty directory
-! o system_mkfifo(3f): call mkfifo(3c) to create a special FIFO file
-! o system_link(3f): call link(3c) to create a filename link
+! M_system(3fm) is a collection of Fortran procedures that call C
+! or a C wrapper using the ISO_C_BINDING interface to access system calls.
+! System calls are a special set of functions used by programs to communicate
+! directly with an operating system.
!
-! o system_rename(3f): call rename(3c) to change filename
+! Generally, system calls are slower than normal function calls because
+! when you make a call control is relinquished to the operating system
+! to perform the system call. In addition, depending on the nature of the
+! system call, your program may be blocked by the OS until the system call
+! has finished, thus making the execution time of your program even longer.
!
-! o system_remove(3f): call remove(3c) to remove file
-! o system_rmdir(3f): call rmdir(3c) to remove empty directory
-! o system_unlink(3f): call unlink(3c) to remove a link to a file
-! o system_utime(3f): call utime(3c) to set file access and modification times
-! o system_dir(3f): read name of files in specified directory matching a wildcard string
-!
-! o fileglob(3f): Returns list of files using a file globbing pattern
-!
-!##STREAM IO
-! o system_getc(3f): get a character from stdin
-! o system_putc(3f): put a character on stdout
-!##RANDOM NUMBERS
-! o system_srand(3f): call srand(3c)
-! o system_rand(3f): call rand(3c)
-!##C ERROR INFORMATION
-! o system_errno(3f): return errno(3c)
-! o system_perror(3f): call perror(3c) to display last C error message
-!##QUERIES
-! o system_geteuid(3f): call geteuid(3c)
-! o system_getuid(3f): call getuid(3c)
-! o system_getegid(3f): call getegid(3c)
-! o system_getgid(3f): call getgid(3c)
-! o system_getpid(3f): call getpid(3c)
-! o system_getppid(3f): call getppid(3c)
-! o system_gethostname(3f): get name of current host
-! o system_uname(3f): call my_uname(3c) which calls uname(3c)
-! o system_getlogin(3f): get login name
-! o system_getpwuid(3f): get login name associated with given UID
-! o system_getgrgid(3f): get group name associated with given GID
-! o system_cpu_time(3f) : get processor time in seconds using times(3c)
-!
-!##FUTURE DIRECTIONS
-! A good idea of what system routines are commonly required is to refer
-! to the POSIX binding standards. (Note: IEEE 1003.9-1992 was withdrawn 6
-! February 2003.) The IEEE standard covering Fortran 77 POSIX bindings
-! is available online, though currently (unfortunately) only from
-! locations with appropriate subscriptions to the IEEE server (e.g.,
-! many university networks). For those who do have such access, the link
-! is: POSIX Fortran 77 Language Interfaces (IEEE Std 1003.9-1992) (pdf)
-!
-!##SEE ALSO
-! Some vendors provide their own way to access POSIX functions and make
-! those available as modules; for instance ...
-!
-! o the IFPORT module of Intel
-! o or the f90_* modules of NAG.
-! o There are also other compiler-independent efforts to make the
-! POSIX procedures accessible from Fortran...
-!
-! o Posix90 (doc),
-! o flib.a platform/files and directories,
-! o fortranposix.
+! One rule-of-thumb that should always be followed when calling a system
+! call -- Always check the return value.
MODULE System_Method
-USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_FLOAT, C_INT, C_CHAR
-use,intrinsic :: iso_c_binding, only : c_ptr, c_f_pointer, c_null_char, c_null_ptr
-USE, INTRINSIC :: ISO_C_BINDING
-USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: INT8, INT16, INT32, INT64
-!!, real32, real64, real128, dp=>real128
-
-IMPLICIT NONE
-PRIVATE
-! C types. Might be platform dependent
-INTEGER, PARAMETER, PUBLIC :: mode_t = INT32
-
-PUBLIC :: system_rand
-PUBLIC :: system_srand
-
-!-!public :: system_getc
-!-!public :: system_putc
-
-PUBLIC :: system_getpid ! return process ID
-PUBLIC :: system_getppid ! return parent process ID
-PUBLIC :: system_getuid, system_geteuid ! return user ID
-PUBLIC :: system_getgid, system_getegid ! return group ID
-PUBLIC :: system_setsid
-PUBLIC :: system_getsid
-PUBLIC :: system_kill ! (pid, signal) kill process (defaults: pid=0, signal=SIGTERM)
-PUBLIC :: system_signal ! (signal,[handler]) install signal handler subroutine
-
-PUBLIC :: system_errno
-PUBLIC :: system_perror
-
-PUBLIC :: system_putenv
-PUBLIC :: system_getenv
-PUBLIC :: set_environment_variable
-PUBLIC :: system_unsetenv
-
-PUBLIC :: system_initenv
-PUBLIC :: system_readenv
-PUBLIC :: system_clearenv
-
-PUBLIC :: system_stat ! call stat(3c) to determine system information of file by name
-PUBLIC :: system_perm ! create string representing file permission and type
-PUBLIC :: system_access ! determine filename access or existence
-PUBLIC :: system_isdir ! determine if filename is a directory
-PUBLIC :: system_islnk ! determine if filename is a link
-PUBLIC :: system_isreg ! determine if filename is a regular file
-PUBLIC :: system_isblk ! determine if filename is a block device
-PUBLIC :: system_ischr ! determine if filename is a character device
-PUBLIC :: system_isfifo ! determine if filename is a fifo - named pipe
-PUBLIC :: system_issock ! determine if filename is a socket
-PUBLIC :: system_realpath ! resolve pathname
-
-PUBLIC :: system_chdir
-PUBLIC :: system_rmdir
-PUBLIC :: system_remove
-PUBLIC :: system_rename
-
-PUBLIC :: system_mkdir
-PUBLIC :: system_mkfifo
-PUBLIC :: system_chmod
-PUBLIC :: system_chown
-PUBLIC :: system_link
-PUBLIC :: system_unlink
-PUBLIC :: system_utime
-
-PUBLIC :: system_setumask
-PUBLIC :: system_getumask
-PUBLIC :: system_umask
-
-PUBLIC :: system_getcwd
-
-PUBLIC :: system_opendir
-PUBLIC :: system_readdir
-PUBLIC :: system_rewinddir
-PUBLIC :: system_closedir
-
-PUBLIC :: system_cpu_time
-
-PUBLIC :: system_uname
-PUBLIC :: system_gethostname
-PUBLIC :: system_getlogin
-PUBLIC :: system_getpwuid
-PUBLIC :: system_getgrgid
-PUBLIC :: fileglob
-
-PUBLIC :: system_alarm
-PUBLIC :: system_calloc
-PUBLIC :: system_clock
-PUBLIC :: system_time
-!public :: system_time
-!public :: system_qsort
-
-PUBLIC :: system_realloc
-PUBLIC :: system_malloc
-PUBLIC :: system_free
-PUBLIC :: system_memcpy
-
-PUBLIC :: system_dir
-
-public :: R_GRP,R_OTH,R_USR,RWX_G,RWX_O,RWX_U,W_GRP,W_OTH,W_USR,X_GRP,X_OTH,X_USR,DEFFILEMODE,ACCESSPERMS
-PUBLIC :: R_OK, W_OK, X_OK, F_OK ! for system_access
-
-!----------------------------------------------------------------------------
-!
-!----------------------------------------------------------------------------
-
-TYPE, BIND(C) :: dirent_SYSTEMA
- INTEGER(C_LONG) :: d_ino
- INTEGER(C_LONG) :: d_off; ! __off_t, check size
- INTEGER(C_SHORT) :: d_reclen
- CHARACTER(len=1, kind=C_CHAR) :: d_name(256)
-END TYPE
-
-TYPE, BIND(C) :: dirent_CYGWIN
- INTEGER(C_INT) :: d_version
- INTEGER(C_LONG) :: d_ino
- CHARACTER(kind=C_CHAR) :: d_type
- CHARACTER(kind=C_CHAR) :: d_unused1(3)
- INTEGER(C_INT) :: d_internal1
- CHARACTER(len=1, kind=C_CHAR) :: d_name(256)
-END TYPE
-
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-INTERFACE
- FUNCTION system_alarm(seconds) BIND(c, name="alarm")
- IMPORT C_INT
- INTEGER(kind=C_INT), VALUE :: seconds
- INTEGER(kind=C_INT) system_alarm
- END FUNCTION system_alarm
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-INTERFACE
- FUNCTION system_calloc(nelem, elsize) BIND(c, name="calloc")
- IMPORT C_SIZE_T, C_INTPTR_T
- INTEGER(C_SIZE_T), VALUE :: nelem, elsize
- INTEGER(C_INTPTR_T) system_calloc
- END FUNCTION system_calloc
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-INTERFACE
- PURE FUNCTION SYSTEM_CLOCK() BIND(c, name="clock")
- IMPORT C_LONG
- INTEGER(C_LONG) system_clock
- END FUNCTION system_clock
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-! Copy N bytes of SRC to DEST, no aliasing or overlapping allowed.
-! extern void *memcpy (void *dest, const void *src, size_t n);
-INTERFACE
- SUBROUTINE system_memcpy(dest, src, n) BIND(C, name='memcpy')
- IMPORT C_INTPTR_T, C_SIZE_T
- INTEGER(C_INTPTR_T), VALUE :: dest
- INTEGER(C_INTPTR_T), VALUE :: src
- INTEGER(C_SIZE_T), VALUE :: n
- END SUBROUTINE system_memcpy
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-INTERFACE
- SUBROUTINE system_free(ptr) BIND(c, name="free")
- IMPORT C_INTPTR_T
- INTEGER(C_INTPTR_T), VALUE :: ptr
- END SUBROUTINE system_free
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-INTERFACE
- FUNCTION system_malloc(size) BIND(c, name="malloc")
- IMPORT C_SIZE_T, C_INTPTR_T
- INTEGER(C_SIZE_T), VALUE :: size
- INTEGER(C_INTPTR_T) system_malloc
- END FUNCTION system_malloc
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-INTERFACE
- FUNCTION system_realloc(ptr, size) BIND(c, name="realloc")
- IMPORT C_SIZE_T, C_INTPTR_T
- INTEGER(C_INTPTR_T), VALUE :: ptr
- INTEGER(C_SIZE_T), VALUE :: size
- INTEGER(C_INTPTR_T) system_realloc
- END FUNCTION system_realloc
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-INTERFACE
- FUNCTION system_time(tloc) BIND(c, name="time")
- ! tloc argument should be loaded via C_LOC from iso_c_binding
- IMPORT C_PTR, C_LONG
- TYPE(C_PTR), VALUE :: tloc
- INTEGER(C_LONG) system_time
- END FUNCTION system_time
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-! abstract interface
-! integer(4) function compar_iface(a, b)
-! import c_int
-! integer, intent(in) :: a, b
-!-! Until implement TYPE(*)
-! integer(kind=c_int) :: compar_iface
-! end function compar_iface
-! end interface
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-! interface
-! subroutine system_qsort(base, nel, width, compar) bind(c, name="qsort")
-! import C_SIZE_T, compar_iface
-! integer :: base
-!-! Until implement TYPE(*)
-! integer(C_SIZE_T), value :: nel, width
-! procedure(compar_iface) compar
-! end subroutine system_qsort
-! end interface
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_srand(3f) - [M_system:PSEUDORANDOM] set seed for pseudo-random number generator system_rand(3f)
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! subroutine system_srand()
-!!
-!!##DESCRIPTION
-!! system_srand(3f) calls the C routine srand(3c) The
-!! srand(3c)/system_srand(3f) function uses its argument as the seed
-!! for a new sequence of pseudo-random integers to be returned by
-!! system_rand(3f)/rand(3c). These sequences are repeatable by calling
-!! system_srand(3f) with the same seed value. If no seed value is
-!! provided, the system_rand(3f) function is automatically seeded with
-!! a value of 1.
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_srand
-!! use M_system, only : system_srand, system_rand
-!! implicit none
-!! integer :: i,j
-!! do j=1,2
-!! call system_srand(1001)
-!! do i=1,10
-!! write(*,*)system_rand()
-!! enddo
-!! write(*,*)
-!! enddo
-!! end program demo_system_srand
-!! expected results:
-!!
-!! 1512084687
-!! 1329390995
-!! 1874040748
-!! 60731048
-!! 239808950
-!! 2017891911
-!! 22055588
-!! 1105177318
-!! 347750200
-!! 1729645355
-!!
-!! 1512084687
-!! 1329390995
-!! 1874040748
-!! 60731048
-!! 239808950
-!! 2017891911
-!! 22055588
-!! 1105177318
-!! 347750200
-!! 1729645355
-!!
-!!##SEE ALSO
-!! drand48(3c), random(3c)
-! void srand_system(int *seed)
-INTERFACE
- SUBROUTINE system_srand(seed) BIND(c, name='srand')
- IMPORT C_INT
- INTEGER(kind=C_INT), INTENT(in) :: seed
- END SUBROUTINE system_srand
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_kill(3f) - [M_system:SIGNALS] send a signal to a process or a group of processes
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! integer(kind=c_int) function system_kill(pid,sig)
-!!
-!! integer,intent(in) :: pid
-!! integer,intent(in) :: sig
-!!
-!!##DESCRIPTION
-!!
-!! The kill() function shall send a signal to a process or a group of
-!! processes specified by pid. The signal to be sent is specified by sig
-!! and is either one from the list given in or 0. If sig is 0
-!! (the null signal), error checking is performed but no signal is actually
-!! sent. The null signal can be used to check the validity of pid.
-!!
-!! For a process to have permission to send a signal to a process designated
-!! by pid, unless the sending process has appropriate privileges, the real
-!! or effective user ID of the sending process shall match the real or
-!! saved set-user-ID of the receiving process.
-!!
-!! If pid is greater than 0, sig shall be sent to the process whose process
-!! ID is equal to pid.
-!!
-!! If pid is 0, sig shall be sent to all processes (excluding an unspecified
-!! set of system processes) whose process group ID is equal to the process
-!! group ID of the sender, and for which the process has permission to send
-!! a signal.
-!!
-!! If pid is -1, sig shall be sent to all processes (excluding an unspecified
-!! set of system processes) for which the process has permission to send
-!! that signal.
-!!
-!! If pid is negative, but not -1, sig shall be sent to all processes
-!! (excluding an unspecified set of system processes) whose process group
-!! ID is equal to the absolute value of pid, and for which the process has
-!! permission to send a signal.
-!!
-!! If the value of pid causes sig to be generated for the sending process,
-!! and if sig is not blocked for the calling thread and if no other thread
-!! has sig unblocked or is waiting in a sigwait() function for sig, either
-!! sig or at least one pending unblocked signal shall be delivered to the
-!! sending thread before kill() returns.
-!!
-!! The user ID tests described above shall not be applied when sending
-!! SIGCONT to a process that is a member of the same session as the sending
-!! process.
-!!
-!! An implementation that provides extended security controls may impose
-!! further implementation-defined restrictions on the sending of signals,
-!! including the null signal. In particular, the system may deny the
-!! existence of some or all of the processes specified by pid.
-!!
-!! The kill() function is successful if the process has permission to send
-!! sig to any of the processes specified by pid. If kill() fails, no signal
-!! shall be sent.
-!!
-!!
-!!##RETURN VALUE
-!!
-!! Upon successful completion, 0 shall be returned. Otherwise, -1 shall be
-!! returned and errno set to indicate the error.
-!!
-!!##ERRORS
-!! The kill() function shall fail if:
-!!
-!! EINVAL The value of the sig argument is an invalid or unsupported
-!! signal number.
-!! EPERM The process does not have permission to send the signal to
-!! any receiving process.
-!! ESRCH No process or process group can be found corresponding to
-!! that specified by pid. The following sections are informative.
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_kill
-!! use M_system, only : system_kill
-!! use M_system, only : system_perror
-!! implicit none
-!! integer :: i,pid,ios,ierr,signal=9
-!! character(len=80) :: argument
-!!
-!! do i=1,command_argument_count()
-!! ! get arguments from command line
-!! call get_command_argument(i, argument)
-!! ! convert arguments to integers assuming they are PID numbers
-!! read(argument,'(i80)',iostat=ios) pid
-!! if(ios.ne.0)then
-!! write(*,*)'bad PID=',trim(argument)
-!! else
-!! write(*,*)'kill SIGNAL=',signal,' PID=',pid
-!! ! send signal SIGNAL to pid PID
-!! ierr=system_kill(pid,signal)
-!! ! write message if an error was detected
-!! if(ierr.ne.0)then
-!! call system_perror('*demo_system_kill*')
-!! endif
-!! endif
-!! enddo
-!! end program demo_system_kill
-!!
-!!##SEE ALSO
-!! getpid(), raise(), setsid(), sigaction(), sigqueue(),
-
-! int kill(pid_t pid, int sig);
-INTERFACE
- FUNCTION system_kill(c_pid, c_signal) BIND(c, name="kill") RESULT(c_ierr)
- IMPORT C_INT
- INTEGER(kind=C_INT), VALUE, INTENT(in) :: c_pid
- INTEGER(kind=C_INT), VALUE, INTENT(in) :: c_signal
- INTEGER(kind=C_INT) :: c_ierr
- END FUNCTION
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_errno(3f) - [M_system:ERROR_PROCESSING] C error return value
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! integer(kind=c_int) function system_errno()
-!!
-!!##DESCRIPTION
-!! Many C routines return an error code which can be queried by errno.
-!! The M_system(3fm) is primarily composed of Fortran routines that call
-!! C routines. In the cases where an error code is returned vi system_errno(3f)
-!! these routines will indicate it.
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_errno
-!! use M_system, only : system_errno, system_unlink, system_perror
-!! implicit none
-!! integer :: stat
-!! stat=system_unlink('not there/OR/anywhere')
-!! if(stat.ne.0)then
-!! write(*,*)'err=',system_errno()
-!! call system_perror('*demo_system_errno*')
-!! endif
-!! end program demo_system_errno
-!!
-!! Typical Results:
-!!
-!! err= 2
-!! *demo_system_errno*: No such file or directory
-
-INTERFACE
- INTEGER(kind=C_INT) FUNCTION system_errno() BIND(C, name="my_errno")
- IMPORT C_INT
- END FUNCTION system_errno
-END INTERFACE
-!-! if a macro on XLF
-!-! interface system_errno
-!-! function ierrno_() bind(c, name="ierrno_")
-!-! import c_int
-!-! integer(kind=c_int) :: ierrno_
-!-! end function system_errno
-!-! end interface
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_geteuid(3f) - [M_system:QUERY] get effective UID of current process from Fortran by calling geteuid(3c)
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! integer(kind=c_int) function system_geteuid()
-!!
-!!##DESCRIPTION
-!! The system_geteuid(3f) function shall return the effective user
-!! ID of the calling process. The geteuid() function shall always be
-!! successful and no return value is reserved to indicate the error.
-!!##EXAMPLE
-!!
-!! Get group ID from Fortran:
-!!
-!! program demo_system_geteuid
-!! use M_system, only : system_geteuid
-!! implicit none
-!! write(*,*)'EFFECTIVE UID=',system_geteuid()
-!! end program demo_system_geteuid
-INTERFACE
- INTEGER(kind=C_INT) FUNCTION system_geteuid() BIND(C, name="geteuid")
- IMPORT C_INT
- END FUNCTION system_geteuid
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_getuid(3f) - [M_system:QUERY] get real UID of current process from Fortran by calling getuid(3c)
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! integer(kind=c_int) function system_getuid()
-!!
-!!##DESCRIPTION
-!! The system_getuid(3f) function shall return the real user ID
-!! of the calling process. The getuid() function shall always be
-!! successful and no return value is reserved to indicate the error.
-!!##EXAMPLE
-!!
-!! Get group ID from Fortran:
-!!
-!! program demo_system_getuid
-!! use M_system, only : system_getuid
-!! implicit none
-!! write(*,*)'UID=',system_getuid()
-!! end program demo_system_getuid
-!!
-!! Results:
-!!
-!! UID= 197609
-INTERFACE
- INTEGER(kind=C_INT) FUNCTION system_getuid() BIND(C, name="getuid")
- IMPORT C_INT
- END FUNCTION system_getuid
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_getegid(3f) - [M_system:QUERY] get the effective group ID (GID) of current process from Fortran by calling getegid(3c)
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! integer(kind=c_int) function system_getegid()
-!!##DESCRIPTION
-!! The getegid() function returns the effective group ID of the
-!! calling process.
-!!
-!!##RETURN VALUE
-!! The getegid() should always be successful and no return value is
-!! reserved to indicate an error.
-!!
-!!##ERRORS
-!! No errors are defined.
-!!
-!!##SEE ALSO
-!! getegid(), system_geteuid(), getuid(), setegid(), seteuid(), setgid(),
-!! setregid(), setreuid(), setuid()
-!!
-!!##EXAMPLE
-!!
-!! Get group ID from Fortran
-!!
-!! program demo_system_getegid
-!! use M_system, only : system_getegid
-!! implicit none
-!! write(*,*)'GID=',system_getegid()
-!! end program demo_system_getegid
-INTERFACE
- INTEGER(kind=C_INT) FUNCTION system_getegid() BIND(C, name="getegid")
- IMPORT C_INT
- END FUNCTION system_getegid
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_getgid(3f) - [M_system:QUERY] get the real group ID (GID) of current process from Fortran by calling getgid(3c)
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! integer(kind=c_int) function system_getgid()
-!!##DESCRIPTION
-!! The getgid() function returns the real group ID of the calling process.
-!!
-!!##RETURN VALUE
-!! The getgid() should always be successful and no return value is
-!! reserved to indicate an error.
-!!
-!!##ERRORS
-!! No errors are defined.
-!!
-!!##SEE ALSO
-!! getegid(), system_geteuid(), getuid(), setegid(), seteuid(), setgid(),
-!! setregid(), setreuid(), setuid()
-!!
-!!##EXAMPLE
-!!
-!! Get group ID from Fortran
-!!
-!! program demo_system_getgid
-!! use M_system, only : system_getgid
-!! implicit none
-!! write(*,*)'GID=',system_getgid()
-!! end program demo_system_getgid
-INTERFACE
- INTEGER(kind=C_INT) FUNCTION system_getgid() BIND(C, name="getgid")
- IMPORT C_INT
- END FUNCTION system_getgid
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_setsid(3f) - [M_system:QUERY] create session and set the process group ID of a session leader
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! integer(kind=c_int) function system_setsid(pid)
-!! integer(kind=c_int) :: pid
-!!##DESCRIPTION
-!! The setsid() function creates a new session, if the calling process is not a process group leader. Upon return the
-!! calling process shall be the session leader of this new session, shall be the process group leader of a new process
-!! group, and shall have no controlling terminal. The process group ID of the calling process shall be set equal to the
-!! process ID of the calling process. The calling process shall be the only process in the new process group and the only
-!! process in the new session.
-!!
-!!##RETURN VALUE
-!! Upon successful completion, setsid() shall return the value of the new process group ID of the calling process. Otherwise,
-!! it shall return �-1 and set errno to indicate the error.
-!!##ERRORS
-!! The setsid() function shall fail if:
-!!
-!! o The calling process is already a process group leader
-!! o the process group ID of a process other than the calling process matches the process ID of the calling process.
-!!##EXAMPLE
-!!
-!! Set SID from Fortran
-!!
-!! program demo_system_setsid
-!! use M_system, only : system_setsid
-!! implicit none
-!! write(*,*)'SID=',system_setsid()
-!! end program demo_system_setsid
-INTERFACE
- INTEGER(kind=C_INT) FUNCTION system_setsid() BIND(C, name="setsid")
- IMPORT C_INT
- END FUNCTION system_setsid
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_getsid(3f) - [M_system:QUERY] get the process group ID of a session leader
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! integer(kind=c_int) function system_getsid(pid)
-!! integer(kind=c_int) :: pid
-!!##DESCRIPTION
-!! The system_getsid() function obtains the process group ID of the
-!! process that is the session leader of the process specified by pid.
-!! If pid is 0, it specifies the calling process.
-!!##RETURN VALUE
-!! Upon successful completion, system_getsid() shall return the process group
-!! ID of the session leader of the specified process. Otherwise,
-!! it shall return -1 and set errno to indicate the error.
-!!##EXAMPLE
-!!
-!! Get SID from Fortran
-!!
-!! program demo_system_getsid
-!! use M_system, only : system_getsid
-!! use ISO_C_BINDING, only : c_int
-!! implicit none
-!! write(*,*)'SID=',system_getsid(0_c_int)
-!! end program demo_system_getsid
-INTERFACE
- INTEGER(kind=C_INT) FUNCTION system_getsid(c_pid) BIND(C, name="getsid")
- IMPORT C_INT
- INTEGER(kind=C_INT) :: c_pid
- END FUNCTION system_getsid
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_getpid(3f) - [M_system:QUERY] get PID (process ID) of current process from Fortran by calling getpid(3c)
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! integer function system_getpid()
-!!##DESCRIPTION
-!! The system_getpid() function returns the process ID of the
-!! calling process.
-!!##RETURN VALUE
-!! The value returned is the integer process ID. The system_getpid()
-!! function shall always be successful and no return value is reserved
-!! to indicate an error.
-!!##EXAMPLE
-!!
-!! Get process PID from Fortran
-!!
-!! program demo_system_getpid
-!! use M_system, only : system_getpid
-!! implicit none
-!! write(*,*)'PID=',system_getpid()
-!! end program demo_system_getpid
-
-INTERFACE
- PURE INTEGER(kind=C_INT) FUNCTION system_getpid() BIND(C, name="getpid")
- IMPORT C_INT
- END FUNCTION system_getpid
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_getppid(3f) - [M_system:QUERY] get parent process ID (PPID) of current process from Fortran by calling getppid(3c)
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! integer(kind=c_int) function system_getppid()
-!!##DESCRIPTION
-!! The system_getppid() function returns the parent process ID of
-!! the calling process.
-!!
-!!##RETURN VALUE
-!! The system_getppid() function should always be successful and no
-!! return value is reserved to indicate an error.
-!!
-!!##ERRORS
-!! No errors are defined.
-!!
-!!##SEE ALSO
-!! exec, fork(), getpgid(), getpgrp(), getpid(), kill(),
-!! setpgid(), setsid()
-!!
-!!##EXAMPLE
-!!
-!! Get parent process PID (PPID) from Fortran
-!!
-!! program demo_system_getppid
-!! use M_system, only : system_getppid
-!! implicit none
-!! write(*,*)'PPID=',system_getppid()
-!! end program demo_system_getppid
-INTERFACE
- INTEGER(kind=C_INT) FUNCTION system_getppid() BIND(C, name="getppid")
- IMPORT C_INT
- END FUNCTION system_getppid
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_umask(3fp) - [M_system] set and get the file mode creation mask
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! integer(kind=c_int) function system_umask(umask_value)
-!!
-!!##DESCRIPTION
-!! The system_umask() function shall set the file mode creation mask of the
-!! process to cmask and return the previous value of the mask. Only
-!! the file permission bits of cmask (see ) are used;
-!! the meaning of the other bits is implementation-defined.
-!!
-!! The file mode creation mask of the process is used to turn off
-!! permission bits in the mode argument supplied during calls to
-!! the following functions:
-!!
-!! * open(), openat(), creat(), mkdir(), mkdirat(), mkfifo(), and mkfifoat()
-!! * mknod(), mknodat()
-!! * mq_open()
-!! * sem_open()
-!!
-!! Bit positions that are set in cmask are cleared in the mode of the created file.
-!!
-!!##RETURN VALUE
-!! The file permission bits in the value returned by umask() shall be
-!! the previous value of the file mode creation mask. The state of any
-!! other bits in that value is unspecified, except that a subsequent
-!! call to umask() with the returned value as cmask shall leave the
-!! state of the mask the same as its state before the first call,
-!! including any unspecified use of those bits.
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_umask
-!! use M_system, only : system_getumask, system_setumask
-!! implicit none
-!! integer value
-!! integer mask
-!! mask=O'002'
-!! value=system_setumask(mask)
-!! write(*,'(a,"octal=",O4.4," decimal=",i0)')'OLD VALUE=',value,value
-!! value=system_getumask()
-!! write(*,'(a,"octal=",O4.4," decimal=",i0)')'MASK=',mask,mask
-!! write(*,'(a,"octal=",O4.4," decimal=",i0)')'NEW VALUE=',value,value
-!! end program demo_system_umask
-!!
-!! Expected results:
-!!
-!! OLD VALUE=octal=0022 decimal=18
-!! MASK=octal=0002 decimal=2
-!! NEW VALUE=octal=0002 decimal=2
-INTERFACE
- INTEGER(kind=C_INT) FUNCTION system_umask(umask_value) BIND(C, name="umask")
- IMPORT C_INT
- INTEGER(kind=C_INT), VALUE :: umask_value
- END FUNCTION system_umask
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_rand(3f) - [M_system:PSEUDORANDOM] call pseudo-random number generator rand(3c)
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! integer(kind=c_int) :: function system_rand()
-!!##DESCRIPTION
-!! Use rand(3c) to generate pseudo-random numbers.
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_rand
-!! use M_system, only : system_srand, system_rand
-!! implicit none
-!! integer :: i
-!!
-!! call system_srand(1001)
-!! do i=1,10
-!! write(*,*)system_rand()
-!! enddo
-!! write(*,*)
-!!
-!! end program demo_system_rand
-!! expected results:
-!!
-!! 1512084687
-!! 1329390995
-!! 1874040748
-!! 60731048
-!! 239808950
-!! 2017891911
-!! 22055588
-!! 1105177318
-!! 347750200
-!! 1729645355
-!!
-!! 1512084687
-!! 1329390995
-!! 1874040748
-!! 60731048
-!! 239808950
-!! 2017891911
-!! 22055588
-!! 1105177318
-!! 347750200
-!! 1729645355
-INTERFACE
- INTEGER(kind=C_INT) FUNCTION system_rand() BIND(C, name="rand")
- IMPORT C_INT
- END FUNCTION system_rand
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-INTERFACE
- SUBROUTINE c_flush() BIND(C, name="my_flush")
- END SUBROUTINE c_flush
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_initenv(3f) - [M_system:ENVIRONMENT] initialize environment table pointer and size so table can be read by readenv(3f)
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! subroutine system_initenv()
-!!##DESCRIPTION
-!! A simple interface allows reading the environment variable table
-!! of the process. Call system_initenv(3f) to initialize reading the
-!! environment table, then call system_readenv(3f) until a blank line
-!! is returned. If more than one thread reads the environment or the
-!! environment is changed while being read the results are undefined.
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_initenv
-!! use M_system, only : system_initenv, system_readenv
-!! character(len=:),allocatable :: string
-!! call system_initenv()
-!! do
-!! string=system_readenv()
-!! if(string.eq.'')then
-!! exit
-!! else
-!! write(*,'(a)')string
-!! endif
-!! enddo
-!! end program demo_system_initenv
-!!
-!! Sample results:
-!!
-!! USERDOMAIN_ROAMINGPROFILE=buzz
-!! HOMEPATH=\Users\JSU
-!! APPDATA=C:\Users\JSU\AppData\Roaming
-!! MANPATH=/home/urbanjs/V600/LIBRARY/libGPF/download/tmp/man:/home/urbanjs/V600/doc/man:::
-!! DISPLAYNUM=0
-!! ProgramW6432=C:\Program Files
-!! HOSTNAME=buzz
-!! XKEYSYMDB=/usr/share/X11/XKeysymDB
-!! PUBLISH_CMD=
-!! OnlineServices=Online Services
-!! :
-!! :
-!! :
-
-integer(kind=c_long),bind(c,name="longest_env_variable") :: longest_env_variable
-
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-INTERFACE
- SUBROUTINE system_initenv() BIND(C, NAME='my_initenv')
- END SUBROUTINE system_initenv
-END INTERFACE
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!-!type(c_ptr),bind(c,name="environ") :: c_environ
-
-INTEGER(kind=mode_t), BIND(c, name="FS_IRGRP") :: R_GRP
-INTEGER(kind=mode_t), BIND(c, name="FS_IROTH") :: R_OTH
-INTEGER(kind=mode_t), BIND(c, name="FS_IRUSR") :: R_USR
-INTEGER(kind=mode_t), BIND(c, name="FS_IRWXG") :: RWX_G
-INTEGER(kind=mode_t), BIND(c, name="FS_IRWXO") :: RWX_O
-INTEGER(kind=mode_t), BIND(c, name="FS_IRWXU") :: RWX_U
-INTEGER(kind=mode_t), BIND(c, name="FS_IWGRP") :: W_GRP
-INTEGER(kind=mode_t), BIND(c, name="FS_IWOTH") :: W_OTH
-INTEGER(kind=mode_t), BIND(c, name="FS_IWUSR") :: W_USR
-INTEGER(kind=mode_t), BIND(c, name="FS_IXGRP") :: X_GRP
-INTEGER(kind=mode_t), BIND(c, name="FS_IXOTH") :: X_OTH
-INTEGER(kind=mode_t), BIND(c, name="FS_IXUSR") :: X_USR
-INTEGER(kind=mode_t), BIND(c, name="FDEFFILEMODE") :: DEFFILEMODE
-INTEGER(kind=mode_t), BIND(c, name="FACCESSPERMS") :: ACCESSPERMS
-
-! Host names are limited to {HOST_NAME_MAX} bytes.
-INTEGER(kind=mode_t), BIND(c, name="FHOST_NAME_MAX") :: HOST_NAME_MAX
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-! for system_access(3f)
-!integer(kind=c_int),bind(c,name="F_OK") :: F_OK
-!integer(kind=c_int),bind(c,name="R_OK") :: R_OK
-!integer(kind=c_int),bind(c,name="W_OK") :: W_OK
-!integer(kind=c_int),bind(c,name="X_OK") :: X_OK
-! not sure these will be the same on all systems, but above did not work
-INTEGER(kind=C_INT), PARAMETER :: F_OK = 0
-INTEGER(kind=C_INT), PARAMETER :: R_OK = 4
-INTEGER(kind=C_INT), PARAMETER :: W_OK = 2
-INTEGER(kind=C_INT), PARAMETER :: X_OK = 1
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-ABSTRACT INTERFACE ! mold for signal handler to be installed by system_signal
- SUBROUTINE handler(signum)
- INTEGER :: signum
- END SUBROUTINE handler
-END INTERFACE
-TYPE handler_pointer
- PROCEDURE(handler), POINTER, NOPASS :: sub
-END TYPE handler_pointer
-INTEGER, PARAMETER :: no_of_signals = 64 ! obtained with command: kill -l
-TYPE(handler_pointer), DIMENSION(no_of_signals) :: handler_ptr_array
-!===================================================================================================================================
-CONTAINS
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_signal(3f) - [M_system:SIGNALS] install a signal handler
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! subroutine system_signal(sig,handler)
-!!
-!! integer,intent(in) :: sig
-!! interface
-!! subroutine handler(signum)
-!! integer :: signum
-!! end subroutine handler
-!! end interface
-!! optional :: handler
-!!
-!!##DESCRIPTION
-!! Calling system_signal(NUMBER, HANDLER) causes user-defined
-!! subroutine HANDLER to be executed when the signal NUMBER is
-!! caught. The same subroutine HANDLER maybe installed to handle
-!! different signals. HANDLER takes only one integer argument which
-!! is assigned the signal number that is caught. See sample program
-!! below for illustration.
-!!
-!! Calling system_signal(NUMBER) installs a do-nothing handler. This
-!! is not equivalent to ignoring the signal NUMBER though, because
-!! the signal can still interrupt any sleep or idle-wait.
-!!
-!! Note that the signals SIGKILL and SIGSTOP cannot be handled
-!! this way.
-!!
-!! [Compare signal(2) and the GNU extension signal in gfortran.]
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_signal
-!! use M_system, only : system_signal
-!! implicit none
-!! logical :: loop=.true.
-!! integer, parameter :: SIGINT=2,SIGQUIT=3
-!! call system_signal(SIGINT,exitloop)
-!! call system_signal(SIGQUIT,quit)
-!! write(*,*)'Starting infinite loop. Press Ctrl+C to exit.'
-!! do while(loop)
-!! enddo
-!! write(*,*)'Reporting from outside the infinite loop.'
-!! write(*,*)'Starting another loop. Do Ctrl+\ anytime to quit.'
-!! loop=.true.
-!! call system_signal(2)
-!! write(*,*)'Just installed do-nothing handler for SIGINT. Try Ctrl+C to test.'
-!! do while(loop)
-!! enddo
-!! write(*,*)'You should never see this line when running this demo.'
-!!
-!! contains
-!!
-!! subroutine exitloop(signum)
-!! integer :: signum
-!! write(*,*)'Caught SIGINT. Exiting infinite loop.'
-!! loop=.false.
-!! end subroutine exitloop
-!!
-!! subroutine quit(signum)
-!! integer :: signum
-!! STOP 'Caught SIGQUIT. Stopping demo.'
-!! end subroutine quit
-!! end program demo_system_signal
-!!
-!!##AUTHOR
-!! Somajit Dey
-!!
-!!##LICENSE
-!! Public Domain
-SUBROUTINE system_signal(signum, handler_routine)
- INTEGER, INTENT(in) :: signum
- PROCEDURE(handler), OPTIONAL :: handler_routine
- TYPE(C_FUNPTR) :: ret, c_handler
-
- INTERFACE
- FUNCTION c_signal(signal, sighandler) BIND(c, name='signal')
- IMPORT :: C_INT, C_FUNPTR
- INTEGER(C_INT), VALUE, INTENT(in) :: signal
- TYPE(C_FUNPTR), VALUE, INTENT(in) :: sighandler
- TYPE(C_FUNPTR) :: c_signal
- END FUNCTION c_signal
- END INTERFACE
-
- IF (PRESENT(handler_routine)) THEN
- handler_ptr_array(signum)%sub => handler_routine
- ELSE
- !!handler_ptr_array(signum)%sub => null(handler_ptr_array(signum)%sub)
- handler_ptr_array(signum)%sub => NULL()
- END IF
- c_handler = C_FUNLOC(f_handler)
- ret = c_signal(signum, c_handler)
-END SUBROUTINE system_signal
-
-SUBROUTINE f_handler(signum) BIND(c)
- INTEGER(C_INT), INTENT(in), VALUE :: signum
- if(associated(handler_ptr_array(signum)%sub))call handler_ptr_array(signum)%sub(signum)
-END SUBROUTINE f_handler
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_access(3f) - [M_system:QUERY_FILE] checks accessibility or existence of a pathname
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! elemental impure logical function system_access(pathname,amode)
-!!
-!! character(len=*),intent(in) :: pathname
-!! integer,intent(in) :: amode
-!!
-!!##DESCRIPTION
-!!
-!! The system_access(3f) function checks pathname existence and access
-!! permissions. The function checks the pathname for accessibility
-!! according to the bit pattern contained in amode, using the real user
-!! ID in place of the effective user ID and the real group ID in place
-!! of the effective group ID.
-!!
-!! The value of amode is either the bitwise-inclusive OR of the access
-!! permissions to be checked (R_OK, W_OK, X_OK) or the existence test (F_OK).
-!!
-!!##OPTIONS
-!! pathname a character string representing a directory pathname. Trailing spaces are ignored.
-!! amode bitwise-inclusive OR of the values R_OK, W_OK, X_OK, or F_OK.
-!!
-!!##RETURN VALUE
-!! If not true an error occurred or the requested access is not granted
-!!
-!!##EXAMPLE
-!!
-!! check if filename is accessible
-!!
-!! Sample program:
-!!
-!! program demo_system_access
-!! use M_system, only : system_access, F_OK, R_OK, W_OK, X_OK
-!! implicit none
-!! integer :: i
-!! character(len=80),parameter :: names(*)=[ &
-!! '/usr/bin/bash ', &
-!! '/tmp/NOTTHERE ', &
-!! '/usr/local ', &
-!! '. ', &
-!! 'PROBABLY_NOT ']
-!! do i=1,size(names)
-!! write(*,*)' does ',trim(names(i)),' exist? ', system_access(names(i),F_OK)
-!! write(*,*)' is ',trim(names(i)),' readable? ', system_access(names(i),R_OK)
-!! write(*,*)' is ',trim(names(i)),' writable? ', system_access(names(i),W_OK)
-!! write(*,*)' is ',trim(names(i)),' executable? ', system_access(names(i),X_OK)
-!! enddo
-!! end program demo_system_access
-ELEMENTAL impure FUNCTION system_access(pathname, amode)
- IMPLICIT NONE
-
-! ident_1="@(#)M_system::system_access(3f): checks accessibility or existence of a pathname"
-
- CHARACTER(len=*), INTENT(in) :: pathname
- INTEGER, INTENT(in) :: amode
- LOGICAL :: system_access
-
- INTERFACE
- function c_access(c_pathname,c_amode) bind (C,name="my_access") result (c_ierr)
- IMPORT C_CHAR, C_INT
- CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: c_pathname(*)
- INTEGER(kind=C_INT), VALUE :: c_amode
- INTEGER(kind=C_INT) :: c_ierr
- END FUNCTION c_access
- END INTERFACE
-
- IF (c_access(str2_carr(TRIM(pathname)), INT(amode, kind=C_INT)) .EQ. 0) THEN
- system_access = .TRUE.
- ELSE
- system_access = .FALSE.
- !!if(system_errno().ne.0)then
- !! call perror('*system_access*')
- !!endif
- END IF
-
-END FUNCTION system_access
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_utime(3f) - [M_system:FILE_SYSTEM] set file access and modification times
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! function utime(pathname,times)
-!!
-!! character(len=*),intent(in) :: pathname
-!! integer,intent(in),optional :: times(2)
-!! logical :: utime
-!!
-!!##DESCRIPTION
-!! The system_utime(3f) function sets the access and modification
-!! times of the file named by the path argument by calling utime(3c).
-!!
-!! If times() is not present the access and modification times of
-!! the file shall be set to the current time.
-!!
-!! To use system_utime(3f) the effective user ID of the process must
-!! match the owner of the file, or the process has to have write
-!! permission to the file or have appropriate privileges,
-!!
-!!##OPTIONS
-!! times If present, the values will be interpreted as the access
-!! and modification times as Unix Epoch values. That is,
-!! they are times measured in seconds since the Unix Epoch.
-!!
-!! pathname name of the file whose access and modification times
-!! are to be updated.
-!!
-!!##RETURN VALUE
-!! Upon successful completion .TRUE. is returned. Otherwise,
-!! .FALSE. is returned and errno shall be set to indicate the error,
-!! and the file times remain unaffected.
-!!
-!!##ERRORS
-!! The underlying utime(3c) function fails if:
-!!
-!! EACCES Search permission is denied by a component of the path
-!! prefix; or the times argument is a null pointer and the
-!! effective user ID of the process does not match the owner
-!! of the file, the process does not have write permission
-!! for the file, and the process does not have appropriate
-!! privileges.
-!!
-!! ELOOP A loop exists in symbolic links encountered during
-!! resolution of the path argument.
-!!
-!! ENAMETOOLONG The length of a component of a pathname is longer
-!! than {NAME_MAX}.
-!!
-!! ENOENT A component of path does not name an existing file
-!! or path is an empty string.
-!!
-!! ENOTDIR A component of the path prefix names an existing file
-!! that is neither a directory nor a symbolic link to a
-!! directory, or the path argument contains at least one
-!! non- character and ends with one or more trailing
-!! characters and the last pathname component
-!! names an existing file that is neither a directory nor
-!! a symbolic link to a directory.
-!!
-!! EPERM The times argument is not a null pointer and the effective
-!! user ID of the calling process does not match the owner
-!! of the file and the calling process does not have
-!! appropriate privileges.
-!!
-!! EROFS The file system containing the file is read-only.
-!!
-!! The utime() function may fail if:
-!!
-!! ELOOP More than {SYMLOOP_MAX} symbolic links were encountered
-!! during resolution of the path argument.
-!!
-!! ENAMETOOLONG The length of a pathname exceeds {PATH_MAX}, or
-!! pathname resolution of a symbolic link produced
-!! an intermediate result with a length that exceeds
-!! {PATH_MAX}.
-!!
-!!##EXAMPLES
-!!
-!! Sample program
-!!
-!! program demo_system_utime
-!! use M_system, only : system_utime, system_perror
-!! implicit none
-!! character(len=4096) :: pathname
-!! integer :: times(2)
-!! integer :: i
-!! do i=1,command_argument_count()
-!! call get_command_argument(i, pathname)
-!! if(.not.system_utime(pathname,times))then
-!! call system_perror('*demo_system_utime*')
-!! endif
-!! enddo
-!! end program demo_system_utime
-FUNCTION system_utime(pathname, times)
- IMPLICIT NONE
-
-! ident_2="@(#)M_system::system_utime(3f): set access and modification times of a pathname"
-
- CHARACTER(len=*), INTENT(in) :: pathname
- INTEGER, INTENT(in), OPTIONAL :: times(2)
- INTEGER :: times_local(2)
- LOGICAL :: system_utime
-
-!-! int my_utime(const char *path, int times[2])
- INTERFACE
- FUNCTION c_utime(c_pathname, c_times) BIND(C, name="my_utime") RESULT(c_ierr)
- IMPORT C_CHAR, C_INT
- CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: c_pathname(*)
- INTEGER(kind=C_INT), INTENT(in) :: c_times(2)
- INTEGER(kind=C_INT) :: c_ierr
- END FUNCTION c_utime
- END INTERFACE
- IF (PRESENT(times)) THEN
- times_local = times
- ELSE
- times_local = timestamp()
- END IF
- if(c_utime(str2_carr(trim(pathname)),int(times_local,kind=c_int)).eq.0)then
- system_utime = .TRUE.
- ELSE
- system_utime = .FALSE.
- !!if(system_errno().ne.0)then
- !! call perror('*system_utime*')
- !!endif
- END IF
-
-END FUNCTION system_utime
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-FUNCTION timestamp() RESULT(epoch)
- USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_LONG
- IMPLICIT NONE
- INTEGER(kind=8) :: epoch
- INTERFACE
- ! time_t time(time_t *tloc)
- FUNCTION c_time(tloc) BIND(c, name='time')
- IMPORT :: C_LONG
- INTEGER(kind=C_LONG), INTENT(in), VALUE :: tloc
- INTEGER(kind=C_LONG) :: c_time
- END FUNCTION c_time
- END INTERFACE
- epoch = c_time(INT(0, kind=8))
-END FUNCTION timestamp
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_realpath(3f) - [M_system:FILE_SYSTEM] call realpath(3c) to resolve a pathname
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! function system_realpath(input) result(output)
-!!
-!! character(len=*),intent(in) :: input
-!! character(len=:),allocatable :: output
-!!##DESCRIPTION
-!! system_realpath(3f) calls the C routine realpath(3c) to obtain the absolute pathname of given path
-!!##OPTIONS
-!!
-!! INPUT pathname to resolve
-!!
-!!##RETURN VALUE
-!! OUTPUT The absolute pathname of the given input pathname.
-!! The pathname shall contain no components that are dot
-!! or dot-dot, or are symbolic links. It is equal to the
-!! NULL character if an error occurred.
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_realpath
-!! use M_system, only : system_realpath, system_perror
-!! implicit none
-!! ! resolve each pathname given on command line
-!! character(len=:),allocatable :: pathi,patho
-!! integer :: i
-!! integer :: filename_length
-!! do i = 1, command_argument_count()
-!! ! get pathname from command line arguments
-!! call get_command_argument (i , length=filename_length)
-!! if(allocated(pathi))deallocate(pathi)
-!! allocate(character(len=filename_length) :: pathi)
-!! call get_command_argument (i , value=pathi)
-!! !
-!! ! resolve each pathname
-!! patho=system_realpath(pathi)
-!! if(patho.ne.char(0))then
-!! write(*,*)trim(pathi),'=>',trim(patho)
-!! else
-!! call system_perror('*system_realpath* error for pathname '//trim(pathi)//':')
-!! write(*,*)trim(pathi),'=>',trim(patho)
-!! endif
-!! deallocate(pathi)
-!! enddo
-!! ! if there were no pathnames given resolve the pathname "."
-!! if(i.eq.1)then
-!! patho=system_realpath('.')
-!! write(*,*)'.=>',trim(patho)
-!! endif
-!! end program demo_system_realpath
-!!
-!! Example usage:
-!!
-!! demo_system_realpath
-!! .=>/home/urbanjs/V600
-!!
-!! cd /usr/share/man
-!! demo_system_realpath . .. NotThere
-!! .=>/usr/share/man
-!! ..=>/usr/share
-!! *system_realpath* error for pathname NotThere:: No such file or directory
-!! NotThere=>NotThere
-FUNCTION system_realpath(input) RESULT(string)
-
-! ident_3="@(#)M_system::system_realpath(3f):call realpath(3c) to get pathname of current working directory"
-
- CHARACTER(len=*), INTENT(in) :: input
- TYPE(C_PTR) :: c_output
- CHARACTER(len=:), ALLOCATABLE :: string
- INTERFACE
- FUNCTION c_realpath(c_input) BIND(c, name="my_realpath") RESULT(c_buffer)
- IMPORT C_CHAR, C_SIZE_T, C_PTR, C_INT
- CHARACTER(kind=C_CHAR), INTENT(in) :: c_input(*)
- TYPE(C_PTR) :: c_buffer
- END FUNCTION
- END INTERFACE
-!-----------------------------------------------------------------------------------------------------------------------------------
- c_output = c_realpath(str2_carr(TRIM(input)))
- IF (.NOT. C_ASSOCIATED(c_output)) THEN
- string = CHAR(0)
- ELSE
- string = C2F_string(c_output)
- END IF
-END FUNCTION system_realpath
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_issock(3f) - [M_system:QUERY_FILE] checks if argument is a socket
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! elemental impure logical function system_issock(pathname)
-!!
-!! character(len=*),intent(in) :: pathname
-!! logical :: system_issock
-!!
-!!##DESCRIPTION
-!! The issock(3f) function checks if path is a path to a socket
-!!
-!!##OPTIONS
-!! path a character string representing a socket pathname. Trailing spaces are ignored.
-!!
-!!##RETURN VALUE
-!! The system_issock() function should always be successful and no
-!! return value is reserved to indicate an error.
-!!
-!!##ERRORS
-!! No errors are defined.
-!!
-!!##SEE ALSO
-!! system_isreg(3f), system_stat(3f), system_isdir(3f), system_perm(3f)
-!!
-!!##EXAMPLE
-!!
-!! check if filename is a socket
-!!
-!! program demo_system_issock
-!! use M_system, only : system_issock
-!! implicit none
-!! integer :: i
-!! character(len=80),parameter :: names(*)=[ &
-!! '/tmp ', &
-!! '/tmp/NOTTHERE ', &
-!! '/usr/local ', &
-!! '. ', &
-!! 'sock.test ', &
-!! 'PROBABLY_NOT ']
-!! do i=1,size(names)
-!! write(*,*)' is ',trim(names(i)),' a socket? ', system_issock(names(i))
-!! enddo
-!! end program demo_system_issock
-FUNCTION system_issock(pathname)
- IMPLICIT NONE
-
-! ident_4="@(#)M_system::system_issock(3f): determine if pathname is a socket"
-
- CHARACTER(len=*), INTENT(in) :: pathname
- LOGICAL :: system_issock
-
- INTERFACE
- FUNCTION c_issock(pathname) BIND(C, name="my_issock") RESULT(c_ierr)
- IMPORT C_CHAR, C_INT
- CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: pathname(*)
- INTEGER(kind=C_INT) :: c_ierr
- END FUNCTION c_issock
- END INTERFACE
-
- IF (c_issock(str2_carr(TRIM(pathname))) .EQ. 1) THEN
- system_issock = .TRUE.
- ELSE
- system_issock = .FALSE.
- END IF
-
-END FUNCTION system_issock
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_isfifo(3f) - [M_system:QUERY_FILE] checks if argument is a fifo - named pipe
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! elemental impure logical function system_isfifo(pathname)
-!!
-!! character(len=*),intent(in) :: pathname
-!! logical :: system_isfifo
-!!
-!!##DESCRIPTION
-!! The isfifo(3f) function checks if path is a path to a fifo - named pipe.
-!!
-!!##OPTIONS
-!! path a character string representing a fifo - named pipe pathname. Trailing spaces are ignored.
-!!
-!!##RETURN VALUE
-!! The system_isfifo() function should always be successful and no
-!! return value is reserved to indicate an error.
-!!
-!!##ERRORS
-!! No errors are defined.
-!!
-!!##SEE ALSO
-!! system_isreg(3f), system_stat(3f), system_isdir(3f), system_perm(3f)
-!!
-!!##EXAMPLE
-!!
-!! check if filename is a FIFO file
-!!
-!! program demo_system_isfifo
-!! use M_system, only : system_isfifo
-!! implicit none
-!! integer :: i
-!! character(len=80),parameter :: names(*)=[ &
-!! '/tmp ', &
-!! '/tmp/NOTTHERE ', &
-!! '/usr/local ', &
-!! '. ', &
-!! 'fifo.test ', &
-!! 'PROBABLY_NOT ']
-!! do i=1,size(names)
-!! write(*,*)' is ',trim(names(i)),' a fifo(named pipe)? ', system_isfifo(names(i))
-!! enddo
-!! end program demo_system_isfifo
-ELEMENTAL impure FUNCTION system_isfifo(pathname)
- IMPLICIT NONE
-
-! ident_5="@(#)M_system::system_isfifo(3f): determine if pathname is a fifo(named pipe)"
-
- CHARACTER(len=*), INTENT(in) :: pathname
- LOGICAL :: system_isfifo
-
- INTERFACE
- FUNCTION c_isfifo(pathname) BIND(C, name="my_isfifo") RESULT(c_ierr)
- IMPORT C_CHAR, C_INT
- CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: pathname(*)
- INTEGER(kind=C_INT) :: c_ierr
- END FUNCTION c_isfifo
- END INTERFACE
-
- IF (c_isfifo(str2_carr(TRIM(pathname))) .EQ. 1) THEN
- system_isfifo = .TRUE.
- ELSE
- system_isfifo = .FALSE.
- END IF
-
-END FUNCTION system_isfifo
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_ischr(3f) - [M_system:QUERY_FILE] checks if argument is a character device
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! elemental impure logical function system_ischr(pathname)
-!!
-!! character(len=*),intent(in) :: pathname
-!! logical :: system_ischr
-!!
-!!##DESCRIPTION
-!! The ischr(3f) function checks if path is a path to a character device.
-!!
-!!##OPTIONS
-!! path a character string representing a character device pathname. Trailing spaces are ignored.
-!!
-!!##RETURN VALUE
-!! The system_ischr() function should always be successful and no
-!! return value is reserved to indicate an error.
-!!
-!!##ERRORS
-!! No errors are defined.
-!!
-!!##SEE ALSO
-!! system_isreg(3f), system_stat(3f), system_isdir(3f), system_perm(3f)
-!!
-!!##EXAMPLE
-!!
-!! check if filename is a character file
-!!
-!! program demo_system_ischr
-!! use M_system, only : system_ischr
-!! implicit none
-!! integer :: i
-!! character(len=80),parameter :: names(*)=[ &
-!! '/tmp ', &
-!! '/tmp/NOTTHERE ', &
-!! '/usr/local ', &
-!! '. ', &
-!! 'char_dev.test ', &
-!! 'PROBABLY_NOT ']
-!! do i=1,size(names)
-!! write(*,*)' is ',trim(names(i)),' a character device? ', system_ischr(names(i))
-!! enddo
-!! end program demo_system_ischr
-!!
-!! Results:
-ELEMENTAL impure FUNCTION system_ischr(pathname)
- IMPLICIT NONE
-
-! ident_6="@(#)M_system::system_ischr(3f): determine if pathname is a link"
-
- CHARACTER(len=*), INTENT(in) :: pathname
- LOGICAL :: system_ischr
-
- INTERFACE
- FUNCTION c_ischr(pathname) BIND(C, name="my_ischr") RESULT(c_ierr)
- IMPORT C_CHAR, C_INT
- CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: pathname(*)
- INTEGER(kind=C_INT) :: c_ierr
- END FUNCTION c_ischr
- END INTERFACE
-
- IF (c_ischr(str2_carr(TRIM(pathname))) .EQ. 1) THEN
- system_ischr = .TRUE.
- ELSE
- system_ischr = .FALSE.
- END IF
-
-END FUNCTION system_ischr
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_isreg(3f) - [M_system:QUERY_FILE] checks if argument is a regular file
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! elemental impure logical function system_isreg(pathname)
-!!
-!! character(len=*),intent(in) :: pathname
-!! logical :: system_isreg
-!!
-!!##DESCRIPTION
-!! The isreg(3f) function checks if path is a regular file
-!!
-!!##OPTIONS
-!! path a character string representing a pathname. Trailing spaces are ignored.
-!!
-!!##RETURN VALUE
-!! The system_isreg() function should always be successful and no
-!! return value is reserved to indicate an error.
-!!
-!!##ERRORS
-!! No errors are defined.
-!!
-!!##SEE ALSO
-!! system_islnk(3f), system_stat(3f), system_isdir(3f), system_perm(3f)
-!!
-!!##EXAMPLE
-!!
-!! check if filename is a regular file
-!!
-!! program simple
-!! use M_system, only : system_isreg
-!! implicit none
-!! integer :: i
-!! character(len=80),parameter :: names(*)=[ &
-!! '/tmp ', &
-!! 'test.txt ', &
-!! '~/.bashrc ', &
-!! '.bashrc ', &
-!! '. ']
-!! do i=1,size(names)
-!! write(*,*)' is ',trim(names(i)),' a regular file? ', system_isreg(names(i))
-!! enddo
-!! end program simple
-!!
-!! EXTENDED EXAMPLE
-!! list readable non-hidden regular files and links in current directory
-!!
-!! program demo_system_isreg
-!! use M_system, only : isreg=>system_isreg, islnk=>system_islnk
-!! use M_system, only : access=>system_access, R_OK
-!! use M_system, only : system_dir
-!! implicit none
-!! character(len=1024),allocatable :: filenames(:) ! BUG: cannot use len=: in gfortran 8.3.1
-!! logical,allocatable :: mymask(:)
-!! integer :: i
-!! ! list readable non-hidden regular files and links in current directory
-!! filenames=system_dir(pattern='*') ! make list of all files in current directory
-!! mymask= isreg(filenames).or.islnk(filenames) ! select regular files and links
-!! where(mymask) mymask=filenames(:)(1:1).ne.'.' ! skip hidden directories in those
-!! where(mymask) mymask=access(filenames,R_OK) ! select readable files in those
-!! filenames=pack(filenames,mask=mymask)
-!! write(*,'(a)')(trim(filenames(i)),i=1,size(filenames))
-!! end program demo_system_isreg
-ELEMENTAL impure FUNCTION system_isreg(pathname)
- IMPLICIT NONE
-
-! ident_7="@(#)M_system::system_isreg(3f): determine if pathname is a regular file"
-
- CHARACTER(len=*), INTENT(in) :: pathname
- LOGICAL :: system_isreg
-
- INTERFACE
- FUNCTION c_isreg(pathname) BIND(C, name="my_isreg") RESULT(c_ierr)
- IMPORT C_CHAR, C_INT
- CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: pathname(*)
- INTEGER(kind=C_INT) :: c_ierr
- END FUNCTION c_isreg
- END INTERFACE
-
- IF (c_isreg(str2_carr(TRIM(pathname))) .EQ. 1) THEN
- system_isreg = .TRUE.
- ELSE
- system_isreg = .FALSE.
- END IF
-
-END FUNCTION system_isreg
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_islnk(3f) - [M_system:QUERY_FILE] checks if argument is a link
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! elemental impure logical function system_islnk(pathname)
-!!
-!! character(len=*),intent(in) :: pathname
-!! logical :: system_islnk
-!!
-!!##DESCRIPTION
-!! The islnk(3f) function checks if path is a path to a link.
-!!
-!!##OPTIONS
-!! path a character string representing a link
-!! pathname. Trailing spaces are ignored.
-!!
-!!##RETURN VALUE
-!! system_islnk The system_islnk() function should always be
-!! successful and no return value is reserved to
-!! indicate an error.
-!!
-!!##ERRORS
-!! No errors are defined.
-!!
-!!##SEE ALSO
-!! system_isreg(3f), system_stat(3f), system_isdir(3f), system_perm(3f)
-!!
-!!##EXAMPLE
-!!
-!!
-!! Sample program:
-!!
-!! program demo_system_islnk
-!! use M_system, only : system_islnk
-!! implicit none
-!! integer :: i
-!! character(len=80),parameter :: names(*)=[ &
-!! '/tmp ', &
-!! '/tmp/NOTTHERE ', &
-!! '/usr/local ', &
-!! '. ', &
-!! 'link.test ', &
-!! 'PROBABLY_NOT ']
-!! do i=1,size(names)
-!! write(*,*)' is ',trim(names(i)),' a link? ', system_islnk(names(i))
-!! enddo
-!! end program demo_system_islnk
-!!
-!! Results:
-ELEMENTAL impure FUNCTION system_islnk(pathname)
- IMPLICIT NONE
-
-! ident_8="@(#)M_system::system_islnk(3f): determine if pathname is a link"
-
- CHARACTER(len=*), INTENT(in) :: pathname
- LOGICAL :: system_islnk
-
- INTERFACE
- FUNCTION c_islnk(pathname) BIND(C, name="my_islnk") RESULT(c_ierr)
- IMPORT C_CHAR, C_INT
- CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: pathname(*)
- INTEGER(kind=C_INT) :: c_ierr
- END FUNCTION c_islnk
- END INTERFACE
-
- IF (c_islnk(str2_carr(TRIM(pathname))) .EQ. 1) THEN
- system_islnk = .TRUE.
- ELSE
- system_islnk = .FALSE.
- END IF
-
-END FUNCTION system_islnk
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_isblk(3f) - [M_system:QUERY_FILE] checks if argument is a block device
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! elemental impure logical function system_isblk(pathname)
-!!
-!! character(len=*),intent(in) :: pathname
-!! logical :: system_isblk
-!!
-!!##DESCRIPTION
-!! The isblk(3f) function checks if path is a path to a block device.
-!!
-!!##OPTIONS
-!! path a character string representing a block device pathname. Trailing spaces are ignored.
-!!
-!!##RETURN VALUE
-!! The system_isblk() function should always be successful and no
-!! return value is reserved to indicate an error.
-!!
-!!##ERRORS
-!! No errors are defined.
-!!
-!!##SEE ALSO
-!! system_isreg(3f), system_stat(3f), system_isdir(3f), system_perm(3f)
-!!
-!!##EXAMPLE
-!!
-!! check if filename is a block device
-!!
-!! program demo_system_isblk
-!! use M_system, only : system_isblk
-!! implicit none
-!! integer :: i
-!! character(len=80),parameter :: names(*)=[ &
-!! '/tmp ', &
-!! '/tmp/NOTTHERE ', &
-!! '/usr/local ', &
-!! '. ', &
-!! 'block_device.tst', &
-!! 'PROBABLY_NOT ']
-!! do i=1,size(names)
-!! write(*,*)' is ',trim(names(i)),' a block device? ', system_isblk(names(i))
-!! enddo
-!! end program demo_system_isblk
-!!
-!! Results:
-ELEMENTAL impure FUNCTION system_isblk(pathname)
- IMPLICIT NONE
-
-! ident_9="@(#)M_system::system_isblk(3f): determine if pathname is a block device"
-
- CHARACTER(len=*), INTENT(in) :: pathname
- LOGICAL :: system_isblk
-
- INTERFACE
- FUNCTION c_isblk(pathname) BIND(C, name="my_isblk") RESULT(c_ierr)
- IMPORT C_CHAR, C_INT
- CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: pathname(*)
- INTEGER(kind=C_INT) :: c_ierr
- END FUNCTION c_isblk
- END INTERFACE
-
- IF (c_isblk(str2_carr(TRIM(pathname))) .EQ. 1) THEN
- system_isblk = .TRUE.
- ELSE
- system_isblk = .FALSE.
- END IF
-
-END FUNCTION system_isblk
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_isdir(3f) - [M_system:QUERY_FILE] checks if argument is a directory path
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! elemental impure logical function system_isdir(pathname)
-!!
-!! character(len=*),intent(in) :: pathname
-!! logical :: system_isdir
-!!
-!!##DESCRIPTION
-!! The system_isdir(3f) function checks if path is a directory.
-!!
-!!##OPTIONS
-!! path a character string representing a directory pathname. Trailing spaces are ignored.
-!!
-!!##RETURN VALUE
-!! The system_isdir() function should always be successful and no
-!! return value is reserved to indicate an error.
-!!
-!!##ERRORS
-!! No errors are defined.
-!!
-!!##SEE ALSO
-!! system_islnk(3f), system_stat(3f), isreg(3f), system_perm(3f)
-!!
-!!##EXAMPLE
-!!
-!!
-!! Sample program
-!!
-!! program demo_system_isdir
-!! use M_system, only : system_isdir
-!! use M_system, only : access=>system_access, R_OK
-!! use M_system, only : system_dir
-!! implicit none
-!! character(len=1024),allocatable :: filenames(:) ! BUG: cannot use len=: in gfortran 8.3.1
-!! integer :: i
-!! character(len=80),parameter :: names(*)=[ &
-!! & '/tmp ', &
-!! & '/tmp/NOTTHERE ', &
-!! & '/usr/local ', &
-!! & '. ', &
-!! & 'PROBABLY_NOT ']
-!! !
-!! do i=1,size(names)
-!! write(*,*)' is ',trim(names(i)),' a directory? ', system_isdir(names(i))
-!! enddo
-!! !
-!! ! EXTENDED EXAMPLE: list readable non-hidden directories in current directory
-!! filenames=system_dir(pattern='*') ! list all files in current directory
-!! ! select readable directories
-!! filenames=pack(filenames,system_isdir(filenames).and.access(filenames,R_OK))
-!! filenames=pack(filenames,filenames(:)(1:1) .ne.'.') ! skip hidden directories
-!! do i=1,size(filenames)
-!! write(*,*)' ',trim(filenames(i)),' is a directory'
-!! enddo
-!! !
-!! end program demo_system_isdir
-!!
-!!
-!! Results:
-!!
-!! is /tmp a directory? T
-!! is /tmp/NOTTHERE a directory? F
-!! is /usr/local a directory? T
-!! is . a directory? T
-!! is PROBABLY_NOT a directory? F
-!!
-!! TEST is a directory
-!! EXAMPLE is a directory
-ELEMENTAL impure FUNCTION system_isdir(dirname)
- IMPLICIT NONE
-
-! ident_10="@(#)M_system::system_isdir(3f): determine if DIRNAME is a directory name"
-
- CHARACTER(len=*), INTENT(in) :: dirname
- LOGICAL :: system_isdir
-
- INTERFACE
- FUNCTION c_isdir(dirname) BIND(C, name="my_isdir") RESULT(c_ierr)
- IMPORT C_CHAR, C_INT
- CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: dirname(*)
- INTEGER(kind=C_INT) :: c_ierr
- END FUNCTION c_isdir
- END INTERFACE
-
- IF (c_isdir(str2_carr(TRIM(dirname))) .EQ. 1) THEN
- system_isdir = .TRUE.
- ELSE
- system_isdir = .FALSE.
- END IF
-
-END FUNCTION system_isdir
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_chown(3f) - [M_system:FILE_SYSTEM] change file owner and group
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! elemental impure logical function system_chown(path,owner,group)
-!!
-!! character(len=*),intent(in) :: path
-!! integer,intent(in) :: owner
-!! integer,intent(in) :: group
-!!
-!!##DESCRIPTION
-!! The chown(3f) function changes owner and group of a file
-!!
-!! The path argument points to a pathname naming a file. The
-!! user ID and group ID of the named file shall be set to the numeric
-!! values contained in owner and group, respectively.
-!!
-!! Only processes with an effective user ID equal to the user ID of
-!! the file or with appropriate privileges may change the ownership
-!! of a file.
-!!
-!!##OPTIONS
-!! path a character string representing a file pathname.
-!! Trailing spaces are ignored.
-!! owner UID of owner that ownership is to be changed to
-!! group GID of group that ownership is to be changed to
-!!
-!!##RETURN VALUE
-!! The system_chown(3f) function should return zero 0 if successful.
-!! Otherwise, these functions shall return 1 and set errno to
-!! indicate the error. If 1 is returned, no changes are made in
-!! the user ID and group ID of the file.
-!!
-!!##EXAMPLE
-!!
-!!
-!! Sample program:
-!!
-!! program demo_system_chown
-!! use M_system, only : system_chown
-!! use M_system, only : system_getuid
-!! use M_system, only : system_getgid
-!! use M_system, only : system_perror
-!! implicit none
-!! integer :: i
-!! character(len=80),parameter :: names(*)=[character(len=80) :: 'myfile1','/usr/local']
-!! do i=1,size(names)
-!! if(.not. system_chown(&
-!! & trim(names(i)), &
-!! & system_getuid(), &
-!! & system_getgid()) &
-!! )then
-!! call system_perror('*demo_system_chown* '//trim(names(i)))
-!! endif
-!! enddo
-!! end program demo_system_chown
-ELEMENTAL impure FUNCTION system_chown(dirname, owner, group)
- IMPLICIT NONE
-
-! ident_11="@(#)M_system::system_chown(3f): change owner and group of a file relative to directory file descriptor"
-
- CHARACTER(len=*), INTENT(in) :: dirname
- INTEGER, INTENT(in) :: owner
- INTEGER, INTENT(in) :: group
- LOGICAL :: system_chown
-
-! int chown(const char *path, uid_t owner, gid_t group);
- INTERFACE
- function c_chown(c_dirname,c_owner,c_group) bind (C,name="my_chown") result (c_ierr)
- IMPORT C_CHAR, C_INT
- CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: c_dirname(*)
- INTEGER(kind=C_INT), INTENT(in), VALUE :: c_owner
- INTEGER(kind=C_INT), INTENT(in), VALUE :: c_group
- INTEGER(kind=C_INT) :: c_ierr
- END FUNCTION c_chown
- END INTERFACE
-
- if(c_chown(str2_carr(trim(dirname)),int(owner,kind=c_int),int(group,kind=c_int)).eq.1)then
- system_chown = .TRUE.
- ELSE
- system_chown = .FALSE.
- END IF
-
-END FUNCTION system_chown
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_cpu_time(3f) - [M_system] get processor time by calling times(3c)
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! subroutine system_cpu_time(c_user, c_system, c_total)
-!!
-!! real,intent(out) :: c_total
-!! real,intent(out) :: c_user
-!! real,intent(out) :: c_system
-!!
-!!##DESCRIPTION
-!!
-!!##OUTPUT
-!! c_total total processor time ( c_user + c_system )
-!! c_user processor user time
-!! c_system processor system time
-!!
-!!##ERRORS
-!! No errors are defined.
-!!
-!!##EXAMPLES
-!!
-!!
-!! Sample program:
-!!
-!! program demo_system_cpu_time
-!!
-!! use M_system, only : system_cpu_time
-!! use ISO_C_BINDING, only : c_float
-!! implicit none
-!! real :: user_start, system_start, total_start
-!! real :: user_finish, system_finish, total_finish
-!! integer :: i
-!! integer :: itimes=1000000
-!! real :: value
-!!
-!! call system_cpu_time(total_start,user_start,system_start)
-!!
-!! value=0.0
-!! do i=1,itimes
-!! value=sqrt(real(i)+value)
-!! enddo
-!! write(10,*)value
-!! flush(10)
-!! write(*,*)'average sqrt value=',value/itimes
-!! call system_cpu_time(total_finish,user_finish,system_finish)
-!! write(*,*)'USER ......',user_finish-user_start
-!! write(*,*)'SYSTEM ....',system_finish-system_start
-!! write(*,*)'TOTAL .....',total_finish-total_start
-!!
-!! end program demo_system_cpu_time
-!!
-!! Typical Results:
-!-! GET ERRORS ABOUT MISSING LONGEST_ENV_VARIABLE IN GFORTRAN 6.4.0 IF JUST USE INTERFACE INSTEAD OF MAKING SUBROUTINE
-!-!interface
-!-! subroutine system_cpu_time(c_total,c_user,c_system) bind (C,NAME='my_cpu_time')
-!-! import c_float
-!-! real(kind=c_float) :: c_user,c_system,c_total
-!-! end subroutine system_cpu_time
-!-!end interface
-SUBROUTINE system_cpu_time(total, user, system)
-
- REAL, INTENT(out) :: user, system, total
- REAL(kind=C_FLOAT) :: c_user, c_system, c_total
-
- INTERFACE
- SUBROUTINE c_cpu_time(c_total, c_user, c_system) BIND(C, NAME='my_cpu_time')
- IMPORT C_FLOAT
- REAL(kind=C_FLOAT) :: c_total, c_user, c_system
- END SUBROUTINE c_cpu_time
- END INTERFACE
-
- CALL c_cpu_time(c_total, c_user, c_system)
- user = c_user
- system = c_system
- total = c_total
-END SUBROUTINE system_cpu_time
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_link(3f) - [M_system:FILE_SYSTEM] link one file to another
-!! file relative to two directory file descriptors
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! elemental impure integer function link(oldpath,newpath);
-!!
-!! character(len=*),intent(in) :: oldpath
-!! character(len=*),intent(in) :: newpath
-!!
-!!##DESCRIPTION
-!! The link() function shall create a new link (directory entry)
-!! for the existing file, path1.
-!!
-!! The path1 argument points to a pathname naming an existing
-!! file. The path2 argument points to a pathname naming the
-!! new directory entry to be created. The link() function shall
-!! atomically create a new link for the existing file and the link
-!! count of the file shall be incremented by one.
-!!
-!! If path1 names a directory, link() shall fail unless the process
-!! has appropriate privileges and the implementation supports using
-!! link() on directories.
-!!
-!! If path1 names a symbolic link, it is implementation-defined
-!! whether link() follows the symbolic link, or creates a new link
-!! to the symbolic link itself.
-!!
-!! Upon successful completion, link() shall mark for update the
-!! last file status change timestamp of the file. Also, the last
-!! data modification and last file status change timestamps of the
-!! directory that contains the new entry shall be marked for update.
-!!
-!! If link() fails, no link shall be created and the link count of
-!! the file shall remain unchanged.
-!!
-!! The implementation may require that the calling process has
-!! permission to access the existing file.
-!!
-!! The linkat() function shall be equivalent to the link() function
-!! except that symbolic links shall be handled as specified by the
-!! value of flag (see below) and except in the case where either path1
-!! or path2 or both are relative paths. In this case a relative path
-!! path1 is interpreted relative to the directory associated with
-!! the file descriptor fd1 instead of the current working directory
-!! and similarly for path2 and the file descriptor fd2. If the
-!! file descriptor was opened without O_SEARCH, the function shall
-!! check whether directory searches are permitted using the current
-!! permissions of the directory underlying the file descriptor. If
-!! the file descriptor was opened with O_SEARCH, the function shall
-!! not perform the check.
-!!
-!! Values for flag are constructed by a bitwise-inclusive OR of
-!! flags from the following list, defined in :
-!!
-!! AT_SYMLINK_FOLLOW
-!! If path1 names a symbolic link, a new link for the target
-!! of the symbolic link is created.
-!!
-!! If linkat() is passed the special value AT_FDCWD in the fd1 or
-!! fd2 parameter, the current working directory shall be used for the
-!! respective path argument. If both fd1 and fd2 have value AT_FDCWD,
-!! the behavior shall be identical to a call to link(), except that
-!! symbolic links shall be handled as specified by the value of flag.
-!!
-!! Some implementations do allow links between file systems.
-!!
-!! If path1 refers to a symbolic link, application developers should
-!! use linkat() with appropriate flags to select whether or not the
-!! symbolic link should be resolved.
-!!
-!! If the AT_SYMLINK_FOLLOW flag is clear in the flag argument and
-!! the path1 argument names a symbolic link, a new link is created
-!! for the symbolic link path1 and not its target.
-!!
-!!##RETURN VALUE
-!! Upon successful completion, these functions shall return
-!! 0. Otherwise, these functions shall return -1 and set errno to
-!! indicate the error.
-!!
-!!##EXAMPLES
-!!
-!! Creating a Link to a File
-!!
-!! program demo_system_link
-!! use M_system, only : system_link, system_perror
-!! integer :: ierr
-!! ierr = system_link('myfile1','myfile2')
-!! if(ierr.ne.0)then
-!! call system_perror('*demo_system_link*')
-!! endif
-!! end program demo_system_link
-ELEMENTAL impure FUNCTION system_link(oldname, newname) RESULT(ierr)
-
-! ident_12="@(#)M_system::system_link(3f): call link(3c) to create a file link"
-
- CHARACTER(len=*), INTENT(in) :: oldname
- CHARACTER(len=*), INTENT(in) :: newname
- INTEGER :: ierr
- INTEGER(kind=C_INT) :: c_ierr
-
- INTERFACE
- FUNCTION c_link(c_oldname, c_newname) BIND(C, name="link") RESULT(c_ierr)
- IMPORT C_CHAR, C_INT
- CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: c_oldname(*)
- CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: c_newname(*)
- INTEGER(kind=C_INT) :: c_ierr
- END FUNCTION c_link
- END INTERFACE
-
- c_ierr = c_link(str2_carr(TRIM(oldname)), str2_carr(TRIM(newname)))
- ierr = c_ierr
-
-END FUNCTION system_link
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_unlink(3f) - [M_system:FILE_SYSTEM] remove a directory
-!! entry relative to directory file descriptor
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! elemental impure integer function unlink(path);
-!!
-!! character(len=*) :: path
-!!
-!!##DESCRIPTION
-!! The unlink() function shall remove a link to a file. If path names a
-!! symbolic link, unlink() shall remove the symbolic link named by path
-!! and shall not affect any file or directory named by the contents of
-!! the symbolic link. Otherwise, unlink() shall remove the link named by
-!! the pathname pointed to by path and shall decrement the link count of
-!! the file referenced by the link.
-!!
-!! When the files link count becomes 0 and no process has the file open,
-!! the space occupied by the file shall be freed and the file shall no
-!! longer be accessible. If one or more processes have the file open when
-!! the last link is removed, the link shall be removed before unlink()
-!! returns, but the removal of the file contents shall be postponed until
-!! all references to the file are closed.
-!!
-!! The path argument shall not name a directory unless the process has
-!! appropriate privileges and the implementation supports using unlink()
-!! on directories.
-!!
-!! Upon successful completion, unlink() shall mark for update the last
-!! data modification and last file status change timestamps of the parent
-!! directory. Also, if the file link count is not 0, the last file status
-!! change timestamp of the file shall be marked for update.
-!!
-!! Values for flag are constructed by a bitwise-inclusive OR of flags from
-!! the following list, defined in :
-!!
-!! AT_REMOVEDIR
-!!
-!! Remove the directory entry specified by fd and path as a
-!! directory, not a normal file.
-!!
-!!##RETURN VALUE
-!!
-!! Upon successful completion, these functions shall return 0. Otherwise,
-!! these functions shall return -1 and set errno to indicate the error. If
-!! -1 is returned, the named file shall not be changed.
-!!
-!!##EXAMPLES
-!!
-!! Removing a link to a file
-!!
-!! program demo_system_unlink
-!! use M_system, only : system_unlink, system_perror
-!! integer :: ierr
-!! ierr = system_unlink('myfile1')
-!! if(ierr.ne.0)then
-!! call system_perror('*demo_system_unlink*')
-!! endif
-!! end program demo_system_unlink
-ELEMENTAL impure FUNCTION system_unlink(fname) RESULT(ierr)
-
-! ident_13="@(#)M_system::system_unlink(3f): call unlink(3c) to rm file link"
-
- CHARACTER(len=*), INTENT(in) :: fname
- INTEGER :: ierr
-
- INTERFACE
- FUNCTION c_unlink(c_fname) BIND(C, name="unlink") RESULT(c_ierr)
- IMPORT C_CHAR, C_INT
- CHARACTER(kind=C_CHAR, len=1) :: c_fname(*)
- INTEGER(kind=C_INT) :: c_ierr
- END FUNCTION c_unlink
- END INTERFACE
- ierr = c_unlink(str2_carr(TRIM(fname)))
-END FUNCTION system_unlink
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_setumask(3f) - [M_system:FILE_SYSTEM] set the file mode creation umask
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! integer function system_setumask(new_umask) result (old_umask)
-!!
-!! integer,intent(in) :: new_umask
-!! integer(kind=c_int) :: umask_c
-!!
-!!##DESCRIPTION
-!! The system_umask(3f) function sets the file mode creation mask of the
-!! process to cmask and return the previous value of the mask. Only
-!! the file permission bits of cmask (see ) are used;
-!! the meaning of the other bits is implementation-defined.
-!!
-!! The file mode creation mask of the process is used to turn off
-!! permission bits in the mode argument supplied during calls to
-!! the following functions:
-!!
-!! * open(), openat(), creat(), mkdir(), mkdirat(), mkfifo(), and mkfifoat()
-!! * mknod(), mknodat()
-!! * mq_open()
-!! * sem_open()
-!!
-!! Bit positions that are set in cmask are cleared in the mode of
-!! the created file.
-!!
-!!##RETURN VALUE
-!! The file permission bits in the value returned by umask() shall be
-!! the previous value of the file mode creation mask. The state of any
-!! other bits in that value is unspecified, except that a subsequent
-!! call to umask() with the returned value as cmask shall leave the
-!! state of the mask the same as its state before the first call,
-!! including any unspecified use of those bits.
-!!
-!!##ERRORS
-!! No errors are defined.
-!!
-!!##EXAMPLE
-!!
-!! Sample program
-!!
-!! program demo_setumask
-!! use M_system, only : system_getumask, system_setumask
-!! integer :: newmask
-!! integer :: i
-!! integer :: old_umask
-!! write(*,101)(system_getumask(),i=1,4)
-!! 101 format(1x,i0,1x,"O'",o4.4,"'",1x,'Z"',z0,"'",1x,"B'",b12.12,"'")
-!! newmask=63
-!! old_umask=system_setumask(newmask)
-!! write(*,*)'NEW'
-!! write(*,101)(system_getumask(),i=1,4)
-!! end program demo_setumask
-!!
-!! Expected output
-!!
-!! 18 O'022' Z"12' B'000010010"
-!! NEW
-!! 63 O'077' Z"3F' B'000111111"
-INTEGER FUNCTION system_setumask(umask_value) RESULT(old_umask)
- INTEGER, INTENT(in) :: umask_value
- INTEGER(kind=C_INT) :: umask_c
-
- umask_c = umask_value
- old_umask = system_umask(umask_c) ! set current umask
-
-END FUNCTION system_setumask
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_getumask(3f) - [M_system:QUERY_FILE] get current umask
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! integer function system_getumask() result (umask_value)
-!!##DESCRIPTION
-!! The return value from getumask(3f) is the value of the file
-!! creation mask, obtained by using umask(3c).
-!!##EXAMPLE
-!!
-!! Sample program
-!!
-!! program demo_getumask
-!! use M_system, only : system_getumask, system_setumask
-!! integer :: i
-!! write(*,101)(system_getumask(),i=1,4)
-!! 101 format(1x,i0,1x,"O'",o4.4,"'",1x,'Z"',z0,"'",1x,"B'",b12.12,"'")
-!! end program demo_getumask
-!!
-!! Expected output
-!!
-!! 18 O'022' Z"12' B'000010010"
-INTEGER FUNCTION system_getumask() RESULT(umask_value)
-! The return value from umask() is just the previous value of the file
-! creation mask, so that this system call can be used both to get and
-! set the required values. Sadly, however, there is no way to get the old
-! umask value without setting a new value at the same time.
-
-! This means that in order just to see the current value, it is necessary
-! to execute a piece of code like the following function:
- INTEGER :: idum
- INTEGER(kind=C_INT) :: old_umask
- old_umask = system_umask(0_C_INT) ! get current umask but by setting umask to 0 (a conservative mask so no vulnerability is open)
- idum = system_umask(old_umask) ! set back to original mask
- umask_value = old_umask
-END FUNCTION system_getumask
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! perror(3f) - [M_system:ERROR_PROCESSING] print error message for last C error on stderr
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! subroutine system_perror(prefix)
-!!
-!! character(len=*),intent(in) :: prefix
-!!
-!!##DESCRIPTION
-!! Use system_perror(3f) to print an error message on stderr
-!! corresponding to the current value of the C global variable errno.
-!! Unless you use NULL as the argument prefix, the error message will
-!! begin with the prefix string, followed by a colon and a space
-!! (:). The remainder of the error message produced is one of the
-!! strings described for strerror(3c).
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_perror
-!! use M_system, only : system_perror,system_rmdir
-!! implicit none
-!! character(len=:),allocatable :: DIRNAME
-!! DIRNAME='/NOT/THERE/OR/ANYWHERE'
-!! ! generate an error with a routine that supports errno and perror(3c)
-!! if(system_rmdir(DIRNAME).ne.0)then
-!! call system_perror('*demo_system_perror*:'//DIRNAME)
-!! endif
-!! write(*,'(a)')"That is all Folks!"
-!! end program demo_system_perror
-!!
-!! Expected results:
-!!
-!! *demo_system_perror*:/NOT/THERE/OR/ANYWHERE: No such file or directory
-!! That is all Folks!
-SUBROUTINE system_perror(prefix)
- USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: ERROR_UNIT, INPUT_UNIT, OUTPUT_UNIT ! access computing environment
-
-! ident_14="@(#)M_system::system_perror(3f): call perror(3c) to display error message"
-
- CHARACTER(len=*), INTENT(in) :: prefix
- INTEGER :: ios
-
- INTERFACE
- SUBROUTINE c_perror(c_prefix) BIND(C, name="perror")
- IMPORT C_CHAR
- CHARACTER(kind=C_CHAR) :: c_prefix(*)
- END SUBROUTINE c_perror
- END INTERFACE
-
- FLUSH (unit=ERROR_UNIT, iostat=ios)
- FLUSH (unit=OUTPUT_UNIT, iostat=ios)
- FLUSH (unit=INPUT_UNIT, iostat=ios)
- CALL c_perror(str2_carr((TRIM(prefix))))
- CALL c_flush()
-
-END SUBROUTINE system_perror
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_chdir(3f) - [M_system_FILE_SYSTEM] call chdir(3c) from Fortran to change working directory
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! subroutine system_chdir(path, err)
-!!
-!! character(len=*) :: path
-!! integer, optional, intent(out) :: err
-!!
-!!##DESCRIPTION
-!!
-!! system_chdir(3f) changes the current working directory of the calling
-!! process to the directory specified in path. The current working
-!! directory is the starting point for interpreting relative pathnames
-!! (those not starting with '/').
-!!
-!!##RETURN VALUE
-!!
-!! On success, zero is returned. On error, -1 is returned, and errno is
-!! set appropriately.
-!!
-!!
-!! Depending on the file system, other errors can be returned. The more
-!! general errors for chdir() are listed below, by their C definitions:
-!!
-!! Errors
-!! EACCES Search permission is denied for one of the components of path.
-!! (See also path_resolution(7).)
-!! EFAULT path points outside your accessible address space.
-!! EIO An I/O error occurred.
-!! ELOOP Too many symbolic links were encountered in resolving path.
-!! ENAMETOOLONG path is too long.
-!! ENOENT The file does not exist.
-!! ENOMEM Insufficient kernel memory was available.
-!! ENOTDIR A component of path is not a directory.
-!!
-!!##SEE ALSO
-!!
-!! chroot(2), getcwd(3), path_resolution(7)
-!!
-!!##EXAMPLE
-!!
-!! Change working directory from Fortran
-!!
-!! program demo_system_chdir
-!! use M_system, only : system_chdir
-!! implicit none
-!! integer :: ierr
-!!
-!! call execute_command_line('pwd')
-!! call system_chdir('/tmp',ierr)
-!! call execute_command_line('pwd')
-!! write(*,*)'*CHDIR TEST* IERR=',ierr
-!!
-!! end program demo_system_chdir
-!!
-!!##RESULTS:
-!! Sample run output:
-!!
-!! /home/urbanjs/V600
-!! /tmp
-!! *CHDIR TEST* IERR= 0
-SUBROUTINE system_chdir(path, err)
-
-! ident_15="@(#)M_system::system_chdir(3f): call chdir(3c)"
-
- CHARACTER(len=*) :: path
- INTEGER, OPTIONAL, INTENT(out) :: err
-
- INTERFACE
- INTEGER(kind=C_INT) FUNCTION c_chdir(c_path) BIND(C, name="chdir")
- IMPORT C_CHAR, C_INT
- CHARACTER(kind=C_CHAR) :: c_path(*)
- END FUNCTION
- END INTERFACE
- INTEGER :: loc_err
-!-----------------------------------------------------------------------------------------------------------------------------------
- loc_err = c_chdir(str2_carr(TRIM(path)))
- IF (PRESENT(err)) THEN
- err = loc_err
- END IF
-END SUBROUTINE system_chdir
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_remove(3f) - [M_system_FILE_SYSTEM] call remove(3c) to remove file
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! elemental impure function system_remove(path) result(err)
-!!
-!! character(*),intent(in) :: path
-!! integer(c_int) :: err
-!!
-!!##DESCRIPTION
-!! Fortran supports scratch files via the OPEN(3c) command; but does
-!! not otherwise allow for removing files. The system_remove(3f) command
-!! allows for removing files by name that the user has the authority to
-!! remove by calling the C remove(3c) function.
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_remove
-!! use M_system, only : system_remove
-!! character(len=*),parameter :: FILE='MyJunkFile.txt'
-!! integer :: ierr
-!! write(*,*)'BEFORE CREATED '//FILE
-!! call execute_command_line('ls -l '//FILE)
-!! write(*,*)
-!!
-!! ! note intentionally causes error if file exists
-!! open(unit=10,file=FILE,status='NEW')
-!! write(*,*)'AFTER OPENED '//FILE
-!! call execute_command_line('ls -l '//FILE)
-!! write(*,*)
-!!
-!! write(10,'(a)') 'This is a file I want to delete'
-!! close(unit=10)
-!! write(*,*)'AFTER CLOSED '
-!! call execute_command_line('ls -l '//FILE)
-!! write(*,*)
-!!
-!! ierr=system_remove(FILE)
-!! write(*,*)'AFTER REMOVED',IERR
-!! call execute_command_line('ls -l '//FILE)
-!! write(*,*)
-!!
-!! end program demo_system_remove
-!!
-!! Expected Results:
-!!
-!! > BEFORE CREATED MyJunkFile.txt
-!! > ls: cannot access 'MyJunkFile.txt': No such file or directory
-!! >
-!! > AFTER OPENED MyJunkFile.txt
-!! > -rw-r--r-- 1 JSU None 0 Nov 19 19:32 MyJunkFile.txt
-!! >
-!! > AFTER CLOSED
-!! > -rw-r--r-- 1 JSU None 32 Nov 19 19:32 MyJunkFile.txt
-!! >
-!! > AFTER REMOVED 0
-!! > ls: cannot access 'MyJunkFile.txt': No such file or directory
-!!
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-ELEMENTAL impure FUNCTION system_remove(path) RESULT(err)
-
-! ident_16="@(#)M_system::system_remove(3f): call remove(3c) to remove file"
-
- CHARACTER(*), INTENT(in) :: path
- INTEGER(C_INT) :: err
-
- INTERFACE
- FUNCTION c_remove(c_path) BIND(c, name="remove") RESULT(c_err)
- IMPORT C_CHAR, C_INT
- CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: c_path(*)
- INTEGER(C_INT) :: c_err
- END FUNCTION
- END INTERFACE
-!-----------------------------------------------------------------------------------------------------------------------------------
- err = c_remove(str2_carr(TRIM(path)))
-END FUNCTION system_remove
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_rename(3f) - [M_system_FILE_SYSTEM] call rename(3c) to rename a system file
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! function system_rename(input,output) result(ierr)
-!!
-!! character(*),intent(in) :: input,output
-!! integer :: ierr
-!!##DESCRIPTION
-!! Rename a file by calling rename(3c). It is not recommended that the
-!! rename occur while either filename is being used on a file currently
-!! OPEN(3f) by the program.
-!!
-!! Both the old and new names must be on the same device.
-!!##OPTIONS
-!! INPUT system filename of an existing file to rename
-!! OUTPUT system filename to be created or overwritten by INPUT file.
-!! Must be on the same device as the INPUT file.
-!!##RETURNS
-!! IERR zero (0) if no error occurs. If not zero a call to
-!! system_errno(3f) or system_perror(3f) is supported
-!! to diagnose error
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_rename
-!! use M_system, only : system_rename
-!! use M_system, only : system_remove
-!! use M_system, only : system_perror
-!! implicit none
-!! character(len=256) :: string
-!! integer :: ios, ierr
-!!
-!! ! try to remove junk files just in case
-!! ierr=system_remove('_scratch_file_')
-!! write(*,'(a,i0)') 'should not be zero ',ierr
-!! call system_perror('*demo_system_rename*')
-!! ierr=system_remove('_renamed_scratch_file_')
-!! write(*,'(a,i0)') 'should not be zero ',ierr
-!! call system_perror('*demo_system_rename*')
-!!
-!! ! create scratch file to rename
-!! open(unit=10,file='_scratch_file_',status='new')
-!! write(10,'(a)') 'Test by renaming "_scratch_file_" to "_renamed_scratch_file_"'
-!! write(10,'(a)') 'IF YOU SEE THIS ON OUTPUT THE RENAME WORKED'
-!! close(10)
-!! ! rename scratch file
-!! ierr=system_rename('_scratch_file_','_renamed_scratch_file_')
-!! if(ierr.ne.0)then
-!! write(*,*)'ERROR RENAMING FILE ',ierr
-!! endif
-!! ! read renamed file
-!! open(unit=11,file='_renamed_scratch_file_',status='old')
-!! INFINITE: do
-!! read(11,'(a)',iostat=ios)string
-!! if(ios.ne.0)exit INFINITE
-!! write(*,'(a)')trim(string)
-!! enddo INFINITE
-!! close(unit=11)
-!!
-!! ! clean up
-!! ierr=system_remove('_scratch_file_')
-!! write(*,'(a,i0)') 'should not be zero ',ierr
-!! ierr=system_remove('_renamed_scratch_file_')
-!! write(*,'(a,i0)') 'should be zero ',ierr
-!!
-!! end program demo_system_rename
-!!
-!! Expected output:
-!!
-!! > should not be zero -1
-!! > *demo_system_rename*: No such file or directory
-!! > should not be zero -1
-!! > *demo_system_rename*: No such file or directory
-!! > Test by renaming "_scratch_file_" to "_renamed_scratch_file_"
-!! > IF YOU SEE THIS ON OUTPUT THE RENAME WORKED
-!! > should not be zero -1
-!! > should be zero 0
-!!
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-FUNCTION system_rename(input, output) RESULT(ierr)
-
-! ident_17="@(#)M_system::system_rename(3f): call rename(3c) to change filename"
-
- CHARACTER(*), INTENT(in) :: input, output
- INTEGER :: ierr
- INTERFACE
- FUNCTION c_rename(c_input, c_output) BIND(c, name="rename") RESULT(c_err)
- IMPORT C_CHAR, C_INT
- CHARACTER(kind=C_CHAR), INTENT(in) :: c_input(*)
- CHARACTER(kind=C_CHAR), INTENT(in) :: c_output(*)
- INTEGER(C_INT) :: c_err
- END FUNCTION
- END INTERFACE
-!-----------------------------------------------------------------------------------------------------------------------------------
- ierr = c_rename(str2_carr(TRIM(input)), str2_carr(TRIM(output)))
-END FUNCTION system_rename
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_chmod(3f) - [M_system_FILE_SYSTEM] call chmod(3c) to change
-!! permission mode of a file relative to directory file descriptor
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! function system_chmod(filename,mode) result(ierr)
-!!
-!! character(len=*),intent(in) :: filename
-!! integer,value,intent(in) :: mode
-!! integer :: ierr
-!!
-!!##DESCRIPTION
-!! The system_chmod(3f) function shall change UID, _ISGID, S_ISVTX, and the
-!! file permission bits of the file named by the pathname pointed
-!! to by the path argument to the corresponding bits in the mode
-!! argument. The application shall ensure that the effective user
-!! ID of the process matches the owner of the file or the process
-!! has appropriate privileges in order to do this.
-!!
-!! S_ISUID, S_ISGID, S_ISVTX, and the file permission bits are
-!! described in .
-!!
-!! If the calling process does not have appropriate privileges,
-!! and if the group ID of the file does not match the effective
-!! group ID or one of the supplementary group IDs and if the file
-!! is a regular file, bit S_ISGID (set-group-ID on execution) in the
-!! file mode shall be cleared upon successful return from chmod().
-!!
-!! Additional implementation-defined restrictions may cause the
-!! S_ISUID and S_ISGID bits in mode to be ignored.
-!!
-!! Upon successful completion, system_chmod() marks for update the
-!! last file status change timestamp of the file.
-!!
-!! Values for flag are constructed by a bitwise-inclusive OR of
-!! flags from the following list, defined in :
-!!
-!! AT_SYMLINK_NOFOLLOW
-!! If path names a symbolic link, then the mode of the symbolic
-!! link is changed.
-!!
-!!
-!!##RETURN VALUE
-!! Upon successful completion, system_chmod(3f) returns 0.
-!! Otherwise, it returns -1 and sets errno to indicate the error. If
-!! -1 is returned, no change to the file mode occurs.
-!!
-!!##EXAMPLES
-!!
-!! Sample program:
-!!
-!! program demo_system_chmod
-!! use M_system, only : system_chmod
-!! use M_system, only : system_stat
-!! use M_system, only : R_GRP,R_OTH,R_USR, RWX_G, RWX_U, W_OTH, X_GRP
-!! !use M_system, only : RWX_O, W_GRP,W_USR,X_OTH,X_USR
-!! !use M_system, only : DEFFILEMODE, ACCESSPERMS
-!! use,intrinsic :: iso_fortran_env, only : int64
-!! implicit none
-!! integer :: ierr
-!! integer :: status
-!! integer(kind=int64) :: buffer(13)
-!! !Setting Read Permissions for User, Group, and Others
-!! ! The following example sets read permissions for the owner, group, and others.
-!! open(file='_test1',unit=10)
-!! write(10,*)'TEST FILE 1'
-!! close(unit=10)
-!! ierr=system_chmod('_test1', IANY([R_USR,R_GRP,R_OTH]))
-!!
-!! !Setting Read, Write, and Execute Permissions for the Owner Only
-!! ! The following example sets read, write, and execute permissions for the owner, and no permissions for group and others.
-!! open(file='_test2',unit=10)
-!! write(10,*)'TEST FILE 2'
-!! close(unit=10)
-!! ierr=system_chmod('_test2', RWX_U)
-!!
-!! !Setting Different Permissions for Owner, Group, and Other
-!! ! The following example sets owner permissions for CHANGEFILE to read, write, and execute, group permissions to read and
-!! ! execute, and other permissions to read.
-!! open(file='_test3',unit=10)
-!! write(10,*)'TEST FILE 3'
-!! close(unit=10)
-!! ierr=system_chmod('_test3', IANY([RWX_U,R_GRP,X_GRP,R_OTH]));
-!!
-!! !Setting and Checking File Permissions
-!! ! The following example sets the file permission bits for a file named /home/cnd/mod1, then calls the stat() function to
-!! ! verify the permissions.
-!!
-!! ierr=system_chmod("home/cnd/mod1", IANY([RWX_U,RWX_G,R_OTH,W_OTH]))
-!! call system_stat("home/cnd/mod1", buffer,status)
-!!
-!! ! In order to ensure that the S_ISUID and S_ISGID bits are set, an application requiring this should use stat() after a
-!! ! successful chmod() to verify this.
-!!
-!! ! Any files currently open could possibly become invalid if the mode
-!! ! of the file is changed to a value which would deny access to
-!! ! that process.
-!!
-!! end program demo_system_chmod
-!!
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-FUNCTION system_chmod(filename, mode) RESULT(ierr)
- CHARACTER(len=*), INTENT(in) :: filename
- INTEGER, VALUE, INTENT(in) :: mode
- INTEGER :: ierr
- INTERFACE
- FUNCTION c_chmod(c_filename, c_mode) BIND(c, name="chmod") RESULT(c_err)
- IMPORT C_CHAR, C_INT
- CHARACTER(kind=C_CHAR), INTENT(in) :: c_filename(*)
- INTEGER(C_INT), VALUE, INTENT(in) :: c_mode
- INTEGER(C_INT) :: c_err
- END FUNCTION
- END INTERFACE
-!-----------------------------------------------------------------------------------------------------------------------------------
- ierr = c_chmod(str2_carr(TRIM(filename)), INT(mode, KIND(0_C_INT)))
-END FUNCTION system_chmod
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_getcwd(3f) - [M_system:QUERY_FILE] call getcwd(3c) to get the pathname of the current working directory
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! subroutine system_getcwd(output,ierr)
-!!
-!! character(len=:),allocatable,intent(out) :: output
-!! integer,intent(out) :: ierr
-!!##DESCRIPTION
-!! system_getcwd(3f) calls the C routine getcwd(3c) to obtain the absolute pathname of the current working directory.
-!!
-!!##RETURN VALUE
-!! OUTPUT The absolute pathname of the current working directory
-!! The pathname shall contain no components that are dot or dot-dot,
-!! or are symbolic links.
-!! IERR is not zero if an error occurs.
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_getcwd
-!! use M_system, only : system_getcwd
-!! implicit none
-!! character(len=:),allocatable :: dirname
-!! integer :: ierr
-!! call system_getcwd(dirname,ierr)
-!! if(ierr.eq.0)then
-!! write(*,*)'CURRENT DIRECTORY ',trim(dirname)
-!! else
-!! write(*,*)'ERROR OBTAINING CURRENT DIRECTORY NAME'
-!! endif
-!! end program demo_system_getcwd
-!!
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-SUBROUTINE system_getcwd(output, ierr)
-
-! ident_18="@(#)M_system::system_getcwd(3f):call getcwd(3c) to get pathname of current working directory"
-
- CHARACTER(len=:), ALLOCATABLE, INTENT(out) :: output
- INTEGER, INTENT(out) :: ierr
- INTEGER(kind=C_LONG), PARAMETER :: length = 4097_C_LONG
- CHARACTER(kind=C_CHAR, len=1) :: buffer(length)
- TYPE(C_PTR) :: buffer2
- INTERFACE
- FUNCTION c_getcwd(buffer, size) BIND(c, name="getcwd") RESULT(buffer_result)
- IMPORT C_CHAR, C_SIZE_T, C_PTR
- CHARACTER(kind=C_CHAR), INTENT(out) :: buffer(*)
- INTEGER(C_SIZE_T), VALUE, INTENT(in) :: size
- TYPE(C_PTR) :: buffer_result
- END FUNCTION
- END INTERFACE
-!-----------------------------------------------------------------------------------------------------------------------------------
- buffer = ' '
- buffer2 = c_getcwd(buffer, length)
- IF (.NOT. C_ASSOCIATED(buffer2)) THEN
- output = ''
- ierr = -1
- ELSE
- output = TRIM(arr2str(buffer))
- ierr = 0
- END IF
-END SUBROUTINE system_getcwd
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_rmdir(3f) - [M_system:FILE_SYSTEM] call rmdir(3c) to remove empty directories
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! function system_rmdir(dirname) result(err)
-!!
-!! character(*),intent(in) :: dirname
-!! integer(c_int) :: err
-!!
-!!##DESCRIPTION
-!! DIRECTORY The name of a directory to remove if it is empty
-!! err zero (0) if no error occurred
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_rmdir
-!! use M_system, only : system_perror
-!! use M_system, only : system_rmdir, system_mkdir
-!! use M_system, only : RWX_U
-!! implicit none
-!! integer :: ierr
-!! write(*,*)'BEFORE TRY TO CREATE _scratch/'
-!! call execute_command_line('ls -ld _scratch')
-!!
-!! write(*,*)'TRY TO CREATE _scratch/'
-!! ierr=system_mkdir('_scratch',RWX_U)
-!! write(*,*)'IERR=',ierr
-!! call execute_command_line('ls -ld _scratch')
-!!
-!! write(*,*)'TRY TO REMOVE _scratch/'
-!! ierr=system_rmdir('_scratch')
-!! write(*,*)'IERR=',ierr
-!! call execute_command_line('ls -ld _scratch')
-!!
-!! write(*,*)'TRY TO REMOVE _scratch when it should be gone/'
-!! ierr=system_rmdir('_scratch')
-!! call system_perror('*test of system_rmdir*')
-!! write(*,*)'IERR=',ierr
-!! call execute_command_line('ls -ld _scratch')
-!!
-!! end program demo_system_rmdir
-!!
-!! Expected output:
-!!
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-FUNCTION system_rmdir(dirname) RESULT(err)
-
-! ident_19="@(#)M_system::system_rmdir(3f): call rmdir(3c) to remove empty directory"
-
- CHARACTER(*), INTENT(in) :: dirname
- INTEGER(C_INT) :: err
-
- INTERFACE
- FUNCTION c_rmdir(c_path) BIND(c, name="rmdir") RESULT(c_err)
- IMPORT C_CHAR, C_INT
- CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: c_path(*)
- INTEGER(C_INT) :: c_err
- END FUNCTION
- END INTERFACE
-!-----------------------------------------------------------------------------------------------------------------------------------
- err = c_rmdir(str2_carr(TRIM(dirname)))
- IF (err .NE. 0) err = system_errno()
-END FUNCTION system_rmdir
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_mkfifo(3f) - [M_system:FILE_SYSTEM] make a FIFO special file relative to directory file descriptor
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! function system_mkfifo(pathname,mode) result(ierr)
-!!
-!! character(len=*),intent(in) :: pathname
-!! integer,intent(in) :: mode
-!! integer :: ierr
-!!
-!!##DESCRIPTION
-!! A regular pipe can only connect two related processes. It is created by
-!! a process and will vanish when the last process closes it.
-!!
-!! A named pipe, also called a FIFO for its behavior, can be used to connect
-!! two unrelated processes and exists independently of the processes;
-!! meaning it can exist even if no one is using it. A FIFO is created using
-!! the mkfifo() library function.
-!!
-!! The mkfifo() function creates a new FIFO special file named by the
-!! pathname.
-!!
-!! The file permission bits of the new FIFO are initialized from mode.
-!!
-!! The file permission bits of the mode argument are modified by the
-!! process file creation mask.
-!!
-!! When bits in mode other than the file permission bits are set, the
-!! effect is implementation-defined.
-!!
-!! If path names a symbolic link, mkfifo() shall fail and set errno to
-!! [EEXIST].
-!!
-!! The FIFOs user ID will be set to the process effective user ID.
-!!
-!! The FIFOs group ID shall be set to the group ID of the parent
-!! directory or to the effective group ID of the process.
-!!
-!! Implementations shall provide a way to initialize the FIFOs group
-!! ID to the group ID of the parent directory.
-!!
-!! Implementations may, but need not, provide an implementation-defined
-!! way to initialize the FIFOs group ID to the effective group ID of
-!! the calling process.
-!!
-!! Upon successful completion, mkfifo() shall mark for update the
-!! last data access, last data modification, and last file status change
-!! timestamps of the file.
-!!
-!! Also, the last data modification and last file status change
-!! timestamps of the directory that contains the new entry shall be
-!! marked for update.
-!!
-!! Predefined variables are typically used to set permission modes.
-!!
-!! You can bytewise-OR together these variables to create the most
-!! common permissions mode:
-!!
-!! User: R_USR (read), W_USR (write), X_USR(execute)
-!! Group: R_GRP (read), W_GRP (write), X_GRP(execute)
-!! Others: R_OTH (read), W_OTH (write), X_OTH(execute)
-!!
-!! Additionally, some shortcuts are provided (basically a bitwise-OR
-!! combination of the above):
-!!
-!! Read + Write + Execute: RWX_U (User), RWX_G (Group), RWX_O (Others)
-!! DEFFILEMODE: Equivalent of 0666 =rw-rw-rw-
-!! ACCESSPERMS: Equivalent of 0777 = rwxrwxrwx
-!!
-!! Therefore, to give only the user rwx (read+write+execute) rights whereas
-!! group members and others may not do anything, you can use any of the
-!! following mkfifo() calls equivalently:
-!!
-!! ierr= mkfifo("myfile", IANY([R_USR, W_USR, X_USR]));
-!! ierr= mkfifo("myfile", RWX_U);
-!!
-!! In order to give anyone any rights (mode 0777 = rwxrwxrwx), you can
-!! use any of the following calls equivalently:
-!!
-!! ierr= mkfifo("myfile",IANY([R_USR,W_USR,X_USR,R_GRP,W_GRP,X_GRP,R_OTH,W_OTH,X_OTH]));
-!! ierr= mkfifo("myfile",IANY([RWX_U,RWX_G,RWX_O]));
-!! ierr= mkfifo("myfile",ACCESSPERMS);
-!!##RETURN VALUE
-!! Upon successful completion, return 0.
-!! Otherwise, return -1 and set errno to indicate the error.
-!! If -1 is returned, no FIFO is created.
-!!
-!!##EXAMPLES
-!!
-!! The following example shows how to create a FIFO file named
-!! /home/cnd/mod_done, with read/write permissions for owner, and
-!! with read permissions for group and others.
-!!
-!! program demo_system_mkfifo
-!! use M_system, only : system_mkfifo, system_perror
-!! !use M_system, only : R_GRP,R_OTH,R_USR,RWX_G,RWX_O
-!! !use M_system, only : RWX_U,W_GRP,W_OTH,W_USR,X_GRP,X_OTH,X_USR
-!! !use M_system, only : DEFFILEMODE, ACCESSPERMS
-!! use M_system, only : W_USR, R_USR, R_GRP, R_OTH
-!! implicit none
-!! integer :: status
-!! status = system_mkfifo("/tmp/buffer", IANY([W_USR, R_USR, R_GRP, R_OTH]))
-!! if(status.ne.0)then
-!! call system_perror('*mkfifo* error:')
-!! endif
-!! end program demo_system_mkfifo
-!!
-!! Now some other process (or this one) can read from /tmp/buffer while this program
-!! is running or after, consuming the data as it is read.
-!!
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-FUNCTION system_mkfifo(pathname, mode) RESULT(err)
-
-! ident_20="@(#)M_system::system_mkfifo(3f): call mkfifo(3c) to create a new FIFO special file"
-
- CHARACTER(len=*), INTENT(in) :: pathname
- INTEGER, INTENT(in) :: mode
- INTEGER :: c_mode
- INTEGER :: err
-
- INTERFACE
- FUNCTION c_mkfifo(c_path, c_mode) BIND(c, name="mkfifo") RESULT(c_err)
- IMPORT C_CHAR, C_INT
- CHARACTER(len=1, kind=C_CHAR), INTENT(in) :: c_path(*)
- INTEGER(C_INT), INTENT(in), VALUE :: c_mode
- INTEGER(C_INT) :: c_err
- END FUNCTION c_mkfifo
- END INTERFACE
-!-----------------------------------------------------------------------------------------------------------------------------------
- c_mode = mode
- err = c_mkfifo(str2_carr(TRIM(pathname)), c_mode)
-END FUNCTION system_mkfifo
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_mkdir(3f) - [M_system:FILE_SYSTEM] call mkdir(3c) to create a new directory
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!!##DESCRIPTION
-!!
-!! Predefined variables are typically used to set permission modes.
-!! You can bytewise-OR together these variables to create the most common
-!! permissions mode:
-!!
-!! User: R_USR (read), W_USR (write), X_USR(execute)
-!! Group: R_GRP (read), W_GRP (write), X_GRP(execute)
-!! Others: R_OTH (read), W_OTH (write), X_OTH(execute)
-!!
-!! Additionally, some shortcuts are provided (basically a bitwise-OR combination of the above):
-!!
-!! Read + Write + Execute: RWX_U (User), RWX_G (Group), RWX_O (Others)
-!! DEFFILEMODE: Equivalent of 0666 =rw-rw-rw-
-!! ACCESSPERMS: Equivalent of 0777 = rwxrwxrwx
-!!
-!! Therefore, to give only the user rwx (read+write+execute) rights whereas
-!! group members and others may not do anything, you can use any of the
-!! following mkdir() calls equivalently:
-!!
-!! ierr= mkdir("mydir", IANY([R_USR, W_USR, X_USR]));
-!! ierr= mkdir("mydir", RWX_U);
-!!
-!! In order to give anyone any rights (mode 0777 = rwxrwxrwx), you can
-!! use any of the following calls equivalently:
-!!
-!! ierr= mkdir("mydir",IANY([R_USR,W_USR,X_USR,R_GRP,W_GRP,X_GRP,R_OTH,W_OTH,X_OTH]));
-!! ierr= mkdir("mydir",IANY([RWX_U,RWX_G,RWX_O]));
-!! ierr= mkdir("mydir",ACCESSPERMS);
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_mkdir
-!! use M_system, only : system_perror
-!! use M_system, only : system_mkdir
-!! use M_system, only : R_GRP,R_OTH,R_USR,RWX_G,RWX_O
-!! use M_system, only : RWX_U,W_GRP,W_OTH,W_USR,X_GRP,X_OTH,X_USR
-!! use M_system, only : DEFFILEMODE, ACCESSPERMS
-!! implicit none
-!! integer :: ierr
-!! ierr=system_mkdir('_scratch',IANY([R_USR,W_USR,X_USR]))
-!! end program demo_system_mkdir
-!!
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-FUNCTION system_mkdir(dirname, mode) RESULT(ierr)
-
-! ident_21="@(#)M_system::system_mkdir(3f): call mkdir(3c) to create empty directory"
-
- CHARACTER(len=*), INTENT(in) :: dirname
- INTEGER, INTENT(in) :: mode
- INTEGER :: c_mode
- INTEGER(kind=C_INT) :: err
- INTEGER :: ierr
-
- INTERFACE
- FUNCTION c_mkdir(c_path, c_mode) BIND(c, name="mkdir") RESULT(c_err)
- IMPORT C_CHAR, C_INT
- CHARACTER(len=1, kind=C_CHAR), INTENT(in) :: c_path(*)
- INTEGER(C_INT), INTENT(in), VALUE :: c_mode
- INTEGER(C_INT) :: c_err
- END FUNCTION c_mkdir
- END INTERFACE
- INTERFACE
- SUBROUTINE my_mkdir(string, c_mode, c_err) BIND(C, name="my_mkdir")
- USE ISO_C_BINDING, ONLY: C_CHAR, C_INT
- CHARACTER(kind=C_CHAR) :: string(*)
- INTEGER(C_INT), INTENT(in), VALUE :: c_mode
- INTEGER(C_INT) :: c_err
- END SUBROUTINE my_mkdir
- END INTERFACE
-!-----------------------------------------------------------------------------------------------------------------------------------
- c_mode = mode
- IF (INDEX(dirname, '/') .NE. 0) THEN
- CALL my_mkdir(str2_carr(TRIM(dirname)), c_mode, err)
- ELSE
- err = c_mkdir(str2_carr(TRIM(dirname)), c_mode)
- END IF
- ierr = err ! c_int to default integer kind
-END FUNCTION system_mkdir
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_opendir(3f) - [M_system:QUERY_FILE] open directory stream by calling opendir(3c)
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! subroutine system_opendir(dirname,dir,ierr)
-!!
-!! character(len=*), intent(in) :: dirname
-!! type(c_ptr) :: dir
-!! integer,intent(out) :: ierr
-!!
-!!##DESCRIPTION
-!! The system_opendir(3f) procedure opens a directory stream
-!! corresponding to the directory named by the dirname argument.
-!! The directory stream is positioned at the first entry.
-!!
-!!##RETURN VALUE
-!! Upon successful completion, a pointer to a C dir type is returned.
-!! Otherwise, these functions shall return a null pointer and set
-!! IERR to indicate the error.
-!!
-!!##ERRORS
-!!
-!! An error corresponds to a condition described in opendir(3c):
-!!
-!! EACCES Search permission is denied for the component of the
-!! path prefix of dirname or read permission is denied
-!! for dirname.
-!!
-!! ELOOP A loop exists in symbolic links encountered during
-!! resolution of the dirname argument.
-!!
-!! ENAMETOOLONG The length of a component of a pathname is longer than {NAME_MAX}.
-!!
-!! ENOENT A component of dirname does not name an existing directory or dirname is an empty string.
-!!
-!! ENOTDIR A component of dirname names an existing file that is neither a directory nor a symbolic link to a directory.
-!!
-!! ELOOP More than {SYMLOOP_MAX} symbolic links were encountered during resolution of the dirname argument.
-!!
-!! EMFILE All file descriptors available to the process are currently open.
-!!
-!! ENAMETOOLONG The length of a pathname exceeds {PATH_MAX},
-!! or pathname resolution of a symbolic link produced an intermediate
-!! result with a length that exceeds {PATH_MAX}.
-!!
-!! ENFILE Too many files are currently open in the system.
-!!
-!!##APPLICATION USAGE
-!! The opendir() function should be used in conjunction with readdir(), closedir(), and rewinddir() to examine the contents
-!! of the directory (see the EXAMPLES section in readdir()). This method is recommended for portability.
-!!##OPTIONS
-!! dirname name of directory to open a directory stream for
-!!##RETURNS
-!! dir pointer to directory stream. If an
-!! error occurred, it will not be associated.
-!! ierr 0 indicates no error occurred
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_opendir
-!! use M_system, only : system_opendir,system_readdir
-!! use M_system, only : system_closedir
-!! use iso_c_binding
-!! implicit none
-!! type(c_ptr) :: dir
-!! character(len=:),allocatable :: filename
-!! integer :: ierr
-!! !--- open directory stream to read from
-!! call system_opendir('.',dir,ierr)
-!! if(ierr.eq.0)then
-!! !--- read directory stream
-!! do
-!! call system_readdir(dir,filename,ierr)
-!! if(filename.eq.' ')exit
-!! write(*,*)filename
-!! enddo
-!! endif
-!! !--- close directory stream
-!! call system_closedir(dir,ierr)
-!! end program demo_system_opendir
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-SUBROUTINE system_opendir(dirname, dir, ierr)
- CHARACTER(len=*), INTENT(in) :: dirname
- TYPE(C_PTR) :: dir
- INTEGER, INTENT(out) :: ierr
-
- INTERFACE
- FUNCTION c_opendir(c_dirname) BIND(c, name="opendir") RESULT(c_dir)
- IMPORT C_CHAR, C_INT, C_PTR
- CHARACTER(kind=C_CHAR), INTENT(in) :: c_dirname(*)
- TYPE(C_PTR) :: c_dir
- END FUNCTION c_opendir
- END INTERFACE
-
- ierr = 0
- dir = c_opendir(str2_carr(TRIM(dirname)))
- IF (.NOT. C_ASSOCIATED(dir)) THEN
- WRITE (*, '(a)') '*system_opendir* Error opening '//TRIM(dirname)
- ierr = -1
- END IF
-
-END SUBROUTINE system_opendir
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_readdir(3f) - [M_system:QUERY_FILE] read a directory using readdir(3c)
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! subroutine system_readdir(dir,filename,ierr)
-!!
-!! type(c_ptr),value :: dir
-!! character(len=:),intent(out),allocatable :: filename
-!! integer,intent(out) :: ierr
-!!
-!!##DESCRIPTION
-!!
-!! system_readdir(3f) returns the name of the directory entry at the
-!! current position in the directory stream specified by the argument
-!! DIR, and positions the directory stream at the next entry. It returns
-!! a null name upon reaching the end of the directory stream.
-!!
-!!##OPTIONS
-!!
-!! DIR A pointer to the directory opened by system_opendir(3f).
-!!
-!!##RETURNS
-!!
-!! FILENAME the name of the directory entry at the current position in
-!! the directory stream specified by the argument DIR, and
-!! positions the directory stream at the next entry.
-!!
-!! The readdir() function does not return directory entries
-!! containing empty names. If entries for dot or dot-dot exist,
-!! one entry is returned for dot and one entry is returned
-!! for dot-dot.
-!!
-!! The entry is marked for update of the last data access
-!! timestamp each time it is read.
-!!
-!! reaching the end of the directory stream, the name is a blank name.
-!!
-!! IERR If IERR is set to non-zero on return, an error occurred.
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_readdir
-!! use M_system, only : system_opendir,system_readdir
-!! use M_system, only : system_rewinddir,system_closedir
-!! use iso_c_binding
-!! implicit none
-!!
-!! type(c_ptr) :: dir
-!! character(len=:),allocatable :: filename
-!! integer :: i, ierr
-!! !--- open directory stream to read from
-!! call system_opendir('.',dir,ierr)
-!! if(ierr.eq.0)then
-!! !--- read directory stream twice
-!! do i=1,2
-!! write(*,'(a,i0)')'PASS ',i
-!! do
-!! call system_readdir(dir,filename,ierr)
-!! if(filename.eq.' ')exit
-!! write(*,*)filename
-!! enddo
-!! call system_rewinddir(dir)
-!! enddo
-!! endif
-!! !--- close directory stream
-!! call system_closedir(dir,ierr)
-!!
-!! end program demo_system_readdir
-!!
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-SUBROUTINE system_readdir(dir, filename, ierr)
- TYPE(C_PTR), VALUE :: dir
- CHARACTER(len=:), INTENT(out), ALLOCATABLE :: filename
- INTEGER, INTENT(out) :: ierr
- INTEGER(kind=C_INT) :: ierr_local
-
- CHARACTER(kind=C_CHAR, len=1) :: buf(4097)
-
- INTERFACE
- SUBROUTINE c_readdir(c_dir, c_filename, c_ierr) BIND(C, NAME='my_readdir')
- IMPORT C_CHAR, C_INT, C_PTR
- TYPE(C_PTR), VALUE :: c_dir
- CHARACTER(kind=C_CHAR) :: c_filename(*)
- INTEGER(kind=C_INT) :: c_ierr
- END SUBROUTINE c_readdir
- END INTERFACE
-
- buf = ' '
- ierr_local = 0
- CALL c_readdir(dir, buf, ierr_local)
- filename = TRIM(arr2str(buf))
- ierr = ierr_local
-
-END SUBROUTINE system_readdir
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_rewinddir(3f) - [M_system:QUERY_FILE] call rewinddir(3c) to rewind directory stream
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! subroutine system_rewinddir(dir)
-!!
-!! type(c_ptr),value :: dir
-!!
-!!##DESCRIPTION
-!! Return to pointer to the beginning of the list for a currently open directory list.
-!!
-!!##OPTIONS
-!! DIR A C_pointer assumed to have been allocated by a call to SYSTEM_OPENDIR(3f).
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_rewinddir
-!! use M_system, only : system_opendir,system_readdir
-!! use M_system, only : system_rewinddir,system_closedir
-!! use iso_c_binding
-!! implicit none
-!!
-!! type(c_ptr) :: dir
-!! character(len=:),allocatable :: filename
-!! integer :: i, ierr
-!! !>>> open directory stream to read from
-!! call system_opendir('.',dir,ierr)
-!! !>>> read directory stream twice
-!! do i=1,2
-!! write(*,'(a,i0)')'PASS ',i
-!! do
-!! call system_readdir(dir,filename,ierr)
-!! if(filename.eq.' ')exit
-!! write(*,*)filename
-!! enddo
-!! !>>> rewind directory stream
-!! call system_rewinddir(dir)
-!! enddo
-!! !>>> close directory stream
-!! call system_closedir(dir,ierr)
-!!
-!! end program demo_system_rewinddir
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-SUBROUTINE system_rewinddir(dir)
- TYPE(C_PTR), VALUE :: dir
-
- INTERFACE
- SUBROUTINE c_rewinddir(c_dir) BIND(c, name="rewinddir")
- IMPORT C_CHAR, C_INT, C_PTR
- TYPE(C_PTR), VALUE :: c_dir
- END SUBROUTINE c_rewinddir
- END INTERFACE
-
- CALL c_rewinddir(dir)
-
-END SUBROUTINE system_rewinddir
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_closedir(3f) - [M_system:QUERY_FILE] close a directory stream by calling closedir(3c)
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! subroutine system_closedir(dir,ierr)
-!!
-!! type(c_ptr) :: dir
-!! integer,intent(out) :: ierr
-!!##DESCRIPTION
-!! The SYSTEM_CLOSEDIR(3f) function closes the directory stream referred to by the argument DIR.
-!! Upon return, the value of DIR may no longer point to an accessible object.
-!!##OPTIONS
-!! dir directory stream pointer opened by SYSTEM_OPENDIR(3f).
-!! ierr Upon successful completion, SYSTEM_CLOSEDIR(3f) returns 0;
-!! otherwise, an error has occurred.
-!!##ERRORS
-!! system_closedir(3f) may fail if:
-!!
-!! EBADF The dirp argument does not refer to an open directory stream.
-!! EINTR The closedir() function was interrupted by a signal.
-!!##EXAMPLE
-!!
-!! Sample program
-!!
-!! program demo_system_closedir
-!! use M_system, only : system_opendir,system_readdir
-!! use M_system, only : system_closedir, system_rewinddir
-!! use iso_c_binding, only : c_ptr
-!! implicit none
-!! type(c_ptr) :: dir
-!! character(len=:),allocatable :: filename
-!! integer :: ierr
-!! !--- open directory stream to read from
-!! call system_opendir('.',dir,ierr)
-!! !--- read directory stream
-!! do
-!! call system_readdir(dir,filename,ierr)
-!! if(filename.eq.' ')exit
-!! write(*,*)filename
-!! enddo
-!! call system_rewinddir(dir)
-!! !--- close directory stream
-!! call system_closedir(dir,ierr)
-!! end program demo_system_closedir
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-SUBROUTINE system_closedir(dir, ierr)
- USE ISO_C_BINDING
- TYPE(C_PTR), VALUE :: dir
- INTEGER, INTENT(out), OPTIONAL :: ierr
- INTEGER :: ierr_local
-
- INTERFACE
- FUNCTION c_closedir(c_dir) BIND(c, name="closedir") RESULT(c_err)
- IMPORT C_CHAR, C_INT, C_PTR
- TYPE(C_PTR), VALUE :: c_dir
- INTEGER(kind=C_INT) :: c_err
- END FUNCTION c_closedir
- END INTERFACE
-
- ierr_local = c_closedir(dir)
- IF (PRESENT(ierr)) THEN
- ierr = ierr_local
- ELSE
- IF (ierr_local /= 0) THEN
- PRINT *, "*system_closedir* error", ierr_local
- STOP 3
- END IF
- END IF
-
-END SUBROUTINE system_closedir
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_putenv(3f) - [M_system:ENVIRONMENT] set environment variable from Fortran by calling putenv(3c)
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! subroutine system_putenv(string, err)
-!!
-!! character(len=*),intent(in) :: string
-!! integer, optional, intent(out) :: err
-!!
-!!##DESCRIPTION
-!! The system_putenv() function adds or changes the value of environment variables.
-!!
-!!##OPTIONS
-!! string string of format "NAME=value".
-!! If name does not already exist in the environment, then string is added to the environment.
-!! If name does exist, then the value of name in the environment is changed to value.
-!! The string passed to putenv(3c) becomes part of the environment,
-!! so this routine creates a string each time it is called that increases the amount of
-!! memory the program uses.
-!! err The system_putenv() function returns zero on success, or nonzero if an error occurs.
-!! A non-zero error usually indicates sufficient memory does not exist to store the
-!! variable.
-!!
-!!##EXAMPLE
-!!
-!! Sample setting an environment variable from Fortran:
-!!
-!! program demo_system_putenv
-!! use M_system, only : system_putenv
-!! use iso_c_binding
-!! implicit none
-!! integer :: ierr
-!! !
-!! write(*,'(a)')'no environment variables containing "GRU":'
-!! call execute_command_line('env|grep GRU')
-!! !
-!! call system_putenv('GRU=this is the value',ierr)
-!! write(*,'(a,i0)')'now "GRU" should be defined: ',ierr
-!! call execute_command_line('env|grep GRU')
-!! !
-!! call system_putenv('GRU2=this is the second value',ierr)
-!! write(*,'(a,i0)')'now "GRU" and "GRU2" should be defined: ',ierr
-!! call execute_command_line('env|grep GRU')
-!! !
-!! call system_putenv('GRU2',ierr)
-!! call system_putenv('GRU',ierr)
-!! write(*,'(a,i0)')'should be gone, varies with different putenv(3c): ',ierr
-!! call execute_command_line('env|grep GRU')
-!! write(*,'(a)')'system_unsetenv(3f) is a better way to remove variables'
-!! !
-!! end program demo_system_putenv
-!!
-!! Results:
-!!
-!! no environment variables containing "GRU":
-!! now "GRU" should be defined: 0
-!! GRU=this is the value
-!! now "GRU" and "GRU2" should be defined: 0
-!! GRU2=this is the second value
-!! GRU=this is the value
-!! should be gone, varies with different putenv(3c): 0
-!! system_unsetenv(3f) is a better way to remove variables
-!!
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-SUBROUTINE system_putenv(string, err)
-
-! ident_22="@(#)M_system::system_putenv(3f): call putenv(3c)"
-
- INTERFACE
- INTEGER(kind=C_INT) FUNCTION c_putenv(c_string) BIND(C, name="putenv")
- IMPORT C_INT, C_CHAR
- CHARACTER(kind=C_CHAR) :: c_string(*)
- END FUNCTION
- END INTERFACE
-
- CHARACTER(len=*), INTENT(in) :: string
- INTEGER, OPTIONAL, INTENT(out) :: err
- INTEGER :: loc_err
- INTEGER :: i
-
- ! PUTENV actually adds the data to the environment so the string passed should be saved or will vanish on exit
- CHARACTER(len=1, kind=C_CHAR), SAVE, POINTER :: memleak(:)
-
- ALLOCATE (memleak(LEN(string) + 1))
- DO i = 1, LEN(string)
- memleak(i) = string(i:i)
- END DO
- memleak(LEN(string) + 1) = C_NULL_CHAR
-
- loc_err = c_putenv(memleak)
- IF (PRESENT(err)) err = loc_err
-
-END SUBROUTINE system_putenv
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_getenv(3f) - [M_system:ENVIRONMENT] get environment variable
-!! from Fortran by calling get_environment_variable(3f)
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! function system_getenv(name,default)
-!!
-!! character(len=:),allocatable :: system_getenv
-!! character(len=*),intent(in) :: name
-!! character(len=*),intent(in),optional :: default
-!!
-!!##DESCRIPTION
-!! The system_getenv() function gets the value of an environment variable.
-!!
-!!##OPTIONS
-!! name Return the value of the specified environment variable or
-!! blank if the variable is not defined.
-!! default If the value returned would be blank this value will be used
-!! instead.
-!!
-!!##EXAMPLE
-!!
-!! Sample setting an environment variable from Fortran:
-!!
-!! program demo_system_getenv
-!! use M_system, only : system_getenv
-!! implicit none
-!! write(*,'("USER : ",a)')system_getenv('USER')
-!! write(*,'("LOGNAME : ",a)')system_getenv('LOGNAME')
-!! write(*,'("USERNAME : ",a)')system_getenv('USERNAME')
-!! end program demo_system_getenv
-!!
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-FUNCTION system_getenv(name, default) RESULT(VALUE)
-
-! ident_23="@(#)M_system::system_getenv(3f): call get_environment_variable as a function with a default value(3f)"
-
- CHARACTER(len=*), INTENT(in) :: name
- CHARACTER(len=*), INTENT(in), OPTIONAL :: default
- INTEGER :: howbig
- INTEGER :: stat
- CHARACTER(len=:), ALLOCATABLE :: VALUE
-
- IF (NAME .NE. '') THEN
- call get_environment_variable(name, length=howbig, status=stat, trim_name=.true.) ! get length required to hold value
- IF (howbig .NE. 0) THEN
- SELECT CASE (stat)
- CASE (1) ! print *, NAME, " is not defined in the environment. Strange..."
- VALUE = ''
- CASE (2) ! print *, "This processor doesn't support environment variables. Boooh!"
- VALUE = ''
- CASE default ! make string to hold value of sufficient size and get value
- IF (ALLOCATED(VALUE)) DEALLOCATE (VALUE)
- ALLOCATE (CHARACTER(len=MAX(howbig, 1)) :: VALUE)
- CALL GET_ENVIRONMENT_VARIABLE(name, VALUE, status=stat, trim_name=.TRUE.)
- IF (stat .NE. 0) VALUE = ''
- END SELECT
- ELSE
- VALUE = ''
- END IF
- ELSE
- VALUE = ''
- END IF
- IF (VALUE .EQ. '' .AND. PRESENT(default)) VALUE = default
-
-END FUNCTION system_getenv
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! set_environment_variable(3f) - [M_system:ENVIRONMENT] call setenv(3c) to set environment variable
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! subroutine set_environment_variable(NAME, VALUE, STATUS)
-!!
-!! character(len=*) :: NAME
-!! character(len=*) :: VALUE
-!! integer, optional, intent(out) :: STATUS
-!!
-!!##DESCRIPTION
-!! The set_environment_variable() procedure adds or changes the value of environment variables.
-!!
-!!##OPTIONS
-!! NAME If name does not already exist in the environment, then string is added to the environment.
-!! If name does exist, then the value of name in the environment is changed to value.
-!! VALUE Value to assign to environment variable NAME
-!! STATUS returns zero on success, or nonzero if an error occurs.
-!! A non-zero error usually indicates sufficient memory does not exist to store the
-!! variable.
-!!
-!!##EXAMPLE
-!!
-!! Sample setting an environment variable from Fortran:
-!!
-!! program demo_set_environment_variable
-!! use M_system, only : set_environment_variable
-!! use iso_c_binding
-!! implicit none
-!! integer :: ierr
-!! !!
-!! write(*,'(a)')'no environment variables containing "GRU":'
-!! call execute_command_line('env|grep GRU')
-!! !!
-!! call set_environment_variable('GRU','this is the value',ierr)
-!! write(*,'(a,i0)')'now "GRU" should be defined, status=',ierr
-!! call execute_command_line('env|grep GRU')
-!! !!
-!! call set_environment_variable('GRU2','this is the second value',ierr)
-!! write(*,'(a,i0)')'now "GRU" and "GRU2" should be defined, status =',ierr
-!! !!
-!! call execute_command_line('env|grep GRU')
-!! end program demo_set_environment_variable
-!!
-!! Results:
-!!
-!! no environment variables containing "GRU":
-!! now "GRU" should be defined, status=0
-!! GRU=this is the value
-!! now "GRU" and "GRU2" should be defined, status =0
-!! GRU2=this is the second value
-!! GRU=this is the value
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-SUBROUTINE set_environment_variable(NAME, VALUE, STATUS)
-
-! ident_24="@(#)M_system::set_environment_variable(3f): call setenv(3c) to set environment variable"
-
- CHARACTER(len=*) :: NAME
- CHARACTER(len=*) :: VALUE
- INTEGER, OPTIONAL, INTENT(out) :: STATUS
- INTEGER :: loc_err
-
- INTERFACE
- INTEGER(kind=C_INT) FUNCTION c_setenv(c_name, c_VALUE) BIND(C, NAME="setenv")
- IMPORT C_INT, C_CHAR
- CHARACTER(kind=C_CHAR) :: c_name(*)
- CHARACTER(kind=C_CHAR) :: c_VALUE(*)
- END FUNCTION
- END INTERFACE
-
- loc_err = c_setenv(str2_carr(TRIM(NAME)), str2_carr(VALUE))
- IF (PRESENT(STATUS)) STATUS = loc_err
-END SUBROUTINE set_environment_variable
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_clearenv(3f) - [M_system:ENVIRONMENT] clear environment by calling clearenv(3c)
-!! (LICENSE:PD)
-!!
-!!
-!!##SYNOPSIS
-!!
-!! subroutine system_clearenv(ierr)
-!!
-!! integer,intent(out),optional :: ierr
-!!
-!!##DESCRIPTION
-!! The clearenv() procedure clears the environment of all name-value
-!! pairs. Typically used in security-conscious applications or ones where
-!! configuration control requires ensuring specific variables are set.
-!!
-!!##RETURN VALUES
-!! ierr returns zero on success, and a nonzero value on failure. Optional.
-!! If not present and an error occurs the program stops.
-!!
-!!##EXAMPLE
-!!
-!!
-!! Sample program:
-!!
-!! program demo_system_clearenv
-!! use M_system, only : system_clearenv
-!! implicit none
-!! ! environment before clearing
-!! call execute_command_line('env|wc')
-!! ! environment after clearing (not necessarily blank!!)
-!! call system_clearenv()
-!! call execute_command_line('env')
-!! end program demo_system_clearenv
-!!
-!! Typical output:
-!!
-!! 89 153 7427
-!! PWD=/home/urbanjs/V600
-!! SHLVL=1
-!!
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-SUBROUTINE system_clearenv(ierr)
-! emulating because not available on some platforms
-
-! ident_25="@(#)M_system::system_clearenv(3f): emulate clearenv(3c) to clear environment"
-
- INTEGER, INTENT(out), OPTIONAL :: ierr
- CHARACTER(len=:), ALLOCATABLE :: string
- INTEGER :: ierr_local1, ierr_local2
- ierr_local2 = 0
- INFINITE: DO
- CALL system_initenv() ! important -- changing table causes undefined behavior so reset after each unsetenv
- string = system_readenv() ! get first name=value pair
- IF (string .EQ. '') EXIT INFINITE
- CALL system_unsetenv(string(1:INDEX(string, '=') - 1), ierr_local1) ! remove first name=value pair
- IF (ierr_local1 .NE. 0) ierr_local2 = ierr_local1
- END DO INFINITE
- IF (PRESENT(ierr)) THEN
- ierr = ierr_local2
- ELSEIF (ierr_local2 .NE. 0) THEN ! if error occurs and not being returned, stop
- WRITE (*, *) '*system_clearenv* error=', ierr_local2
- STOP
- END IF
-END SUBROUTINE system_clearenv
-!--subroutine system_clearenv(ierr)
-!--! clearenv(3c) not available on some systems I tried
-!--! Found reference that if it is unavailable the assignment
-! "environ = NULL;" will probably do but emulating instead
-!--$@ (#)M_system::system_clearenv(3f): call clearenv(3c) to clear
-! "environment"
-!--integer,intent(out),optional :: ierr
-!-- integer :: ierr_local
-!--
-!--interface
-!-- integer(kind=c_int) function c_clearenv() bind(C,NAME="clearenv")
-!-- import c_int
-!-- end function
-!--end interface
-!--
-!-- ierr_local = c_clearenv()
-!-- if(present(ierr))then
-!-- ierr=ierr_local
-!-- elseif(ierr_local.ne.0)then ! if error occurs and not being returned, stop
-!-- write(*,*)'*system_clearenv* error=',ierr_local
-!-- stop
-!-- endif
-!--
-!--end subroutine system_clearenv
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_unsetenv(3f) - [M_system:ENVIRONMENT] delete an environment variable by calling unsetenv(3c)
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! subroutine system_unsetenv(name,ierr)
-!!
-!! character(len=*),intent(in) :: name
-!! integer,intent(out),optional :: ierr
-!!
-!!##DESCRIPTION
-!!
-!! The system_unsetenv(3f) function deletes the variable name from the
-!! environment.
-!!
-!!##OPTIONS
-!! name name of variable to delete.
-!! If name does not exist in the environment, then the
-!! function succeeds, and the environment is unchanged.
-!!
-!! ierr The system_unsetenv(3f) function returns zero on success, or -1 on error.
-!! name is NULL, points to a string of length 0, or contains an '=' character.
-!! Insufficient memory to add a new variable to the environment.
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_unsetenv
-!! use M_system, only : system_unsetenv, system_putenv
-!! implicit none
-!! call system_putenv('GRU=this is the value')
-!! write(*,'(a)')'The variable GRU should be set'
-!! call execute_command_line('env|grep GRU')
-!! call system_unsetenv('GRU')
-!! write(*,'(a)')'The variable GRU should not be set'
-!! call execute_command_line('env|grep GRU')
-!! end program demo_system_unsetenv
-!!
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-SUBROUTINE system_unsetenv(name, ierr)
-
-! ident_26="@(#)M_system::system_unsetenv(3f): call unsetenv(3c) to remove variable from environment"
-
- CHARACTER(len=*), INTENT(in) :: name
- INTEGER, INTENT(out), OPTIONAL :: ierr
- INTEGER :: ierr_local
-
-! int unsetenv(void)
- INTERFACE
- INTEGER(kind=C_INT) FUNCTION c_unsetenv(c_name) BIND(C, NAME="unsetenv")
- IMPORT C_INT, C_CHAR
- CHARACTER(len=1, kind=C_CHAR) :: c_name(*)
- END FUNCTION
- END INTERFACE
-
- ierr_local = c_unsetenv(str2_carr(TRIM(NAME)))
-
- IF (PRESENT(ierr)) THEN
- ierr = ierr_local
- ELSEIF (ierr_local .NE. 0) THEN ! if error occurs and not being returned, stop
- WRITE (*, *) '*system_unsetenv* error=', ierr_local
- STOP
- END IF
-
-END SUBROUTINE system_unsetenv
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_readenv(3f) - [M_system:ENVIRONMENT] step thru and read environment table
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! function system_readenv() result(string)
-!!
-!! character(len=:),allocatable :: string
-!!##DESCRIPTION
-!! A simple interface allows reading the environment variable table of the process. Call
-!! system_initenv(3f) to initialize reading the environment table, then call system_readenv(3f) can
-!! be called until a blank line is returned. If more than one thread
-!! reads the environment or the environment is changed while being read the results are undefined.
-!!##OPTIONS
-!! string the string returned from the environment of the form "NAME=VALUE"
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_readenv
-!! use M_system, only : system_initenv, system_readenv
-!! character(len=:),allocatable :: string
-!! call system_initenv()
-!! do
-!! string=system_readenv()
-!! if(string.eq.'')then
-!! exit
-!! else
-!! write(*,'(a)')string
-!! endif
-!! enddo
-!! end program demo_system_readenv
-!!
-!! Sample results:
-!!
-!! USERDOMAIN_ROAMINGPROFILE=buzz
-!! HOMEPATH=\Users\JSU
-!! APPDATA=C:\Users\JSU\AppData\Roaming
-!! MANPATH=/home/urbanjs/V600/LIBRARY/libGPF/download/tmp/man:/home/urbanjs/V600/doc/man:::
-!! DISPLAYNUM=0
-!! ProgramW6432=C:\Program Files
-!! HOSTNAME=buzz
-!! XKEYSYMDB=/usr/share/X11/XKeysymDB
-!! PUBLISH_CMD=
-!! OnlineServices=Online Services
-!! :
-!! :
-!! :
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-FUNCTION system_readenv() RESULT(string)
-
-! ident_27="@(#)M_system::system_readenv(3f): read next entry from environment table"
-
- CHARACTER(len=:), ALLOCATABLE :: string
- CHARACTER(kind=C_CHAR) :: c_buff(longest_env_variable + 1)
-
- INTERFACE
- SUBROUTINE c_readenv(c_string) BIND(C, NAME='my_readenv')
- IMPORT C_CHAR, C_INT, C_PTR, C_SIZE_T
- CHARACTER(kind=C_CHAR), INTENT(out) :: c_string(*)
- END SUBROUTINE c_readenv
- END INTERFACE
-
- c_buff = ' '
- c_buff(longest_env_variable + 1:longest_env_variable + 1) = C_NULL_CHAR
- CALL c_readenv(c_buff)
- string = TRIM(arr2str(c_buff))
-
-END FUNCTION system_readenv
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! fileglob(3f) - [M_system:QUERY_FILE] Read output of an ls(1) command from Fortran
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! subroutine fileglob(glob,list)
-!!
-!! character(len=*),intent(in) :: glob
-!! character(len=*),pointer :: list(:)
-!!
-!!##DESCRIPTION
-!! Non-portable procedure uses the shell and the ls(1) command to expand a filename
-!! and returns a pointer to a list of expanded filenames.
-!!
-!!##OPTIONS
-!! glob Pattern for the filenames (like: *.txt)
-!! list Allocated list of filenames (returned), the caller must deallocate it.
-!!
-!!##EXAMPLE
-!!
-!! Read output of an ls(1) command from Fortran
-!!
-!! program demo_fileglob ! simple unit test
-!! call tryit('*.*')
-!! call tryit('/tmp/__notthere.txt')
-!! contains
-!!
-!! subroutine tryit(string)
-!! use M_system, only : fileglob
-!! character(len=255),pointer :: list(:)
-!! character(len=*) :: string
-!! call fileglob(string, list)
-!! write(*,*)'Files:',size(list)
-!! write(*,'(a)')(trim(list(i)),i=1,size(list))
-!! deallocate(list)
-!! end subroutine tryit
-!!
-!! end program demo_fileglob ! simple unit test
-!!
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-SUBROUTINE fileglob(glob, list) ! NON-PORTABLE AT THIS POINT. REQUIRES ls(1) command, assumes 1 line per file
-! The length of the character strings in list() must be long enough for the filenames.
-! The list can be zero names long, it is still allocated.
- IMPLICIT NONE
-
-! ident_28="@(#)M_system::fileglob(3f): Returns list of files using a file globbing pattern"
-
-!-----------------------------------------------------------------------------------------------------------------------------------
- CHARACTER(len=*), INTENT(in) :: glob ! Pattern for the filenames (like: *.txt)
- CHARACTER(len=*), POINTER :: list(:) ! Allocated list of filenames (returned), the caller must deallocate it.
-!-----------------------------------------------------------------------------------------------------------------------------------
- CHARACTER(len=255) :: tmpfile ! scratch filename to hold expanded file list
- CHARACTER(len=255) :: cmd ! string to build system command in
- INTEGER :: iotmp ! needed to open unique scratch file for holding file list
- INTEGER :: i, ios, icount
- write(tmpfile,'(*(g0))')'/tmp/__filelist_',timestamp(),'_',system_getpid() ! preliminary scratch file name
- cmd = 'ls -d '//TRIM(glob)//'>'//TRIM(tmpfile)//' ' ! build command string
- CALL execute_command_line(cmd) ! Execute the command specified by the string.
- OPEN (newunit=iotmp, file=tmpfile, iostat=ios) ! open unique scratch filename
- IF (ios .NE. 0) RETURN ! the open failed
- icount = 0 ! number of filenames in expanded list
- DO ! count the number of lines (assumed ==files) so know what to allocate
- READ (iotmp, '(a)', iostat=ios) ! move down a line in the file to count number of lines
- IF (ios .NE. 0) EXIT ! hopefully, this is because end of file was encountered so done
- icount = icount + 1 ! increment line count
- END DO
- REWIND (iotmp) ! rewind file list so can read and store it
- ALLOCATE (list(icount)) ! allocate and fill the array
- DO i = 1, icount
- READ (iotmp, '(a)') list(i) ! read a filename from a line
- END DO
- CLOSE (iotmp, status='delete', iostat=ios) ! close and delete scratch file
-END SUBROUTINE fileglob
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_uname(3f) - [M_system] call a C wrapper that calls uname(3c) to get current system information from Fortran
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! subroutine system_uname(WHICH,NAMEOUT)
-!!
-!! character(KIND=C_CHAR),intent(in) :: WHICH
-!! character(len=*),intent(out) :: NAMEOUT
-!!##DESCRIPTION
-!! Given a letter, return a corresponding description of the current operating system.
-!! The NAMEOUT variable is assumed sufficiently large enough to hold the value.
-!!
-!! s return the kernel name
-!! r return the kernel release
-!! v return the kernel version
-!! n return the network node hostname
-!! m return the machine hardware name
-!! T test mode -- print all information, in the following order - srvnm
-!!
-!!##EXAMPLE
-!!
-!! Call uname(3c) from Fortran
-!!
-!! program demo_system_uname
-!! use M_system, only : system_uname
-!! implicit none
-!! integer,parameter :: is=100
-!! integer :: i
-!! character(len=*),parameter :: letters='srvnmxT'
-!! character(len=is) :: string=' '
-!!
-!! do i=1,len(letters)
-!! write(*,'(80("="))')
-!! call system_uname(letters(i:i),string)
-!! write(*,*)'=====> TESTING system_uname('//letters(i:i)//')--->'//trim(string)
-!! enddo
-!!
-!! end program demo_system_uname
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-SUBROUTINE system_uname(WHICH, NAMEOUT)
- IMPLICIT NONE
-
-! ident_29="@(#)M_system::system_uname(3f): call my_uname(3c) which calls uname(3c)"
-
- CHARACTER(KIND=C_CHAR), INTENT(in) :: WHICH
- CHARACTER(len=*), INTENT(out) :: NAMEOUT
-
-! describe the C routine to Fortran
-! void system_uname(char *which, char *buf, int *buflen);
- INTERFACE
- SUBROUTINE system_uname_c(WHICH, BUF, BUFLEN) BIND(C, NAME='my_uname')
- IMPORT C_CHAR, C_INT
- IMPLICIT NONE
- CHARACTER(KIND=C_CHAR), INTENT(in) :: WHICH
- CHARACTER(KIND=C_CHAR), INTENT(out) :: BUF(*)
- INTEGER(kind=C_INT), INTENT(in) :: BUFLEN
- END SUBROUTINE system_uname_c
- END INTERFACE
-
- NAMEOUT = 'unknown'
- CALL system_uname_c(WHICH, NAMEOUT, INT(LEN(NAMEOUT), KIND(0_C_INT)))
-
-END SUBROUTINE system_uname
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_gethostname(3f) - [M_system:QUERY] get name of current host
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! subroutine system_gethostname(string,ierr)
-!!
-!! character(len=:),allocatable,intent(out) :: NAME
-!! integer,intent(out) :: IERR
-!!##DESCRIPTION
-!! The system_gethostname(3f) procedure returns the standard host
-!! name for the current machine.
-!!
-!!##OPTIONS
-!! string returns the hostname. Must be an allocatable CHARACTER variable.
-!! ierr Upon successful completion, 0 shall be returned; otherwise, -1
-!! shall be returned.
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_gethostname
-!! use M_system, only : system_gethostname
-!! implicit none
-!! character(len=:),allocatable :: name
-!! integer :: ierr
-!! call system_gethostname(name,ierr)
-!! if(ierr.eq.0)then
-!! write(*,'("hostname[",a,"]")')name
-!! else
-!! write(*,'(a)')'ERROR: could not get hostname'
-!! endif
-!! end program demo_system_gethostname
-!!
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-SUBROUTINE system_gethostname(NAME, IERR)
- IMPLICIT NONE
-
-! ident_30="@(#)M_system::system_gethostname(3f): get name of current host by calling gethostname(3c)"
-
- CHARACTER(len=:), ALLOCATABLE, INTENT(out) :: NAME
- INTEGER, INTENT(out) :: IERR
- CHARACTER(kind=C_CHAR, len=1) :: C_BUFF(HOST_NAME_MAX + 1)
-
-! describe the C routine to Fortran
-!int gethostname(char *name, size_t namelen);
- INTERFACE
- FUNCTION system_gethostname_c(c_buf, c_buflen) BIND(C, NAME='gethostname')
- IMPORT C_CHAR, C_INT
- IMPLICIT NONE
- INTEGER(kind=C_INT) :: system_gethostname_c
- CHARACTER(KIND=C_CHAR), INTENT(out) :: c_buf(*)
- INTEGER(kind=C_INT), INTENT(in), VALUE :: c_buflen
- END FUNCTION system_gethostname_c
- END INTERFACE
-
- C_BUFF = ' '
- ierr = system_gethostname_c(C_BUFF, HOST_NAME_MAX) ! Host names are limited to {HOST_NAME_MAX} bytes.
- NAME = TRIM(arr2str(C_BUFF))
-
-END SUBROUTINE system_gethostname
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_getlogin(3f) - [M_system:QUERY] get login name
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! function system_getlogin() result (fname)
-!!
-!! character(len=:),allocatable :: FNAME
-!!
-!!##DESCRIPTION
-!!
-!! The system_getlogin(3f) function returns a string containing the user
-!! name associated by the login activity with the controlling terminal
-!! of the current process. Otherwise, it returns a null string and sets
-!! errno to indicate the error.
-!!
-!! Three names associated with the current process can be determined:
-!!
-!! o system_getpwuid(system_getuid()) returns the name associated with the real user ID of the process.
-!! o system_getpwuid(system_geteuid()) returns the name associated with the effective user ID of the process
-!! o system_getlogin() returns the name associated with the current login activity
-!!
-!!##RETURN VALUE
-!! fname returns the login name.
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_getlogin
-!! use M_system, only : system_getlogin
-!! implicit none
-!! character(len=:),allocatable :: name
-!! name=system_getlogin()
-!! write(*,'("login[",a,"]")')name
-!! end program demo_system_getlogin
-!!
-!! Results:
-!!
-!! login[JSU]
-!!
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-!-- The following example calls the getlogin() function to obtain the name of the user associated with the calling process,
-!-- and passes this information to the getpwnam() function to get the associated user database information.
-!-- ...
-!-- char *lgn;
-!-- struct passwd *pw;
-!-- ...
-!-- if ((lgn = getlogin()) == NULL || (pw = getpwnam(lgn)) == NULL) {
-!-- fprintf(stderr, "Get of user information failed.\n"); exit(1);
-!-- }
-!--APPLICATION USAGE
-!--SEE ALSO
-!-- getpwnam(), getpwuid(), system_geteuid(), getuid()
-FUNCTION system_getlogin() RESULT(fname)
- CHARACTER(len=:), ALLOCATABLE :: fname
- TYPE(C_PTR) :: username
-
- INTERFACE
- FUNCTION c_getlogin() BIND(c, name="getlogin") RESULT(c_username)
- IMPORT C_INT, C_PTR
- TYPE(C_PTR) :: c_username
- END FUNCTION c_getlogin
- END INTERFACE
-
- username = c_getlogin()
- IF (.NOT. C_ASSOCIATED(username)) THEN
- !! in windows 10 subsystem running Ubunto does not work
- !!write(*,'(a)')'*system_getlogin* Error getting username. not associated'
- !!fname=c_null_char
- fname = system_getpwuid(system_geteuid())
- ELSE
- fname = c2f_string(username)
- END IF
-
-END FUNCTION system_getlogin
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_perm(3f) - [M_system:QUERY_FILE] get file type and permission as a string
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! function system_perm(mode) result (perms)
-!!
-!! integer(kind=int64),intent(in) :: MODE
-!! character(len=:),allocatable :: PERMS
-!!
-!!##DESCRIPTION
-!!
-!! The system_perm(3f) function returns a string containing the type
-!! and permission of a file implied by the value of the mode value.
-!!
-!!##RETURN VALUE
-!! PERMS returns the permission string in a format similar to that
-!! used by Unix commands such as ls(1).
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_perm
-!! use M_system, only : system_perm, system_stat
-!! use,intrinsic :: iso_fortran_env, only : int64
-!! implicit none
-!! character(len=4096) :: string
-!! integer(kind=int64) :: values(13)
-!! integer :: ierr
-!! character(len=:),allocatable :: perms
-!! values=0
-!! ! get pathname from command line
-!! call get_command_argument(1, string)
-!! ! get pathname information
-!! call system_stat(string,values,ierr)
-!! if(ierr.eq.0)then
-!! ! convert permit mode to a string
-!! perms=system_perm(values(3))
-!! ! print permits as a string, decimal value, and octal value
-!! write(*,'("for ",a," permits[",a,"]",1x,i0,1x,o0)') &
-!! & trim(string),perms,values(3),values(3)
-!! endif
-!! end program demo_system_perm
-!!
-!! Results:
-!!
-!! demo_system_perm /tmp
-!!
-!! for /tmp permits[drwxrwxrwx --S] 17407 41777
-!!
-!!##AUTHOR
-!! John S. Urban
-!!
-!!##LICENSE
-!! Public Domain
-FUNCTION system_perm(mode) RESULT(perms)
- CLASS(*), INTENT(in) :: mode
- CHARACTER(len=:), ALLOCATABLE :: perms
- TYPE(C_PTR) :: permissions
- INTEGER(kind=C_LONG) :: mode_local
- INTERFACE
- FUNCTION c_perm(c_mode) BIND(c, name="my_get_perm") RESULT(c_permissions)
- IMPORT C_INT, C_PTR, C_LONG
- INTEGER(kind=C_LONG), VALUE :: c_mode
- TYPE(C_PTR) :: c_permissions
- END FUNCTION c_perm
- END INTERFACE
-
- mode_local = INT(anyinteger_to_64bit(mode), kind=C_LONG)
- permissions = c_perm(mode_local)
- IF (.NOT. C_ASSOCIATED(permissions)) THEN
- WRITE (*, '(a)') '*system_perm* Error getting permissions. not associated'
- perms = C_NULL_CHAR
- ELSE
- perms = c2f_string(permissions)
- END IF
-
-END FUNCTION system_perm
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_getgrgid(3f) - [M_system:QUERY] get groupd name associated with a GID
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! function system_getgrgid(gid) result (gname)
-!!
-!! class(*),intent(in) :: gid ! any INTEGER type
-!! character(len=:),allocatable :: gname
-!!
-!!##DESCRIPTION
-!!
-!! The system_getlogin() function returns a string containing the group
-!! name associated with the given GID. If no match is found
-!! it returns a null string and sets errno to indicate the error.
-!!
-!!##OPTION
-!! gid GID to try to look up associated group for. Can be of any
-!! INTEGER type.
-!!
-!!##RETURN VALUE
-!! gname returns the group name. Blank if an error occurs
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_getgrgid
-!! use M_system, only : system_getgrgid
-!! use M_system, only : system_getgid
-!! implicit none
-!! character(len=:),allocatable :: name
-!! name=system_getgrgid( system_getgid() )
-!! write(*,'("group[",a,"] for ",i0)')name,system_getgid()
-!! end program demo_system_getgrgid
-!!
-!! Results:
-!!
-!! group[default] for 197121
-!!
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-FUNCTION system_getgrgid(gid) RESULT(gname)
- CLASS(*), INTENT(in) :: gid
- CHARACTER(len=:), ALLOCATABLE :: gname
- CHARACTER(kind=C_CHAR, len=1) :: groupname(4097) ! assumed long enough for any groupname
- INTEGER :: ierr
- INTEGER(kind=C_LONG_LONG) :: gid_local
-
- INTERFACE
- function c_getgrgid(c_gid,c_groupname) bind(c,name="my_getgrgid") result(c_ierr)
- IMPORT C_INT, C_PTR, C_CHAR, C_LONG_LONG
- INTEGER(kind=C_LONG_LONG), VALUE, INTENT(in) :: c_gid
- CHARACTER(kind=C_CHAR), INTENT(out) :: c_groupname(*)
- INTEGER(kind=C_INT) :: c_ierr
- END FUNCTION c_getgrgid
- END INTERFACE
-!-----------------------------------------------------------------------------------------------------------------------------------
- gid_local = anyinteger_to_64bit(gid)
- ierr = c_getgrgid(gid_local, groupname)
- IF (ierr .EQ. 0) THEN
- gname = TRIM(arr2str(groupname))
- ELSE
- gname = ''
- END IF
-!-----------------------------------------------------------------------------------------------------------------------------------
-END FUNCTION system_getgrgid
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_getpwuid(3f) - [M_system:QUERY] get login name associated with a UID
-!! (LICENSE:PD)
-!!##SYNOPSIS
-!!
-!! function system_getpwuid(uid) result (uname)
-!!
-!! class(*),intent(in) :: uid ! any INTEGER type
-!! character(len=:),allocatable :: uname
-!!
-!!##DESCRIPTION
-!!
-!! The system_getpwuid() function returns a string containing the user
-!! name associated with the given UID. If no match is found it returns
-!! a null string and sets errno to indicate the error.
-!!
-!!##OPTION
-!! uid UID to try to look up associated username for. Can be of any
-!! INTEGER type.
-!!
-!!##RETURN VALUE
-!! uname returns the login name.
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_getpwuid
-!! use M_system, only : system_getpwuid
-!! use M_system, only : system_getuid
-!! use,intrinsic :: iso_fortran_env, only : int64
-!! implicit none
-!! character(len=:),allocatable :: name
-!! integer(kind=int64) :: uid
-!! uid=system_getuid()
-!! name=system_getpwuid(uid)
-!! write(*,'("login[",a,"] has UID ",i0)')name,uid
-!! end program demo_system_getpwuid
-!!
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-FUNCTION system_getpwuid(uid) RESULT(uname)
- CLASS(*), INTENT(in) :: uid
- CHARACTER(len=:), ALLOCATABLE :: uname
- CHARACTER(kind=C_CHAR, len=1) :: username(4097) ! assumed long enough for any username
- INTEGER :: ierr
- INTEGER(kind=C_LONG_LONG) :: uid_local
-
- INTERFACE
- function c_getpwuid(c_uid,c_username) bind(c,name="my_getpwuid") result(c_ierr)
- IMPORT C_INT, C_PTR, C_CHAR, C_LONG_LONG
- INTEGER(kind=C_LONG_LONG), VALUE, INTENT(in) :: c_uid
- CHARACTER(kind=C_CHAR), INTENT(out) :: c_username(*)
- INTEGER(kind=C_INT) :: c_ierr
- END FUNCTION c_getpwuid
- END INTERFACE
-!-----------------------------------------------------------------------------------------------------------------------------------
- uid_local = anyinteger_to_64bit(uid)
- ierr = c_getpwuid(uid_local, username)
- IF (ierr .EQ. 0) THEN
- uname = TRIM(arr2str(username))
- ELSE
- uname = ''
- END IF
-!-----------------------------------------------------------------------------------------------------------------------------------
-END FUNCTION system_getpwuid
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-PURE FUNCTION arr2str(array) RESULT(string)
-
-! ident_31="@(#)M_system::arr2str(3fp): function copies null-terminated char array to string"
-
- CHARACTER(len=1), INTENT(in) :: array(:)
- CHARACTER(len=SIZE(array)) :: string
- INTEGER :: i
-
- string = ' '
- DO i = 1, SIZE(array)
- IF (array(i) .EQ. CHAR(0)) THEN
- EXIT
- ELSE
- string(i:i) = array(i)
- END IF
- END DO
-
-END FUNCTION arr2str
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-PURE FUNCTION str2_carr(string) RESULT(array)
-
-! ident_32="@(#)M_system::str2_carr(3fp): function copies string to null terminated char array"
-
- CHARACTER(len=*), INTENT(in) :: string
- CHARACTER(len=1, kind=C_CHAR) :: array(LEN(string) + 1)
- INTEGER :: i
-
- DO i = 1, LEN_TRIM(string)
- array(i) = string(i:i)
- END DO
- array(i:i) = C_NULL_CHAR
-
-END FUNCTION str2_carr
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-FUNCTION C2F_string(c_string_pointer) RESULT(f_string)
-
-! gets a C string (pointer), and returns the corresponding Fortran string up to 4096(max_len) characters;
-! If the C string is null, it returns string C "null" character:
-
- TYPE(C_PTR), INTENT(in) :: c_string_pointer
- CHARACTER(len=:), ALLOCATABLE :: f_string
- CHARACTER(kind=C_CHAR), DIMENSION(:), POINTER :: char_array_pointer => NULL()
- INTEGER, PARAMETER :: max_len = 4096
- CHARACTER(len=max_len) :: aux_string
- INTEGER :: i
- INTEGER :: length
-
- length = 0
- CALL C_F_POINTER(c_string_pointer, char_array_pointer, [max_len])
-
- IF (.NOT. ASSOCIATED(char_array_pointer)) THEN
- IF (ALLOCATED(f_string)) DEALLOCATE (f_string)
- ALLOCATE (CHARACTER(len=4) :: f_string)
- f_string = C_NULL_CHAR
- RETURN
- END IF
-
- aux_string = " "
-
- DO i = 1, max_len
- IF (char_array_pointer(i) == C_NULL_CHAR) THEN
- length = i - 1; EXIT
- END IF
- aux_string(i:i) = char_array_pointer(i)
- END DO
-
- IF (ALLOCATED(f_string)) DEALLOCATE (f_string)
- ALLOCATE (CHARACTER(len=length) :: f_string)
- f_string = aux_string(1:length)
-END FUNCTION C2F_string
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! SYSTEM_STAT - [M_system:QUERY_FILE] Get file status information
-!! (LICENSE:PD)
-!!
-!!##SYNTAX
-!! CALL SYSTEM_STAT(NAME, VALUES [, STATUS],[DEBUG])
-!!
-!! character(len=*),intent(in) :: NAME
-!! integer(kind=int64),intent(out) :: values(13)
-!! integer,optional,intent(out) :: status
-!! integer,intent(in) :: debug
-!!
-!!##DESCRIPTION
-!!
-!! This function returns information about a file. No permissions are
-!! required on the file itself, but execute (search) permission is required
-!! on all of the directories in path that lead to the file. The elements
-!! that are obtained and stored in the array VALUES:
-!!
-!! VALUES(1) Device ID
-!! VALUES(2) Inode number
-!! VALUES(3) File mode
-!! VALUES(4) Number of links
-!! VALUES(5) Owner uid
-!! VALUES(6) Owner gid
-!! VALUES(7) ID of device containing directory entry for file (0 if not available)
-!! VALUES(8) File size (bytes)
-!! VALUES(9) Last access time as a Unix Epoch time rounded to seconds
-!! VALUES(10) Last modification time as a Unix Epoch time rounded to seconds
-!! VALUES(11) Last file status change time as a Unix Epoch time rounded to seconds
-!! VALUES(12) Preferred I/O block size (-1 if not available)
-!! VALUES(13) Number of blocks allocated (-1 if not available)
-!!
-!! Not all these elements are relevant on all systems. If an element is
-!! not relevant, it is returned as 0.
-!!
-!!##OPTIONS
-!!
-!! NAME The type shall be CHARACTER, of the default kind and a valid
-!! path within the file system.
-!! VALUES The type shall be INTEGER(8), DIMENSION(13).
-!! STATUS (Optional) status flag of type INTEGER(4). Returns 0 on success
-!! and a system specific error code otherwise.
-!! DEBUG (Optional) print values being returned from C routine being
-!! called if value of 0 is used
-!!
-!!##EXAMPLE
-!!
-!! program demo_system_stat
-!!
-!! use M_system, only : system_stat, system_getpwuid, system_getgrgid
-!! use M_time, only : fmtdate, u2d
-!! use, intrinsic :: iso_fortran_env, only : int32, int64
-!! implicit none
-!!
-!! integer(kind=int64) :: buff(13)
-!! integer(kind=int32) :: status
-!! character(len=*),parameter :: fmt_date='year-month-day hour:minute:second'
-!!
-!! integer(kind=int64) :: &
-!! Device_ID, Inode_number, File_mode, Number_of_links,
-!! Owner_uid, &
-!! Owner_gid, Directory_device, File_size, Last_access,
-!! Last_modification,&
-!! Last_status_change, Preferred_block_size, Number_of_blocks_allocated
-!! equivalence &
-!! ( buff(1) , Device_ID ) , &
-!! ( buff(2) , Inode_number ) , &
-!! ( buff(3) , File_mode ) , &
-!! ( buff(4) , Number_of_links ) , &
-!! ( buff(5) , Owner_uid ) , &
-!! ( buff(6) , Owner_gid ) , &
-!! ( buff(7) , Directory_device ) , &
-!! ( buff(8) , File_size ) , &
-!! ( buff(9) , Last_access ) , &
-!! ( buff(10) , Last_modification ) , &
-!! ( buff(11) , Last_status_change ) , &
-!! ( buff(12) , Preferred_block_size ) , &
-!! ( buff(13) , Number_of_blocks_allocated )
-!!
-!! CALL SYSTEM_STAT("/etc/hosts", buff, status)
-!!
-!! if (status == 0) then
-!! write (*, FMT="('Device ID(hex/decimal):', &
-!! & T30, Z0,'h/',I0,'d')") buff(1),buff(1)
-!! write (*, FMT="('Inode number:', &
-!! & T30, I0)") buff(2)
-!! write (*, FMT="('File mode (octal):', &
-!! & T30, O19)") buff(3)
-!! write (*, FMT="('Number of links:', &
-!! & T30, I0)") buff(4)
-!! write (*, FMT="('Owner''s uid/username:', &
-!! & T30, I0,1x, A)") buff(5), system_getpwuid(buff(5))
-!! write (*, FMT="('Owner''s gid/group:', &
-!! & T30, I0,1x, A)") buff(6), system_getgrgid(buff(6))
-!! write (*, FMT="('Device where located:', &
-!! & T30, I0)") buff(7)
-!! write (*, FMT="('File size(bytes):', &
-!! & T30, I0)") buff(8)
-!! write (*, FMT="('Last access time:', &
-!! & T30, I0,1x, A)") buff(9), fmtdate(u2d(int(buff(9))),fmt_date)
-!! write (*, FMT="('Last modification time:', &
-!! & T30, I0,1x, A)") buff(10),fmtdate(u2d(int(buff(10))),fmt_date)
-!! write (*, FMT="('Last status change time:', &
-!! & T30, I0,1x, A)") buff(11),fmtdate(u2d(int(buff(11))),fmt_date)
-!! write (*, FMT="('Preferred block size(bytes):', &
-!! & T30, I0)") buff(12)
-!! write (*, FMT="('No. of blocks allocated:', &
-!! & T30, I0)") buff(13)
-!! endif
-!!
-!! end program demo_system_stat
-!!
-!! Results:
-!!
-!! Device ID(hex/decimal): 3E6BE045h/1047257157d
-!! Inode number: 1407374886070599
-!! File mode (octal): 100750
-!! Number of links: 1
-!! Owner uid/username: 18 SYSTEM
-!! Owner gid/group: 18 SYSTEM
-!! Device where located: 0
-!! File size(bytes): 824
-!! Last access time: 1557983191 2019-05-16 01:06:31
-!! Last modification time: 1557983191 2019-05-16 01:06:31
-!! Last status change time: 1557983532 2019-05-16 01:12:12
-!! Preferred block size(bytes): 65536
-!! No. of blocks allocated: 4
-!!
-!!##AUTHOR
-!! John S. Urban
-!!##LICENSE
-!! Public Domain
-SUBROUTINE system_stat(pathname, values, ierr)
- IMPLICIT NONE
-
-! ident_33="@(#)M_system::system_stat(3f): call stat(3c) to get pathname information"
-
- CHARACTER(len=*), INTENT(in) :: pathname
-
- INTEGER(kind=INT64), INTENT(out) :: values(13)
- INTEGER(kind=C_LONG) :: cvalues(13)
-
- INTEGER, OPTIONAL, INTENT(out) :: ierr
- INTEGER(kind=C_INT) :: cierr
-
- INTERFACE
- SUBROUTINE c_stat(buffer, cvalues, cierr, cdebug) BIND(c, name="my_stat")
- IMPORT C_CHAR, C_SIZE_T, C_PTR, C_INT, C_LONG
- CHARACTER(kind=C_CHAR), INTENT(in) :: buffer(*)
- INTEGER(kind=C_LONG), INTENT(out) :: cvalues(*)
- INTEGER(kind=C_INT) :: cierr
- INTEGER(kind=C_INT), INTENT(in) :: cdebug
- END SUBROUTINE c_stat
- END INTERFACE
-!-----------------------------------------------------------------------------------------------------------------------------------
- CALL c_stat(str2_carr(TRIM(pathname)), cvalues, cierr, 0_C_INT)
- values = cvalues
- IF (PRESENT(ierr)) THEN
- ierr = cierr
- END IF
-END SUBROUTINE system_stat
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>
-!!##NAME
-!! system_dir(3f) - [M_io] return filenames in a directory matching specified wildcard string
-!! (LICENSE:PD)
-!!
-!!##SYNOPSIS
-!!
-!! function system_dir(directory,pattern)
-!!
-!! character(len=*),intent(in),optional :: directory
-!! character(len=*),intent(in),optional :: pattern
-!! character(len=:),allocatable :: system_dir(:)
-!!
-!!##DESCRIPTION
-!! returns an array of filenames in the specified directory matching
-!! the wildcard string (which defaults to "*").
-!!
-!!##OPTIONS
-!! DIRECTORY name of directory to match filenames in. Defaults to ".".
-!! PATTERN wildcard string matching the rules of the matchw(3f) function. Basically
-!! o "*" matches anything
-!! o "?" matches any single character
-!!
-!!##RETURNS
-!! system_dir An array right-padded to the length of the longest
-!! filename. Note that this means filenames actually containing
-!! trailing spaces in their names may be incorrect.
-!!
-!!##EXAMPLE
-!!
-!! Sample program:
-!!
-!! program demo_system_dir
-!! use M_system, only : system_dir
-!! implicit none
-!! write(*, '(a)')system_dir(pattern='*.F90')
-!! end program demo_system_dir
-!!
-!!##AUTHOR
-!! John S. Urban
-!!
-!!##LICENSE
-!! Public Domain
-FUNCTION system_dir(directory, pattern)
-!use M_system, only : system_opendir, system_readdir, system_rewinddir, system_closedir
- USE ISO_C_BINDING
- IMPLICIT NONE
- CHARACTER(len=*), INTENT(in), OPTIONAL :: directory
- CHARACTER(len=*), INTENT(in), OPTIONAL :: pattern
- CHARACTER(len=:), ALLOCATABLE :: system_dir(:)
- CHARACTER(len=:), ALLOCATABLE :: wild
- TYPE(C_PTR) :: dir
- CHARACTER(len=:), ALLOCATABLE :: filename
- INTEGER :: i, ierr, icount, longest
- longest = 0
- icount = 0
- IF (PRESENT(pattern)) THEN
- wild = pattern
- ELSE
- wild = '*'
- END IF
- IF (PRESENT(directory)) THEN !--- open directory stream to read from
- CALL system_opendir(directory, dir, ierr)
- ELSE
- CALL system_opendir('.', dir, ierr)
- END IF
- IF (ierr .EQ. 0) THEN
- DO i = 1, 2 !--- read directory stream twice, first time to get size
- DO
- CALL system_readdir(dir, filename, ierr)
- IF (filename .EQ. ' ') EXIT
- IF (wild .NE. '*') THEN
- IF (.NOT. matchw(filename, wild)) CYCLE ! Call a wildcard matching routine.
- END IF
- icount = icount + 1
- SELECT CASE (i)
- CASE (1)
- longest = MAX(longest, LEN(filename))
- CASE (2)
- system_dir(icount) = filename
- END SELECT
- END DO
- IF (i .EQ. 1) THEN
- CALL system_rewinddir(dir)
- IF (ALLOCATED(system_dir)) DEALLOCATE (system_dir)
- ALLOCATE (CHARACTER(len=longest) :: system_dir(icount))
- icount = 0
- END IF
- END DO
- END IF
- CALL system_closedir(dir, ierr) !--- close directory stream
-END FUNCTION system_dir
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-! copied from M_strings.ff to make stand-alone github version
-FUNCTION matchw(tame, wild)
-
-! ident_34="@(#)M_strings::matchw(3f): function compares text strings, one of which can have wildcards ('*' or '?')."
-
- LOGICAL :: matchw
- CHARACTER(len=*) :: tame ! A string without wildcards
- CHARACTER(len=*) :: wild ! A (potentially) corresponding string with wildcards
- CHARACTER(len=LEN(tame) + 1) :: tametext
- CHARACTER(len=LEN(wild) + 1) :: wildtext
- CHARACTER(len=1), PARAMETER :: NULL = CHAR(0)
- INTEGER :: wlen
- INTEGER :: ti, wi
- INTEGER :: i
- CHARACTER(len=:), ALLOCATABLE :: tbookmark, wbookmark
-! These two values are set when we observe a wildcard character. They
-! represent the locations, in the two strings, from which we start once we've observed it.
- tametext = tame//NULL
- wildtext = wild//NULL
- tbookmark = NULL
- wbookmark = NULL
- wlen = LEN(wild)
- wi = 1
- ti = 1
- DO ! Walk the text strings one character at a time.
- IF (wildtext(wi:wi) == '*') THEN ! How do you match a unique text string?
- DO i = wi, wlen ! Easy: unique up on it!
- IF (wildtext(wi:wi) .EQ. '*') THEN
- wi = wi + 1
- ELSE
- EXIT
- END IF
- END DO
- IF (wildtext(wi:wi) .EQ. NULL) THEN ! "x" matches "*"
- matchw = .TRUE.
- RETURN
- END IF
- IF (wildtext(wi:wi) .NE. '?') THEN
- ! Fast-forward to next possible match.
- DO WHILE (tametext(ti:ti) .NE. wildtext(wi:wi))
- ti = ti + 1
- IF (tametext(ti:ti) .EQ. NULL) THEN
- matchw = .FALSE.
- RETURN ! "x" doesn't match "*y*"
- END IF
- END DO
- END IF
- wbookmark = wildtext(wi:)
- tbookmark = tametext(ti:)
- elseif(tametext(ti:ti) .ne. wildtext(wi:wi) .and. wildtext(wi:wi) .ne. '?') then
- ! Got a non-match. If we've set our bookmarks, back up to one or both of them and retry.
- IF (wbookmark .NE. NULL) THEN
- IF (wildtext(wi:) .NE. wbookmark) THEN
- wildtext = wbookmark;
- wlen = LEN_TRIM(wbookmark)
- wi = 1
- ! Don't go this far back again.
- IF (tametext(ti:ti) .NE. wildtext(wi:wi)) THEN
- tbookmark = tbookmark(2:)
- tametext = tbookmark
- ti = 1
- CYCLE ! "xy" matches "*y"
- ELSE
- wi = wi + 1
- END IF
- END IF
- IF (tametext(ti:ti) .NE. NULL) THEN
- ti = ti + 1
- CYCLE ! "mississippi" matches "*sip*"
- END IF
- END IF
- matchw = .FALSE.
- RETURN ! "xy" doesn't match "x"
- END IF
- ti = ti + 1
- wi = wi + 1
- IF (tametext(ti:ti) .EQ. NULL) THEN ! How do you match a tame text string?
- IF (wildtext(wi:wi) .NE. NULL) THEN
- DO WHILE (wildtext(wi:wi) == '*') ! The tame way: unique up on it!
- wi = wi + 1 ! "x" matches "x*"
- IF (wildtext(wi:wi) .EQ. NULL) EXIT
- END DO
- END IF
- IF (wildtext(wi:wi) .EQ. NULL) THEN
- matchw = .TRUE.
- RETURN ! "x" matches "x"
- END IF
- matchw = .FALSE.
- RETURN ! "x" doesn't match "xy"
- END IF
- END DO
-END FUNCTION matchw
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
-!>NAME
-!!
-!! anyinteger_to_64bit(3f) - [M_anything] convert integer any kind to integer(kind=int64)
-!! (LICENSE:PD)
-!!
-!!SYNOPSIS
-!!
-!! pure elemental function anyinteger_to_64bit(intin) result(ii38)
-!!
-!! integer(kind=int64) function anyinteger_to_64bit(value)
-!! class(*),intent(in) :: intin
-!! integer(kind=int8|int16|int32|int64) :: value
-!!
-!!DESCRIPTION
-!!
-!! This function uses polymorphism to allow arguments of different types
-!! generically. It is used to create other procedures that can take
-!! many scalar arguments as input options, equivalent to passing the
-!! parameter VALUE as int(VALUE,0_int64).
-!!
-!!OPTIONS
-!!
-!! VALUEIN input argument of a procedure to convert to type INTEGER(KIND=int64).
-!! May be of KIND kind=int8, kind=int16, kind=int32, kind=int64.
-!!RESULTS
-!! The value of VALUIN converted to INTEGER(KIND=INT64).
-!!EXAMPLE
-!! Sample program
-!!
-!! program demo_anyinteger_to_64bit
-!! use, intrinsic :: iso_fortran_env, only : int8, int16, int32, int64
-!! implicit none
-!! ! call same function with many scalar input types
-!! write(*,*)squarei(huge(0_int8)),huge(0_int8) , &
-!! & '16129'
-!! write(*,*)squarei(huge(0_int16)),huge(0_int16) , &
-!! & '1073676289'
-!! write(*,*)squarei(huge(0_int32)),huge(0_int32) , &
-!! & '4611686014132420609'
-!! write(*,*)squarei(huge(0_int64)),huge(0_int64) , &
-!! & '85070591730234615847396907784232501249'
-!! contains
-!! !
-!! function squarei(invalue)
-!! use M_anything, only : anyinteger_to_64bit
-!! class(*),intent(in) :: invalue
-!! doubleprecision :: invalue_local
-!! doubleprecision :: squarei
-!! invalue_local=anyinteger_to_64bit(invalue)
-!! squarei=invalue_local*invalue_local
-!! end function squarei
-!! !
-!! end program demo_anyinteger_to_64bit
-!!
-!! Results
-!!
-!! 16129.000000000000 127 \
-!! 16129
-!! 1073676289.0000000 32767 \
-!! 1073676289
-!! 4.6116860141324206E+018 2147483647 \
-!! 4611686014132420609
-!! 8.5070591730234616E+037 9223372036854775807 \
-!! 85070591730234615847396907784232501249
-!! 2.8948022309329049E+076 170141183460469231731687303715884105727 \
-!! 28948022309329048855892746252171976962977213799489202546401021394546514198529
-!!
-!!AUTHOR
-!! John S. Urban
-!!LICENSE
-!! Public Domain
-!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-PURE ELEMENTAL FUNCTION anyinteger_to_64bit(intin) RESULT(ii38)
- USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: ERROR_UNIT !! ,input_unit,output_unit
- IMPLICIT NONE
-
-!!@(#) M_anything::anyinteger_to_64(3f): convert integer parameter of any kind to 64-bit integer
-
- CLASS(*), INTENT(in) :: intin
- INTEGER(kind=INT64) :: ii38
- SELECT TYPE (intin)
- TYPE is (INTEGER(kind=INT8)); ii38 = INT(intin, kind=INT64)
- TYPE is (INTEGER(kind=INT16)); ii38 = INT(intin, kind=INT64)
- TYPE is (INTEGER(kind=INT32)); ii38 = intin
- TYPE is (INTEGER(kind=INT64)); ii38 = intin
- !class default
- !write(error_unit,*)'ERROR: unknown integer type'
- !stop 'ERROR: *anyinteger_to_64* unknown integer type'
- END SELECT
-END FUNCTION anyinteger_to_64bit
-!===================================================================================================================================
-!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
-!===================================================================================================================================
+USE SystemOptions
+USE SystemInterface
+USE SystemSignal_Method
+USE SystemFile_Method
+USE SystemEnvironment_Method
+USE SystemEnquiry_Method
+USE SystemProcess_Method
END MODULE System_Method
diff --git a/src/modules/System/src/System_Utility.F90 b/src/modules/System/src/System_Utility.F90
new file mode 100755
index 000000000..a1aecd964
--- /dev/null
+++ b/src/modules/System/src/System_Utility.F90
@@ -0,0 +1,142 @@
+! This module is mainly taken from the source:
+! https://github.com/urbanjost/M_system.
+! The original name of the program has been changed
+! from M_SYSTEM to System_Method.
+! This is to confirm to the coding sytles of easifem.
+! Original program has been re-organized into module and submodule.
+! If you are using easifem for getting methods defined in this
+! module, then please use M_System module by using the above link.
+! We would like to thank the original author Urban Jost for creating
+! This useful module.
+
+!> author: John S. Urban
+! date: 2026-02-04
+! summary: Fortran interface to C system interface
+!
+!# System_Utility
+!
+! System_Method is a collection of Fortran procedures that call C
+! or a C wrapper using the ISO_C_BINDING interface to access system calls.
+! System calls are a special set of functions used by programs
+! to communicate directly with an operating system.
+
+MODULE System_Utility
+USE ISO_C_BINDING, ONLY: C_INT
+USE ISO_C_BINDING, ONLY: C_PTR
+USE ISO_C_BINDING, ONLY: C_CHAR
+USE GlobalData, ONLY: INT64
+IMPLICIT NONE
+
+PRIVATE
+
+PUBLIC :: Anyinteger_to_64bit
+PUBLIC :: Matchw
+PUBLIC :: Str2_Carr
+PUBLIC :: Arr2Str
+PUBLIC :: C2F_String
+PUBLIC :: TimeStamp
+
+!----------------------------------------------------------------------------
+! Arr2Str@UtilityMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-07
+! summary: convert fortran array to a string
+
+INTERFACE
+ MODULE PURE FUNCTION Arr2Str(array) RESULT(string)
+ CHARACTER(len=1), INTENT(IN) :: array(:)
+ CHARACTER(len=SIZE(array)) :: string
+ END FUNCTION Arr2Str
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! C2F_String@UtilityMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: converts c string to fortran string
+
+INTERFACE
+ MODULE FUNCTION C2F_String(c_string_pointer) RESULT(f_string)
+ TYPE(C_PTR), INTENT(IN) :: c_string_pointer
+ CHARACTER(:), ALLOCATABLE :: f_string
+ END FUNCTION C2F_String
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! Str2_Carr@UtilityMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: convert fortran string into c char array.
+
+INTERFACE
+ MODULE PURE FUNCTION Str2_Carr(string) RESULT(array)
+ CHARACTER(*), INTENT(in) :: string
+ CHARACTER(len=1, kind=C_CHAR) :: array(LEN(string) + 1)
+ END FUNCTION Str2_Carr
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! TimeStamp@UtilityMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: Time stamp method
+
+INTERFACE
+ MODULE FUNCTION TimeStamp() RESULT(epoch)
+ INTEGER(kind=8) :: epoch
+ END FUNCTION TimeStamp
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! Matchw@UtilityMethods
+!----------------------------------------------------------------------------
+
+INTERFACE
+ MODULE FUNCTION Matchw(tame, wild)
+ LOGICAL :: Matchw
+ CHARACTER(*), INTENT(IN) :: tame
+ !! A string without wildcards
+ CHARACTER(*), INTENT(IN) :: wild
+ !! A (potentially) corresponding string with wildcards
+ END FUNCTION Matchw
+END INTERFACE
+
+!----------------------------------------------------------------------------
+! Anyinteger_to_64bit@UtilityMethods
+!----------------------------------------------------------------------------
+
+!> author: Vikas Sharma, Ph. D.
+! date: 2026-02-05
+! summary: Convert integer any kind to integer
+!
+!# Anyinteger_to_64bit
+!
+! This function uses polymorphism to allow arguments of different types
+! generically. It is used to create other procedures that can take
+! many scalar arguments as input options, equivalent to passing the
+! parameter VALUE as INT(VALUE,0_int64).
+
+INTERFACE
+ MODULE PURE ELEMENTAL FUNCTION Anyinteger_to_64bit(intin) RESULT(ii38)
+ CLASS(*), INTENT(in) :: intin
+ !! Input argument of a procedure to convert to type
+ !! INTEGER(KIND=int64). May be of KIND kind=int8, kind=int16,
+ !! kind=int32, kind=int64.
+ INTEGER(INT64) :: ii38
+ !! The value of VALUIN converted to INTEGER(KIND=INT64).
+ END FUNCTION Anyinteger_to_64bit
+END INTERFACE
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+END MODULE System_Utility
diff --git a/src/submodules/CMakeLists.txt b/src/submodules/CMakeLists.txt
index ac3d6e7fb..6a0e2cb91 100644
--- a/src/submodules/CMakeLists.txt
+++ b/src/submodules/CMakeLists.txt
@@ -15,6 +15,9 @@
# this program. If not, see
#
+# System
+include(${CMAKE_CURRENT_LIST_DIR}/System/CMakeLists.txt)
+
# TriangleInterface
include(${CMAKE_CURRENT_LIST_DIR}/TriangleInterface/CMakeLists.txt)
diff --git a/src/submodules/System/CMakeLists.txt b/src/submodules/System/CMakeLists.txt
new file mode 100644
index 000000000..b2a16bed9
--- /dev/null
+++ b/src/submodules/System/CMakeLists.txt
@@ -0,0 +1,30 @@
+# This program is a part of EASIFEM library
+# Expandable And Scalable Infrastructure for Finite Element Methods
+# htttps://www.easifem.com
+# Vikas Sharma, Ph.D., vickysharma0812@gmail.com
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see
+
+set(src_path "${CMAKE_CURRENT_LIST_DIR}/src/")
+
+target_sources(
+ ${PROJECT_NAME}
+ PRIVATE
+ ${src_path}/System_Utility@Methods.F90
+ ${src_path}/SystemSignal_Method@Methods.F90
+ ${src_path}/SystemFile_Method@Methods.F90
+ ${src_path}/SystemEnvironment_Method@Methods.F90
+ ${src_path}/SystemEnquiry_Method@Methods.F90
+ ${src_path}/SystemProcess_Method@Methods.F90
+)
diff --git a/src/submodules/System/src/SystemEnquiry_Method@Methods.F90 b/src/submodules/System/src/SystemEnquiry_Method@Methods.F90
new file mode 100644
index 000000000..f6f479fec
--- /dev/null
+++ b/src/submodules/System/src/SystemEnquiry_Method@Methods.F90
@@ -0,0 +1,163 @@
+! This program is a part of EASIFEM library
+! Expandable And Scalable Infrastructure for Finite Element Methods
+! htttps://www.easifem.com
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see
+
+SUBMODULE(SystemEnquiry_Method) Methods
+USE ISO_C_BINDING, ONLY: C_SIZE_T
+USE ISO_C_BINDING, ONLY: C_ASSOCIATED
+USE System_Utility, ONLY: Arr2Str
+USE System_Utility, ONLY: Str2_Carr
+USE SystemInterface, ONLY: C_Access
+USE SystemInterface, ONLY: C_Issock
+USE SystemInterface, ONLY: C_Isfifo
+USE SystemInterface, ONLY: C_Ischr
+USE SystemInterface, ONLY: C_Isreg
+USE SystemInterface, ONLY: C_Islnk
+USE SystemInterface, ONLY: C_Isblk
+USE SystemInterface, ONLY: C_Isdir
+
+IMPLICIT NONE
+CONTAINS
+
+!----------------------------------------------------------------------------
+! System_Access
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Access
+LOGICAL :: isok
+
+isok = C_Access(str2_carr(TRIM(pathname)), INT(amode, kind=C_INT)) .EQ. 0
+IF (isok) THEN
+ system_access = .TRUE.
+ELSE
+ system_access = .FALSE.
+END IF
+END PROCEDURE System_Access
+
+!----------------------------------------------------------------------------
+! System_Issock
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Issock
+LOGICAL :: isok
+
+isok = C_Issock(Str2_Carr(TRIM(pathname))) .EQ. 1
+
+IF (isok) THEN
+ System_Issock = .TRUE.
+ELSE
+ System_Issock = .FALSE.
+END IF
+END PROCEDURE System_Issock
+
+!----------------------------------------------------------------------------
+! System_Isfifo
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Isfifo
+LOGICAL :: isok
+
+isok = C_Isfifo(Str2_Carr(TRIM(pathname))) .EQ. 1
+
+IF (isok) THEN
+ System_Isfifo = .TRUE.
+ELSE
+ System_Isfifo = .FALSE.
+END IF
+
+END PROCEDURE System_Isfifo
+
+!----------------------------------------------------------------------------
+! System_Ischr
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Ischr
+LOGICAL :: isok
+
+isok = C_Ischr(Str2_Carr(TRIM(pathname))) .EQ. 1
+IF (isok) THEN
+ System_Ischr = .TRUE.
+ELSE
+ System_Ischr = .FALSE.
+END IF
+END PROCEDURE System_Ischr
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Isreg
+LOGICAL :: isok
+
+isok = C_Isreg(Str2_Carr(TRIM(pathname))) .EQ. 1
+IF (isok) THEN
+ System_Isreg = .TRUE.
+ELSE
+ System_Isreg = .FALSE.
+END IF
+END PROCEDURE System_Isreg
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Islnk
+LOGICAL :: isok
+
+isok = C_Islnk(Str2_Carr(TRIM(pathname))) .EQ. 1
+IF (isok) THEN
+ System_Islnk = .TRUE.
+ELSE
+ System_Islnk = .FALSE.
+END IF
+END PROCEDURE System_Islnk
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Isblk
+LOGICAL :: isok
+
+isok = C_Isblk(Str2_Carr(TRIM(pathname))) .EQ. 1
+IF (isok) THEN
+ System_Isblk = .TRUE.
+ELSE
+ System_Isblk = .FALSE.
+END IF
+END PROCEDURE System_Isblk
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Isdir
+LOGICAL :: isok
+
+isok = C_Isdir(Str2_Carr(TRIM(dirname))) .EQ. 1
+
+IF (isok) THEN
+ System_Isdir = .TRUE.
+ELSE
+ System_Isdir = .FALSE.
+END IF
+END PROCEDURE System_Isdir
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+END SUBMODULE Methods
diff --git a/src/submodules/System/src/SystemEnvironment_Method@Methods.F90 b/src/submodules/System/src/SystemEnvironment_Method@Methods.F90
new file mode 100644
index 000000000..56fac5cf0
--- /dev/null
+++ b/src/submodules/System/src/SystemEnvironment_Method@Methods.F90
@@ -0,0 +1,170 @@
+! This program is a part of EASIFEM library
+! Expandable And Scalable Infrastructure for Finite Element Methods
+! htttps://www.easifem.com
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see
+!
+SUBMODULE(SystemEnvironment_Method) Methods
+USE ISO_C_BINDING, ONLY: C_SIZE_T
+USE ISO_C_BINDING, ONLY: C_INT
+USE ISO_C_BINDING, ONLY: C_CHAR
+USE ISO_C_BINDING, ONLY: C_NULL_CHAR
+USE System_Utility, ONLY: Arr2Str
+USE System_Utility, ONLY: Str2_Carr
+USE SystemInterface, ONLY: C_Setenv
+USE SystemInterface, ONLY: C_Unsetenv
+USE SystemInterface, ONLY: C_Readenv
+USE SystemInterface, ONLY: C_Putenv
+USE SystemInterface, ONLY: System_Initenv
+IMPLICIT NONE
+
+CONTAINS
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Putenv
+INTEGER :: Loc_Err
+INTEGER :: i
+! PUTENV actually adds the data to the environment so the string passed
+! should be saved or will vanish on exit
+CHARACTER(len=1, kind=C_CHAR), SAVE, POINTER :: memleak(:)
+
+ALLOCATE (memleak(LEN(string) + 1))
+DO i = 1, LEN(string)
+ memleak(i) = string(i:i)
+END DO
+memleak(LEN(string) + 1) = C_NULL_CHAR
+
+Loc_Err = C_Putenv(memleak)
+IF (PRESENT(err)) err = Loc_Err
+END PROCEDURE System_Putenv
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Getenv
+INTEGER :: howbig
+INTEGER :: stat
+
+IF (NAME .NE. '') THEN
+ CALL GET_ENVIRONMENT_VARIABLE(name, length=howbig, status=stat, &
+ Trim_Name=.TRUE.)
+ ! get length required to hold value
+ IF (howbig .NE. 0) THEN
+ SELECT CASE (stat)
+ CASE (1)
+ ! print *, NAME, " is not defined in the environment. Strange..."
+ VALUE = ''
+ CASE (2)
+ ! print *, "This processor doesn't support environment variables.
+ ! Boooh!"
+ VALUE = ''
+ CASE DEFAULT
+ ! make string to hold value of sufficient size and get value
+ IF (ALLOCATED(VALUE)) DEALLOCATE (VALUE)
+ ALLOCATE (CHARACTER(len=MAX(howbig, 1)) :: VALUE)
+ CALL GET_ENVIRONMENT_VARIABLE(name, VALUE, &
+ status=stat, trim_name=.TRUE.)
+ IF (stat .NE. 0) VALUE = ''
+ END SELECT
+ ELSE
+ VALUE = ''
+ END IF
+ELSE
+ VALUE = ''
+END IF
+IF (VALUE .EQ. '' .AND. PRESENT(default)) VALUE = default
+END PROCEDURE System_Getenv
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE Set_Environment_Variable
+INTEGER :: loc_err
+loc_err = C_Setenv(Str2_Carr(TRIM(NAME)), Str2_Carr(VALUE))
+IF (PRESENT(STATUS)) STATUS = Loc_Err
+END PROCEDURE Set_Environment_Variable
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Clearenv
+! emulating because not available on some platforms
+CHARACTER(len=:), ALLOCATABLE :: string
+INTEGER :: ierr_local1, ierr_local2
+
+ierr_local2 = 0
+
+INFINITE: DO
+ CALL System_Initenv()
+ ! important -- changing table causes undefined behavior
+ ! so reset after each unsetenv
+ string = System_Readenv()
+ ! get first name=value pair
+ IF (string .EQ. '') EXIT INFINITE
+ CALL System_Unsetenv(string(1:INDEX(string, '=') - 1), Ierr_Local1)
+ ! remove first name=value pair
+ IF (Ierr_Local1 .NE. 0) Ierr_Local2 = Ierr_Local1
+END DO INFINITE
+
+IF (PRESENT(ierr)) THEN
+ ierr = Ierr_Local2
+ELSEIF (Ierr_Local2 .NE. 0) THEN
+ ! if error occurs and not being returned, stop
+ WRITE (*, *) '*System_Clearenv* error=', Ierr_Local2
+ STOP
+END IF
+END PROCEDURE System_Clearenv
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Unsetenv
+INTEGER :: ierr_local
+
+ierr_local = C_Unsetenv(Str2_Carr(TRIM(NAME)))
+
+IF (PRESENT(ierr)) THEN
+ ierr = Ierr_Local
+ELSEIF (Ierr_Local .NE. 0) THEN
+ ! if error occurs and not being returned, stop
+ WRITE (*, *) '*System_Unsetenv* error=', Ierr_Local
+ STOP
+END IF
+END PROCEDURE System_Unsetenv
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Readenv
+CHARACTER(kind=C_CHAR) :: C_Buff(LONGEST_ENV_VARIABLE + 1)
+
+C_Buff = ' '
+C_Buff(Longest_env_Variable + 1:Longest_env_Variable + 1) = C_NULL_CHAR
+CALL C_Readenv(C_Buff)
+string = TRIM(arr2str(C_Buff))
+END PROCEDURE System_Readenv
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+END SUBMODULE Methods
diff --git a/src/submodules/System/src/SystemFile_Method@Methods.F90 b/src/submodules/System/src/SystemFile_Method@Methods.F90
new file mode 100644
index 000000000..5e13cd7f4
--- /dev/null
+++ b/src/submodules/System/src/SystemFile_Method@Methods.F90
@@ -0,0 +1,452 @@
+! This program is a part of EASIFEM library
+! Expandable And Scalable Infrastructure for Finite Element Methods
+! htttps://www.easifem.com
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see
+!
+
+SUBMODULE(SystemFile_Method) Methods
+USE ISO_C_BINDING, ONLY: C_ASSOCIATED
+USE ISO_C_BINDING, ONLY: C_SIZE_T
+USE ISO_C_BINDING, ONLY: C_LONG
+USE ISO_C_BINDING, ONLY: C_CHAR
+USE System_Utility, ONLY: Matchw
+USE System_Utility, ONLY: Arr2Str
+USE System_Utility, ONLY: C2F_String
+USE System_Utility, ONLY: Str2_Carr
+USE System_Utility, ONLY: TimeStamp
+
+USE SystemInterface, ONLY: C_Utime
+USE SystemInterface, ONLY: C_RealPath
+USE SystemInterface, ONLY: C_Chown
+USE SystemInterface, ONLY: C_Link
+USE SystemInterface, ONLY: C_Unlink
+USE SystemInterface, ONLY: C_Chdir
+USE SystemInterface, ONLY: C_Remove
+USE SystemInterface, ONLY: C_Rename
+USE SystemInterface, ONLY: C_Chmod
+USE SystemInterface, ONLY: System_Getpid
+USE SystemInterface, ONLY: System_Errno
+USE SystemInterface, ONLY: System_Umask
+
+IMPLICIT NONE
+
+CONTAINS
+
+!----------------------------------------------------------------------------
+! System_Utime
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Utime
+INTEGER(kind=8) :: times_local(2)
+LOGICAL :: isok
+
+!-! int my_utime(const char *path, int times[2])
+IF (PRESENT(times)) THEN
+ times_local = times
+ELSE
+ times_local = timestamp()
+END IF
+
+isok = C_Utime(Str2_Carr(TRIM(pathname)), INT(Times_Local, kind=C_INT)) &
+ .EQ. 0
+
+IF (isok) THEN
+ system_utime = .TRUE.
+ELSE
+ system_utime = .FALSE.
+END IF
+END PROCEDURE System_Utime
+
+!----------------------------------------------------------------------------
+! System_RealPath
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_RealPath
+TYPE(C_PTR) :: c_output
+c_output = C_RealPath(str2_carr(TRIM(input)))
+IF (.NOT. C_ASSOCIATED(c_output)) THEN
+ string = CHAR(0)
+ELSE
+ string = C2F_string(c_output)
+END IF
+END PROCEDURE System_RealPath
+
+!----------------------------------------------------------------------------
+! System_Chown
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Chown
+LOGICAL :: isok
+
+isok = C_Chown( &
+ Str2_Carr(TRIM(dirname)), &
+ INT(owner, kind=C_INT), &
+ INT(group, kind=C_INT)) .EQ. 1
+
+IF (isok) THEN
+ System_Chown = .TRUE.
+ELSE
+ System_Chown = .FALSE.
+END IF
+
+END PROCEDURE System_Chown
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE system_link
+INTEGER(C_INT) :: c_ierr
+C_Ierr = C_Link(Str2_Carr(TRIM(oldname)), Str2_Carr(TRIM(newname)))
+ierr = c_ierr
+END PROCEDURE system_link
+
+!----------------------------------------------------------------------------
+! System_Unlink
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Unlink
+ierr = C_Unlink(Str2_Carr(TRIM(fname)))
+END PROCEDURE System_Unlink
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Setumask
+INTEGER(C_INT) :: Umask_C
+Umask_C = Umask_Value
+Old_Umask = System_Umask(Umask_C)
+END PROCEDURE System_Setumask
+
+!----------------------------------------------------------------------------
+! System_Chdir
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Chdir
+INTEGER :: Loc_Err
+Loc_Err = C_Chdir(Str2_Carr(TRIM(path)))
+IF (PRESENT(err)) THEN
+ err = Loc_Err
+END IF
+END PROCEDURE System_Chdir
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Remove
+err = C_Remove(Str2_Carr(TRIM(path)))
+END PROCEDURE System_Remove
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Rename
+ierr = C_Rename(Str2_Carr(TRIM(input)), Str2_Carr(TRIM(output)))
+END PROCEDURE System_Rename
+
+!----------------------------------------------------------------------------
+! System_Chmod
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Chmod
+ierr = C_Chmod(Str2_Carr(TRIM(filename)), INT(mode, KIND(0_C_INT)))
+END PROCEDURE System_Chmod
+
+!----------------------------------------------------------------------------
+! System_Getcwd
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE system_getcwd
+INTEGER(kind=C_LONG), PARAMETER :: length = 4097_C_LONG
+CHARACTER(kind=C_CHAR, len=1) :: buffer(length)
+TYPE(C_PTR) :: buffer2
+INTERFACE
+ FUNCTION c_getcwd(buffer, size) BIND(c, name="getcwd") RESULT(buffer_result)
+ IMPORT C_CHAR, C_SIZE_T, C_PTR
+ CHARACTER(kind=C_CHAR), INTENT(out) :: buffer(*)
+ INTEGER(C_SIZE_T), VALUE, INTENT(in) :: size
+ TYPE(C_PTR) :: buffer_result
+ END FUNCTION
+END INTERFACE
+
+buffer = ' '
+buffer2 = c_getcwd(buffer, length)
+IF (.NOT. C_ASSOCIATED(buffer2)) THEN
+ output = ''
+ ierr = -1
+ELSE
+ output = TRIM(arr2str(buffer))
+ ierr = 0
+END IF
+END PROCEDURE system_getcwd
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE system_rmdir
+INTERFACE
+ FUNCTION c_rmdir(c_path) BIND(c, name="rmdir") RESULT(c_err)
+ IMPORT C_CHAR, C_INT
+ CHARACTER(kind=C_CHAR, len=1), INTENT(in) :: c_path(*)
+ INTEGER(C_INT) :: c_err
+ END FUNCTION
+END INTERFACE
+
+err = c_rmdir(str2_carr(TRIM(dirname)))
+IF (err .NE. 0) err = system_errno()
+END PROCEDURE system_rmdir
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE system_mkfifo
+INTEGER :: c_mode
+INTERFACE
+ FUNCTION c_mkfifo(c_path, c_mode) BIND(c, name="mkfifo") RESULT(c_err)
+ IMPORT C_CHAR, C_INT
+ CHARACTER(len=1, kind=C_CHAR), INTENT(in) :: c_path(*)
+ INTEGER(C_INT), INTENT(in), VALUE :: c_mode
+ INTEGER(C_INT) :: c_err
+ END FUNCTION c_mkfifo
+END INTERFACE
+
+c_mode = mode
+err = c_mkfifo(str2_carr(TRIM(pathname)), c_mode)
+END PROCEDURE system_mkfifo
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE system_mkdir
+INTEGER :: c_mode
+INTEGER(kind=C_INT) :: err
+
+INTERFACE
+ FUNCTION c_mkdir(c_path, c_mode) BIND(c, name="mkdir") RESULT(c_err)
+ IMPORT C_CHAR, C_INT
+ CHARACTER(len=1, kind=C_CHAR), INTENT(in) :: c_path(*)
+ INTEGER(C_INT), INTENT(in), VALUE :: c_mode
+ INTEGER(C_INT) :: c_err
+ END FUNCTION c_mkdir
+END INTERFACE
+
+INTERFACE
+ SUBROUTINE my_mkdir(string, c_mode, c_err) BIND(C, name="my_mkdir")
+ USE ISO_C_BINDING, ONLY: C_CHAR, C_INT
+ CHARACTER(kind=C_CHAR) :: string(*)
+ INTEGER(C_INT), INTENT(in), VALUE :: c_mode
+ INTEGER(C_INT) :: c_err
+ END SUBROUTINE my_mkdir
+END INTERFACE
+
+c_mode = mode
+IF (INDEX(dirname, '/') .NE. 0) THEN
+ CALL my_mkdir(str2_carr(TRIM(dirname)), c_mode, err)
+ELSE
+ err = c_mkdir(str2_carr(TRIM(dirname)), c_mode)
+END IF
+ierr = err ! c_int to default integer kind
+END PROCEDURE system_mkdir
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE system_opendir
+INTERFACE
+ FUNCTION c_opendir(c_dirname) BIND(c, name="opendir") RESULT(c_dir)
+ IMPORT C_CHAR, C_INT, C_PTR
+ CHARACTER(kind=C_CHAR), INTENT(in) :: c_dirname(*)
+ TYPE(C_PTR) :: c_dir
+ END FUNCTION c_opendir
+END INTERFACE
+
+ierr = 0
+dir = c_opendir(str2_carr(TRIM(dirname)))
+IF (.NOT. C_ASSOCIATED(dir)) THEN
+ WRITE (*, '(a)') '*system_opendir* Error opening '//TRIM(dirname)
+ ierr = -1
+END IF
+END PROCEDURE system_opendir
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE system_readdir
+INTEGER(kind=C_INT) :: ierr_local
+CHARACTER(kind=C_CHAR, len=1) :: buf(4097)
+
+INTERFACE
+ SUBROUTINE c_readdir(c_dir, c_filename, c_ierr) BIND(C, NAME='my_readdir')
+ IMPORT C_CHAR, C_INT, C_PTR
+ TYPE(C_PTR), VALUE :: c_dir
+ CHARACTER(kind=C_CHAR) :: c_filename(*)
+ INTEGER(kind=C_INT) :: c_ierr
+ END SUBROUTINE c_readdir
+END INTERFACE
+
+buf = ' '
+ierr_local = 0
+CALL c_readdir(dir, buf, ierr_local)
+filename = TRIM(arr2str(buf))
+ierr = ierr_local
+END PROCEDURE system_readdir
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE system_rewinddir
+INTERFACE
+ SUBROUTINE c_rewinddir(c_dir) BIND(c, name="rewinddir")
+ IMPORT C_CHAR, C_INT, C_PTR
+ TYPE(C_PTR), VALUE :: c_dir
+ END SUBROUTINE c_rewinddir
+END INTERFACE
+
+CALL c_rewinddir(dir)
+END PROCEDURE system_rewinddir
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE system_closedir
+INTEGER :: ierr_local
+
+INTERFACE
+ FUNCTION c_closedir(c_dir) BIND(c, name="closedir") RESULT(c_err)
+ IMPORT C_CHAR, C_INT, C_PTR
+ TYPE(C_PTR), VALUE :: c_dir
+ INTEGER(kind=C_INT) :: c_err
+ END FUNCTION c_closedir
+END INTERFACE
+
+ierr_local = c_closedir(dir)
+IF (PRESENT(ierr)) THEN
+ ierr = ierr_local
+ELSE
+ IF (ierr_local /= 0) THEN
+ PRINT *, "*system_closedir* error", ierr_local
+ STOP 3
+ END IF
+END IF
+END PROCEDURE system_closedir
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE fileglob
+CHARACTER(len=255) :: tmpfile
+! scratch filename to hold expanded file list
+CHARACTER(len=255) :: cmd
+! string to build system command in
+INTEGER :: iotmp
+! needed to open unique scratch file for holding file list
+INTEGER :: i, ios, icount
+write(tmpfile,'(*(g0))')'/tmp/__filelist_',timestamp(),'_',system_getpid()
+! preliminary scratch file name
+cmd = 'ls -d '//TRIM(glob)//'>'//TRIM(tmpfile)//' '
+! build command string
+CALL execute_command_line(cmd)
+! Execute the command specified by the string.
+OPEN (newunit=iotmp, file=tmpfile, iostat=ios)
+! open unique scratch filename
+IF (ios .NE. 0) RETURN
+! the open failed
+icount = 0
+! number of filenames in expanded list
+DO
+! count the number of lines (assumed ==files) so know what to allocate
+ READ (iotmp, '(a)', iostat=ios)
+ ! move down a line in the file to count number of lines
+ IF (ios .NE. 0) EXIT
+ ! hopefully, this is because end of file was encountered so done
+ icount = icount + 1
+ ! increment line count
+END DO
+REWIND (iotmp)
+! rewind file list so can read and store it
+ALLOCATE (list(icount))
+! allocate and fill the array
+DO i = 1, icount
+ READ (iotmp, '(a)') list(i)
+ ! read a filename from a line
+END DO
+CLOSE (iotmp, status='delete', iostat=ios)
+! close and delete scratch file
+END PROCEDURE fileglob
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE system_dir
+CHARACTER(len=:), ALLOCATABLE :: wild
+TYPE(C_PTR) :: dir
+CHARACTER(len=:), ALLOCATABLE :: filename
+INTEGER :: i, ierr, icount, longest
+longest = 0
+icount = 0
+IF (PRESENT(pattern)) THEN
+ wild = pattern
+ELSE
+ wild = '*'
+END IF
+IF (PRESENT(directory)) THEN !--- open directory stream to read from
+ CALL system_opendir(directory, dir, ierr)
+ELSE
+ CALL system_opendir('.', dir, ierr)
+END IF
+IF (ierr .EQ. 0) THEN
+ DO i = 1, 2 !--- read directory stream twice, first time to get size
+ DO
+ CALL system_readdir(dir, filename, ierr)
+ IF (filename .EQ. ' ') EXIT
+ IF (wild .NE. '*') THEN
+ IF (.NOT. matchw(filename, wild)) CYCLE ! Call a wildcard matching routine.
+ END IF
+ icount = icount + 1
+ SELECT CASE (i)
+ CASE (1)
+ longest = MAX(longest, LEN(filename))
+ CASE (2)
+ system_dir(icount) = filename
+ END SELECT
+ END DO
+ IF (i .EQ. 1) THEN
+ CALL system_rewinddir(dir)
+ IF (ALLOCATED(system_dir)) DEALLOCATE (system_dir)
+ ALLOCATE (CHARACTER(len=longest) :: system_dir(icount))
+ icount = 0
+ END IF
+ END DO
+END IF
+CALL system_closedir(dir, ierr) !--- close directory stream
+END PROCEDURE system_dir
+
+!----------------------------------------------------------------------------
+! Include Error
+!----------------------------------------------------------------------------
+
+END SUBMODULE Methods
diff --git a/src/submodules/System/src/SystemProcess_Method@Methods.F90 b/src/submodules/System/src/SystemProcess_Method@Methods.F90
new file mode 100644
index 000000000..5736b4be1
--- /dev/null
+++ b/src/submodules/System/src/SystemProcess_Method@Methods.F90
@@ -0,0 +1,198 @@
+! This program is a part of EASIFEM library
+! Expandable And Scalable Infrastructure for Finite Element Methods
+! htttps://www.easifem.com
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see
+
+SUBMODULE(SystemProcess_Method) Methods
+USE ISO_FORTRAN_ENV, ONLY: ERROR_UNIT, INPUT_UNIT, OUTPUT_UNIT
+USE ISO_C_BINDING, ONLY: C_LONG_LONG
+USE ISO_C_BINDING, ONLY: C_SIZE_T
+USE ISO_C_BINDING, ONLY: C_ASSOCIATED
+USE System_Utility, ONLY: Anyinteger_to_64bit
+USE System_Utility, ONLY: Arr2Str
+USE System_Utility, ONLY: C2F_String
+USE System_Utility, ONLY: Str2_Carr
+USE SystemInterface, ONLY: C_CPU_Time
+USE SystemInterface, ONLY: System_Umask
+USE SystemInterface, ONLY: C_Perror
+USE SystemInterface, ONLY: C_Flush
+USE SystemInterface, ONLY: C_Uname
+USE SystemInterface, ONLY: C_Gethostname
+USE SystemInterface, ONLY: C_Getlogin
+USE SystemInterface, ONLY: C_Perm
+USE SystemInterface, ONLY: C_Getgrgid
+USE SystemInterface, ONLY: C_Getpwuid
+USE SystemInterface, ONLY: C_Stat
+USE SystemInterface, ONLY: System_Geteuid
+
+IMPLICIT NONE
+CONTAINS
+
+!----------------------------------------------------------------------------
+! system_cpu_time
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_CPU_Time
+REAL(C_FLOAT) :: C_User, C_System, C_Total
+
+CALL C_CPU_Time(C_Total, C_User, C_System)
+user = C_User
+system = C_System
+total = C_Total
+END PROCEDURE System_CPU_Time
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Getumask
+INTEGER :: idum
+INTEGER(C_INT) :: Old_Umask
+
+Old_Umask = System_Umask(0_C_INT)
+! get current umask but by setting umask to 0
+! (a conservative mask so no vulnerability is open)
+idum = System_Umask(Old_Umask)
+! set back to original mask
+Umask_Value = Old_Umask
+END PROCEDURE System_Getumask
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Perror
+INTEGER :: ios
+FLUSH (unit=ERROR_UNIT, iostat=ios)
+FLUSH (unit=OUTPUT_UNIT, iostat=ios)
+FLUSH (unit=INPUT_UNIT, iostat=ios)
+CALL C_Perror(Str2_Carr((TRIM(prefix))))
+CALL C_Flush()
+END PROCEDURE System_Perror
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Uname
+NAMEOUT = 'unknown'
+CALL C_Uname(WHICH, NAMEOUT, INT(LEN(NAMEOUT), KIND(0_C_INT)))
+END PROCEDURE System_Uname
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Gethostname
+CHARACTER(kind=C_CHAR, len=1) :: C_BUFF(HOST_NAME_MAX + 1)
+C_BUFF = ' '
+ierr = C_Gethostname(C_BUFF, HOST_NAME_MAX)
+! Host names are limited to {HOST_NAME_MAX} bytes.
+NAME = TRIM(arr2str(C_BUFF))
+END PROCEDURE System_Gethostname
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Getlogin
+TYPE(C_PTR) :: username
+username = C_Getlogin()
+IF (.NOT. C_ASSOCIATED(username)) THEN
+ ! In windows 10 subsystem running Ubunto does not work
+ !write(*,'(a)')'*System_Getlogin* Error getting username. not associated'
+ !fname=C_null_Char
+ fname = System_Getpwuid(System_Geteuid())
+ELSE
+ fname = C2f_String(username)
+END IF
+END PROCEDURE System_Getlogin
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Perm
+TYPE(C_PTR) :: permissions
+INTEGER(C_LONG) :: Mode_Local
+
+Mode_Local = INT(Anyinteger_to_64bit(mode), kind=C_LONG)
+permissions = C_Perm(Mode_Local)
+IF (.NOT. C_ASSOCIATED(permissions)) THEN
+ WRITE (*, '(a)') '*System_Perm* Error getting permissions. not associated'
+ perms = C_NULL_CHAR
+ELSE
+ perms = C2f_String(permissions)
+END IF
+END PROCEDURE System_Perm
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Getgrgid
+CHARACTER(kind=C_CHAR, len=1) :: groupname(4097)
+! assumed long enough for any groupname
+INTEGER :: ierr
+INTEGER(C_LONG_LONG) :: Gid_Local
+
+Gid_Local = Anyinteger_to_64bit(gid)
+ierr = C_Getgrgid(Gid_Local, groupname)
+IF (ierr .EQ. 0) THEN
+ gname = TRIM(arr2str(groupname))
+ELSE
+ gname = ''
+END IF
+END PROCEDURE System_Getgrgid
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Getpwuid
+CHARACTER(kind=C_CHAR, len=1) :: username(4097)
+! assumed long enough for any username
+INTEGER :: ierr
+INTEGER(kind=C_LONG_LONG) :: Uid_Local
+
+Uid_Local = Anyinteger_to_64bit(uid)
+ierr = C_Getpwuid(Uid_Local, username)
+IF (ierr .EQ. 0) THEN
+ uname = TRIM(arr2str(username))
+ELSE
+ uname = ''
+END IF
+END PROCEDURE System_Getpwuid
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Stat
+INTEGER(kind=C_LONG) :: cvalues(13)
+INTEGER(kind=C_INT) :: cierr
+
+CALL C_Stat(Str2_Carr(TRIM(pathname)), cvalues, cierr, 0_C_INT)
+values = cvalues
+IF (PRESENT(ierr)) THEN
+ ierr = cierr
+END IF
+END PROCEDURE System_Stat
+
+!----------------------------------------------------------------------------
+! Include error
+!----------------------------------------------------------------------------
+
+END SUBMODULE Methods
diff --git a/src/submodules/System/src/SystemSignal_Method@Methods.F90 b/src/submodules/System/src/SystemSignal_Method@Methods.F90
new file mode 100644
index 000000000..b91a2931a
--- /dev/null
+++ b/src/submodules/System/src/SystemSignal_Method@Methods.F90
@@ -0,0 +1,55 @@
+! This program is a part of EASIFEM library
+! Expandable And Scalable Infrastructure for Finite Element Methods
+! htttps://www.easifem.com
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see
+
+SUBMODULE(SystemSignal_Method) Methods
+USE ISO_C_BINDING, ONLY: C_FUNLOC
+USE SystemInterface, ONLY: C_Signal
+IMPLICIT NONE
+
+CONTAINS
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE f_handler
+LOGICAL :: isok
+
+isok = ASSOCIATED(handler_ptr_array(signum)%sub)
+IF (isok) THEN
+ CALL handler_ptr_array(signum)%sub(signum)
+END IF
+END PROCEDURE f_handler
+
+!----------------------------------------------------------------------------
+! System_Signal
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE System_Signal
+TYPE(C_FUNPTR) :: ret, c_handler
+
+IF (PRESENT(handler_routine)) THEN
+ handler_ptr_array(signum)%sub => handler_routine
+ELSE
+ handler_ptr_array(signum)%sub => NULL()
+END IF
+
+c_handler = C_FUNLOC(f_handler)
+ret = C_Signal(signum, c_handler)
+END PROCEDURE System_Signal
+
+END SUBMODULE Methods
diff --git a/src/submodules/System/src/System_Utility@Methods.F90 b/src/submodules/System/src/System_Utility@Methods.F90
new file mode 100644
index 000000000..9f7d9645f
--- /dev/null
+++ b/src/submodules/System/src/System_Utility@Methods.F90
@@ -0,0 +1,235 @@
+! This program is a part of EASIFEM library
+! Expandable And Scalable Infrastructure for Finite Element Methods
+! htttps://www.easifem.com
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see
+
+SUBMODULE(System_Utility) Methods
+USE ISO_FORTRAN_ENV, ONLY: ERROR_UNIT
+USE ISO_C_BINDING, ONLY: C_NULL_CHAR
+USE ISO_C_BINDING, ONLY: C_F_POINTER
+USE SystemInterface, ONLY: C_Time
+USE GlobalData, ONLY: INT8, INT16, INT32
+
+IMPLICIT NONE
+CONTAINS
+
+!----------------------------------------------------------------------------
+! C2F_String
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE C2F_String
+CHARACTER(kind=C_CHAR), POINTER :: &
+ char_array_pointer(:) => NULL()
+INTEGER, PARAMETER :: max_len = 4096
+CHARACTER(max_len) :: aux_string
+INTEGER :: i
+INTEGER :: length
+
+length = 0
+CALL C_F_POINTER(c_string_pointer, char_array_pointer, [max_len])
+
+IF (.NOT. ASSOCIATED(char_array_pointer)) THEN
+ IF (ALLOCATED(f_string)) DEALLOCATE (f_string)
+ ALLOCATE (CHARACTER(len=4) :: f_string)
+ f_string = C_NULL_CHAR
+ RETURN
+END IF
+
+aux_string = " "
+
+DO i = 1, max_len
+ IF (char_array_pointer(i) == C_NULL_CHAR) THEN
+ length = i - 1
+ EXIT
+ END IF
+ aux_string(i:i) = char_array_pointer(i)
+END DO
+
+IF (ALLOCATED(f_string)) DEALLOCATE (f_string)
+ALLOCATE (CHARACTER(len=length) :: f_string)
+f_string = aux_string(1:length)
+END PROCEDURE C2F_String
+
+!----------------------------------------------------------------------------
+! Str2_Carr
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE Str2_Carr
+INTEGER :: i
+DO i = 1, LEN_TRIM(string)
+ array(i) = string(i:i)
+END DO
+array(i:i) = C_NULL_CHAR
+END PROCEDURE Str2_Carr
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE Timestamp
+epoch = C_Time(INT(0, kind=8))
+END PROCEDURE Timestamp
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE Arr2Str
+INTEGER :: i
+
+string = ' '
+DO i = 1, SIZE(array)
+ IF (array(i) .EQ. CHAR(0)) THEN
+ EXIT
+ ELSE
+ string(i:i) = array(i)
+ END IF
+END DO
+END PROCEDURE Arr2Str
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE Matchw
+CHARACTER(len=LEN(tame) + 1) :: tametext
+CHARACTER(len=LEN(wild) + 1) :: wildtext
+CHARACTER(len=1), PARAMETER :: NULL = CHAR(0)
+INTEGER :: wlen, ti, wi, i
+CHARACTER(len=:), ALLOCATABLE :: tbookmark, wbookmark
+
+! These two values are set when we observe a wildcard character. They
+! represent the locations, in the two strings, from which we start once
+! we've observed it.
+tametext = tame//NULL
+wildtext = wild//NULL
+tbookmark = NULL
+wbookmark = NULL
+wlen = LEN(wild)
+wi = 1
+ti = 1
+DO
+! Walk the text strings one character at a time.
+ IF (wildtext(wi:wi) == '*') THEN
+ ! How do you match a unique text string?
+ DO i = wi, wlen
+ ! Easy: unique up on it!
+ IF (wildtext(wi:wi) .EQ. '*') THEN
+ wi = wi + 1
+ ELSE
+ EXIT
+ END IF
+ END DO
+ IF (wildtext(wi:wi) .EQ. NULL) THEN
+ ! "x" matches "*"
+ Matchw = .TRUE.
+ RETURN
+ END IF
+ IF (wildtext(wi:wi) .NE. '?') THEN
+ ! Fast-forward to next possible match.
+ DO WHILE (tametext(ti:ti) .NE. wildtext(wi:wi))
+ ti = ti + 1
+ IF (tametext(ti:ti) .EQ. NULL) THEN
+ Matchw = .FALSE.
+ RETURN
+ ! "x" doesn't match "*y*"
+ END IF
+ END DO
+ END IF
+ wbookmark = wildtext(wi:)
+ tbookmark = tametext(ti:)
+ ELSEIF ((tametext(ti:ti) .NE. wildtext(wi:wi)) &
+ .AND. (wildtext(wi:wi) .NE. '?')) THEN
+ ! Got a non-match. If we've set our bookmarks,
+ ! back up to one or both of them and retry.
+ IF (wbookmark .NE. NULL) THEN
+ IF (wildtext(wi:) .NE. wbookmark) THEN
+ wildtext = wbookmark
+ wlen = LEN_TRIM(wbookmark)
+ wi = 1
+ ! Don't go this far back again.
+ IF (tametext(ti:ti) .NE. wildtext(wi:wi)) THEN
+ tbookmark = tbookmark(2:)
+ tametext = tbookmark
+ ti = 1
+ CYCLE
+ ! "xy" matches "*y"
+ ELSE
+ wi = wi + 1
+ END IF
+ END IF
+ IF (tametext(ti:ti) .NE. NULL) THEN
+ ti = ti + 1
+ CYCLE
+ ! "mississippi" matches "*sip*"
+ END IF
+ END IF
+ Matchw = .FALSE.
+ RETURN
+ ! "xy" doesn't match "x"
+ END IF
+ ti = ti + 1
+ wi = wi + 1
+ IF (tametext(ti:ti) .EQ. NULL) THEN
+ ! How do you match a tame text string?
+ IF (wildtext(wi:wi) .NE. NULL) THEN
+ DO WHILE (wildtext(wi:wi) == '*')
+ ! The tame way: unique up on it!
+ wi = wi + 1
+ ! "x" matches "x*"
+ IF (wildtext(wi:wi) .EQ. NULL) EXIT
+ END DO
+ END IF
+ IF (wildtext(wi:wi) .EQ. NULL) THEN
+ Matchw = .TRUE.
+ RETURN
+ ! "x" matches "x"
+ END IF
+ Matchw = .FALSE.
+ RETURN
+ ! "x" doesn't match "xy"
+ END IF
+END DO
+END PROCEDURE Matchw
+
+!----------------------------------------------------------------------------
+!
+!----------------------------------------------------------------------------
+
+MODULE PROCEDURE Anyinteger_to_64bit
+SELECT TYPE (intin)
+TYPE IS (INTEGER(INT8))
+ ii38 = INT(intin, kind=INT64)
+
+TYPE IS (INTEGER(INT16))
+ ii38 = INT(intin, kind=INT64)
+
+TYPE IS (INTEGER(INT32))
+ ii38 = INT(intin, kind=INT64)
+
+TYPE IS (INTEGER(INT64))
+ ii38 = intin
+
+ !class default
+ !write(error_unit,*)'ERROR: unknown integer type'
+ !stop 'ERROR: *Anyinteger_to_64* unknown integer type'
+END SELECT
+END PROCEDURE Anyinteger_to_64bit
+
+!----------------------------------------------------------------------------
+! Include Error
+!----------------------------------------------------------------------------
+
+END SUBMODULE Methods