Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!!
4 : !!!! MIT License
5 : !!!!
6 : !!!! ParaMonte: plain powerful parallel Monte Carlo library.
7 : !!!!
8 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab
9 : !!!!
10 : !!!! This file is part of the ParaMonte library.
11 : !!!!
12 : !!!! Permission is hereby granted, free of charge, to any person obtaining a
13 : !!!! copy of this software and associated documentation files (the "Software"),
14 : !!!! to deal in the Software without restriction, including without limitation
15 : !!!! the rights to use, copy, modify, merge, publish, distribute, sublicense,
16 : !!!! and/or sell copies of the Software, and to permit persons to whom the
17 : !!!! Software is furnished to do so, subject to the following conditions:
18 : !!!!
19 : !!!! The above copyright notice and this permission notice shall be
20 : !!!! included in all copies or substantial portions of the Software.
21 : !!!!
22 : !!!! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
23 : !!!! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
24 : !!!! MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
25 : !!!! IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
26 : !!!! DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
27 : !!!! OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE
28 : !!!! OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
29 : !!!!
30 : !!!! ACKNOWLEDGMENT
31 : !!!!
32 : !!!! ParaMonte is an honor-ware and its currency is acknowledgment and citations.
33 : !!!! As per the ParaMonte library license agreement terms, if you use any parts of
34 : !!!! this library for any purposes, kindly acknowledge the use of ParaMonte in your
35 : !!!! work (education/research/industry/development/...) by citing the ParaMonte
36 : !!!! library as described on this page:
37 : !!!!
38 : !!!! https://github.com/cdslaborg/paramonte/blob/main/ACKNOWLEDGMENT.md
39 : !!!!
40 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
41 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
42 :
43 : !> \brief This module contains classes and procedures relevant to the system operations.
44 : !> \author Amir Shahmoradi
45 :
46 : module System_mod
47 :
48 : use JaggedArray_mod, only: CharVec_type
49 : use Constants_mod, only: IK, NLC
50 : use Err_mod, only: Err_type
51 : implicit none
52 :
53 : character(*), parameter :: MODULE_NAME = "@System_mod"
54 : integer(IK) , parameter :: MAX_OS_NAME_LEN = 63_IK
55 :
56 : #if defined OS_IS_WINDOWS
57 : character(*), parameter :: OS_NAME = "Windows"
58 : character(*), parameter :: OS_PATH_SEPARATOR = "\"
59 : #elif defined OS_IS_DARWIN
60 : character(*), parameter :: OS_NAME = "Darwin"
61 : character(*), parameter :: OS_PATH_SEPARATOR = "/"
62 : #elif defined OS_IS_LINUX
63 : character(*), parameter :: OS_NAME = "Linux"
64 : character(*), parameter :: OS_PATH_SEPARATOR = "/"
65 : #endif
66 :
67 : !> The `RandomFileName_type` class.
68 : type :: RandomFileName_type
69 : character(:), allocatable :: path !< The full path to the randomly-generated unique file name.
70 : character(:), allocatable :: dir !< The directory within which is the unique new file is supposed to be generated.
71 : character(:), allocatable :: key !< The optionally user-specified file prefix for the unique file name.
72 : character(:), allocatable :: ext !< The optionally user-specified file extension.
73 : type(Err_type) :: Err !< An object of class [Err_type](@ref err_mod::err_type).
74 : end type RandomFileName_type
75 :
76 : !> The `RandomFileName_type` constructor.
77 : interface RandomFileName_type
78 : module procedure :: getRandomFileName
79 : end interface RandomFileName_type
80 :
81 : !> The `SystemInfo_type` class.
82 : type :: SystemInfo_type
83 : integer(IK) :: nRecord !< The number of elements of the vector `List`.
84 : type(CharVec_type), allocatable :: Records(:) !< An array of length `nRecord` of strings, each element of which represents
85 : !! one line in the output system information.
86 : type(Err_type) :: Err !< An object of class [Err_type](@ref err_mod::err_type) indicating whether
87 : !! any error has occurred during information collection.
88 : contains
89 : procedure, nopass :: get => getSystemInfo
90 : end type SystemInfo_type
91 :
92 : !> The `SystemInfo_type` constructor.
93 : interface SystemInfo_type
94 : module procedure :: constructSystemInfo
95 : end interface SystemInfo_type
96 :
97 : !> The Shell name type.
98 : type, private :: ShellName_type
99 : character(:), allocatable :: current !< The name of the current runtime shell.
100 : character(:), allocatable :: default !< The name of the default runtime shell.
101 : end type ShellName_type
102 :
103 : !> The `Shell_type` class.
104 : type :: Shell_type
105 : logical :: isSh = .false. !< The logical value indicating whether the shell is Unix sh.
106 : logical :: isCMD = .false. !< The logical value indicating whether the shell is Windows CMD.
107 : logical :: isZsh = .false. !< The logical value indicating whether the shell is Unix zsh.
108 : logical :: isCsh = .false. !< The logical value indicating whether the shell is Unix csh.
109 : logical :: isBash = .false. !< The logical value indicating whether the shell is Unix Bash.
110 : logical :: isPowerShell = .false. !< The logical value indicating whether the shell is Windows PowerShell.
111 : logical :: isUnix = .false. !< The logical value indicating whether the shell is Unix-like.
112 : character(:), allocatable :: slash !< The path separator character in the current shell (Windows Shell: "\", Unix-like: "/").
113 : character(:), allocatable :: name !< The name of or path to the current shell.
114 : type(Err_type) :: Err !< An object of class [Err_type](@ref err_mod::err_type) indicating
115 : !! whether error has occurred during the query.
116 : contains
117 : procedure, pass :: query => queryRuntimeShell
118 : end type Shell_type
119 :
120 : !> The `OS_type` class.
121 : type :: OS_type
122 : character(:), allocatable :: name !< The name of the operating system.
123 : character(:), allocatable :: slash !< The file/folder name separator used by the OS.
124 : logical :: isWindows = .false. !< Logical variable indicating whether the OS is Windows.
125 : logical :: isDarwin = .false. !< Logical variable indicating whether the OS is Darwin (macOS).
126 : logical :: isLinux = .false. !< Logical variable indicating whether the OS is Linux.
127 : type(Shell_type) :: Shell !< An object of class [Shell_type](@ref shell_type) containing
128 : !! information about the runtime shell name and type.
129 : type(Err_type) :: Err !< An object of class [Err_type](@ref err_mod::err_type) indicating whether
130 : !! error has occurred during the object initialization.
131 : contains
132 : procedure, pass :: query => queryOS
133 : end type OS_type
134 :
135 : !> The `EnvVar_type` class.
136 : type :: EnvVar_type
137 : character(:), allocatable :: name
138 : character(:), allocatable :: value
139 : integer :: length
140 : type(Err_type) :: Err
141 : contains
142 : procedure, nopass :: get => getEnvVar
143 : end type EnvVar_type
144 :
145 : !> The `CmdArg_type` class.
146 : type :: CmdArg_type
147 : character(:), allocatable :: cmd !< A string containing the full command line obtained via `get_command()` Fortran intrinsic subroutine.
148 : type(CharVec_type), allocatable :: Arg(:) !< A list of `(0:CmdArg_type%count)` elements, each of which represents one command line argument,
149 : !! including the main command as the zeroth element.
150 : integer :: count !< The number of command line arguments, excluding the main (zeroth) command.
151 : type(Err_type) :: Err !< An object of class [Err_type](@ref err_mod::err_type) indicating
152 : !! whether error has occurred during the object initialization.
153 : contains
154 : procedure, pass :: query => queryCmdArg
155 : end type CmdArg_type
156 :
157 : !> The `SysCmd_type` class.
158 : type :: SysCmd_type
159 : character(:), allocatable :: cmd !< The command to be executed by the program in the terminal.
160 : logical :: wait !< Indicated if the program should wait for the terminal to return the control to it.
161 : integer :: exitstat !< The exit status from the terminal.
162 : type(Err_type) :: Err !< An object of class [Err_type](@ref err_mod::err_type) indicating
163 : !! whether error has occurred during the object initialization.
164 : contains
165 : procedure, pass :: run => runSysCmd
166 : end type SysCmd_type
167 :
168 : !> The `SysCmd_type` constructor.
169 : interface SysCmd_type
170 : module procedure :: constructSysCmd
171 : end interface SysCmd_type
172 :
173 : ! cache the OS query result to speed up code
174 :
175 : #if defined CODECOV_ENABLED
176 : logical :: mv_osCacheActivated = .false. !< A logical flag indicating whether an OS query has occurred or not.
177 : logical :: mv_shCacheActivated = .false. !< A logical flag indicating whether a Shell query has occurred or not.
178 : #else
179 : logical , protected :: mv_osCacheActivated = .false. !< A logical flag indicating whether an OS query has occurred or not.
180 : logical , protected :: mv_shCacheActivated = .false. !< A logical flag indicating whether a Shell query has occurred or not.
181 : #endif
182 : type(OS_type), private :: mv_OS
183 :
184 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
185 :
186 : contains
187 :
188 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
189 :
190 : !> \brief
191 : !> The constructor of the class [SystemInfo_type](@ref systeminfo_type).
192 : !> Return a comprehensive report of the system information.
193 : !>
194 : !> \param[in] OS : An object of class [OS_type](@ref os_type) loaded with `OS%query()` results (**optional**).
195 : !> \param[in] path : A string representing the path to file that has the system information already cached (**optional**).
196 : !> If the path is provided and the file exists, then the system information will be read from that file.
197 : !> \param[in] pid : An input integer representing the ID of the current process (**optional**). If present, it will be used
198 : !> to generate processor-unique systeminfo cache files. This is mostly useful for parallel code coverage analysis.
199 : !>
200 : !> \return
201 : !> `SystemInfo` : An object of class [SystemInfo_type](@ref systeminfo_type) containing the system information.
202 : !>
203 : !> \warning
204 : !> Note that `pid` is used only when the input `path` is missing.
205 362 : function constructSystemInfo(OS, path, pid) result(SystemInfo)
206 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
207 : !DEC$ ATTRIBUTES DLLEXPORT :: constructSystemInfo
208 : #endif
209 : use FileContents_mod, only: getFileContents
210 : use DateTime_mod, only: DateTime_type
211 : use Constants_mod, only: NLC, IK
212 : use String_mod, only: num2str
213 : implicit none
214 :
215 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@constructSystemInfo()"
216 :
217 : type(SystemInfo_type) :: SystemInfo
218 : type(OS_type), intent(in), optional :: OS
219 : character(*), intent(in), optional :: path
220 : integer(IK), intent(in), optional :: pid
221 : type(DateTime_type) :: DateTime
222 362 : character(:), allocatable :: cacheFile
223 : logical :: fileIsOpen, fileExists
224 : integer :: fileUnit
225 :
226 362 : fileExists = present(path)
227 :
228 362 : if (fileExists) then
229 359 : cacheFile = path
230 : else ! construct the default cache file name
231 3 : call DateTime%query()
232 3 : if (present(pid)) then
233 3 : cacheFile = num2str(pid)
234 : else
235 0 : cacheFile = ""
236 : end if
237 3 : cacheFile = ".paramonte.sysinfo."//DateTime%year//DateTime%month//DateTime%day//".cache."//cacheFile
238 : end if
239 :
240 : ! check if the cache file exists
241 :
242 362 : inquire(file = cacheFile, opened = fileIsOpen, number = fileUnit, exist = fileExists, iostat = SystemInfo%Err%stat) ! check if the file exists
243 362 : if (SystemInfo%Err%stat/=0) then
244 : ! LCOV_EXCL_START
245 : SystemInfo%Err%occurred = .true.
246 : SystemInfo%Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the existence of file = '" // cacheFile // "'."
247 : return
248 : end if
249 : ! LCOV_EXCL_STOP
250 :
251 362 : if (fileExists) then
252 :
253 : ! read the system info from cache file.
254 :
255 358 : if (fileIsOpen) close(fileUnit)
256 :
257 358 : call getFileContents(cacheFile, SystemInfo%Records, SystemInfo%nRecord, SystemInfo%Err)
258 358 : if (SystemInfo%Err%occurred) then
259 : ! LCOV_EXCL_START
260 : SystemInfo%Err%msg = PROCEDURE_NAME//": Error occurred while collecting system info from the input file: "//cacheFile//NLC//SystemInfo%Err%msg
261 : return
262 : end if
263 : ! LCOV_EXCL_STOP
264 :
265 : else
266 :
267 4 : call getSystemInfo( SystemInfo%Records, SystemInfo%Err, OS, SystemInfo%nRecord, cacheFile )
268 :
269 : end if
270 :
271 362 : end function constructSystemInfo
272 :
273 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
274 :
275 : !> \brief
276 : !> Query all attributes of the [OS_type](@ref os_type) class: `name`, `slash`, `isWindows`, `Err`.
277 : !>
278 : !> \param[out] OS : An object of class [OS_type](@ref os_type).
279 : !> \param[in] shellQueryEnabled : A logical variable indicating if the type and name of the current
280 : !> runtime shell should be queried or not (**optional**, default = `.true.`).
281 2790 : subroutine queryOS(OS, shellQueryEnabled)
282 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
283 : !DEC$ ATTRIBUTES DLLEXPORT :: queryOS
284 : #endif
285 362 : use String_mod, only: num2str, getLowerCase
286 : use Constants_mod, only: IK, RK
287 : use Err_mod, only: Err_type
288 : implicit none
289 : class(OS_type) , intent(out) :: OS
290 : logical , intent(in), optional :: shellQueryEnabled
291 : character(*) , parameter :: PROCEDURE_NAME = MODULE_NAME // "@queryOS()"
292 : logical :: shellQueryEnabledDefault
293 : #if !defined OS_IS_WINDOWS && !defined OS_IS_DARWIN && !defined OS_IS_LINUX
294 : character(:) , allocatable :: osname
295 : #endif
296 :
297 1395 : shellQueryEnabledDefault = .true.
298 1395 : if (present(shellQueryEnabled)) shellQueryEnabledDefault = shellQueryEnabled
299 1395 : OS%Err%occurred = .false.
300 1395 : OS%Err%msg = ""
301 :
302 1395 : if (mv_osCacheActivated) then
303 :
304 1383 : OS%name = mv_OS%name
305 1383 : OS%slash = mv_OS%slash
306 1383 : OS%isWindows = mv_OS%isWindows
307 1383 : OS%isDarwin = mv_OS%isDarwin
308 1383 : OS%isLinux = mv_OS%isLinux
309 :
310 1383 : if (mv_shCacheActivated) then
311 1380 : OS%Shell = mv_OS%Shell
312 : else
313 3 : mv_shCacheActivated = .true.
314 3 : call OS%Shell%query()
315 3 : if (OS%Shell%Err%occurred) then
316 : ! LCOV_EXCL_START
317 : OS%Err = OS%Shell%Err
318 : return
319 : end if
320 : ! LCOV_EXCL_STOP
321 3 : mv_OS%Shell = OS%Shell
322 : end if
323 :
324 1383 : return
325 :
326 : end if
327 :
328 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
329 : #if defined OS_IS_WINDOWS || defined OS_IS_DARWIN || defined OS_IS_LINUX
330 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
331 :
332 12 : OS%name = OS_NAME
333 12 : OS%slash = OS_PATH_SEPARATOR
334 :
335 : #if defined OS_IS_WINDOWS
336 : OS%isWindows = .true.
337 : #elif defined OS_IS_DARWIN
338 : OS%isDarwin = .true.
339 : #elif defined OS_IS_LINUX
340 12 : OS%isLinux = .true.
341 : #endif
342 :
343 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
344 : #else
345 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
346 :
347 : if (allocated(OS%name)) deallocate(OS%name); allocate( character(MAX_OS_NAME_LEN) :: OS%name )
348 : call getEnvVar( name="OS", value=OS%name, Err=OS%Err )
349 : if (OS%Err%occurred) then
350 : ! LCOV_EXCL_START
351 : OS%Err%msg = PROCEDURE_NAME // ": Error occurred while querying OS type." // NLC // OS%Err%msg
352 : OS%name = ""
353 : return
354 : end if
355 : ! LCOV_EXCL_STOP
356 :
357 : OS%name = trim(adjustl(OS%name))
358 :
359 : blockOS: if (len(OS%name)>=7_IK) then
360 :
361 : if (getLowerCase(OS%name(1:7))=="windows") then
362 :
363 : OS%isWindows = .true.
364 : OS%isDarwin = .false.
365 : OS%isLinux = .false.
366 : OS%slash = "\"
367 :
368 : end if
369 :
370 : else blockOS ! it is either Linux- or Darwin- based OS
371 :
372 : if (allocated(OS%name)) deallocate( OS%name )
373 : allocate( character(MAX_OS_NAME_LEN) :: OS%name )
374 : OS%isWindows = .false.
375 : OS%slash = "/"
376 :
377 : if (allocated(OS%name)) deallocate(OS%name); allocate( character(MAX_OS_NAME_LEN) :: OS%name )
378 : call getEnvVar( name="OSTYPE", value=OS%name, Err=OS%Err )
379 : if (OS%Err%occurred) then
380 : ! LCOV_EXCL_START
381 : OS%Err%msg = PROCEDURE_NAME // ": Error occurred while querying OS type." // NLC // OS%Err%msg
382 : OS%name = ""
383 : return
384 : end if
385 : ! LCOV_EXCL_STOP
386 :
387 : OS%name = trim(adjustl(OS%name))
388 : osname = getLowerCase(OS%name)
389 :
390 : blockNonWindowsOS: if (index(osname,"darwin")/=0) then
391 :
392 : OS%isDarwin = .true.
393 : OS%isLinux = .false.
394 : return
395 :
396 : elseif (index(osname,"linux")/=0) then blockNonWindowsOS
397 :
398 : OS%isDarwin = .false.
399 : OS%isLinux = .true.
400 : return
401 :
402 : else blockNonWindowsOS
403 :
404 : if (allocated(OS%name)) deallocate(OS%name); allocate( character(MAX_OS_NAME_LEN) :: OS%name )
405 :
406 : blockUnknownOS: block
407 :
408 : integer :: fileUnit
409 : type(RandomFileName_type) :: RFN
410 : RFN = RandomFileName_type(key="queryOS")
411 : if (RFN%Err%occurred) then
412 : ! LCOV_EXCL_START
413 : OS%Err = RFN%Err
414 : OS%Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring OS type." // NLC // OS%Err%msg
415 : OS%name = ""
416 : return
417 : end if
418 : ! LCOV_EXCL_STOP
419 :
420 : call executeCmd( command="uname > "//RFN%path, Err=OS%Err )
421 : if (OS%Err%occurred) then
422 : ! LCOV_EXCL_START
423 : OS%Err%msg = PROCEDURE_NAME // ": Error occurred while executing command 'uname > "// RFN%path // "'." // NLC // OS%Err%msg
424 : OS%name = ""
425 : return
426 : end if
427 : ! LCOV_EXCL_STOP
428 :
429 : open( newunit = fileUnit & ! LCOV_EXCL_LINE
430 : , file = RFN%path & ! LCOV_EXCL_LINE
431 : , status = "old" & ! LCOV_EXCL_LINE
432 : , iostat = OS%Err%stat & ! LCOV_EXCL_LINE
433 : #if defined INTEL_COMPILER_ENABLED && defined OS_IS_WINDOWS
434 : , SHARED &
435 : #endif
436 : )
437 : if (OS%Err%stat>0) then
438 : ! LCOV_EXCL_START
439 : OS%Err%occurred = .true.
440 : OS%Err%msg = PROCEDURE_NAME // ": Unknown error occurred while opening file = '" // RFN%path // "'."
441 : OS%name = ""
442 : return
443 : end if
444 : ! LCOV_EXCL_STOP
445 :
446 : read(fileUnit,*,iostat=OS%Err%stat) OS%name
447 :
448 : if ( is_iostat_eor(OS%Err%stat) ) then
449 : ! LCOV_EXCL_START
450 : OS%Err%occurred = .true.
451 : OS%Err%msg = PROCEDURE_NAME // ": End-Of-Record error condition occurred while attempting to read &
452 : &the Operating System's name from file = '" // RFN%path // "'."
453 : OS%name = ""
454 : return
455 : elseif ( is_iostat_end(OS%Err%stat) ) then
456 : OS%Err%occurred = .true.
457 : OS%Err%msg = PROCEDURE_NAME // ": End-Of-File error condition occurred while attempting to read &
458 : &the Operating System's name from file = '" // RFN%path // "'."
459 : OS%name = ""
460 : return
461 : elseif ( OS%Err%stat>0 ) then
462 : OS%Err%occurred = .true.
463 : OS%Err%msg = PROCEDURE_NAME // ": Unknown error condition occurred while attempting to read &
464 : &the Operating System's name from file = '" // RFN%path // "'."
465 : OS%name = ""
466 : return
467 : end if
468 : ! LCOV_EXCL_STOP
469 :
470 : close(fileUnit, status = "delete", iostat = OS%Err%stat) ! parallel processes cannot delete the same file
471 :
472 : OS%name = trim(adjustl(OS%name))
473 : osname = getLowerCase(OS%name)
474 : if (index(osname,"darwin")/=0) then
475 : OS%isDarwin = .true.
476 : OS%isLinux = .false.
477 : elseif (index(osname,"linux")/=0) then
478 : OS%isLinux = .true.
479 : OS%isDarwin = .false.
480 : else
481 : OS%isLinux = .false.
482 : OS%isDarwin = .false.
483 : end if
484 :
485 : end block blockUnknownOS
486 :
487 : end if blockNonWindowsOS
488 :
489 : end if blockOS
490 :
491 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
492 : #endif
493 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
494 :
495 12 : mv_osCacheActivated = .true.
496 12 : mv_OS%name = OS%name
497 12 : mv_OS%slash = OS%slash
498 12 : mv_OS%isWindows = OS%isWindows
499 12 : mv_OS%isDarwin = OS%isDarwin
500 12 : mv_OS%isLinux = OS%isLinux
501 :
502 12 : if (shellQueryEnabledDefault) then
503 :
504 9 : if (mv_shCacheActivated) then
505 3 : OS%Shell = mv_OS%Shell
506 : else
507 6 : mv_shCacheActivated = .true.
508 6 : call OS%Shell%query()
509 6 : if (OS%Shell%Err%occurred) then
510 : ! LCOV_EXCL_START
511 : OS%Err = OS%Shell%Err
512 : return
513 : end if
514 : ! LCOV_EXCL_STOP
515 6 : mv_OS%Shell = OS%Shell
516 : end if
517 :
518 : end if
519 :
520 1395 : end subroutine queryOS
521 :
522 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
523 :
524 15 : subroutine queryRuntimeShell(Shell)
525 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
526 : !DEC$ ATTRIBUTES DLLEXPORT :: queryRuntimeShell
527 : #endif
528 1395 : use FileContents_mod, only: FileContents_type
529 :
530 : implicit none
531 :
532 : class(Shell_type), intent(inout) :: Shell
533 :
534 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@queryRuntimeShell()"
535 :
536 15 : type(RandomFileName_type) :: RFN
537 15 : type(FileContents_type) :: FileContents
538 15 : character(:), allocatable :: command
539 : logical :: fileExists
540 :
541 15 : Shell%Err%occurred = .false.
542 15 : Shell%Err%msg = ""
543 :
544 : ! create a random output file name
545 :
546 15 : RFN = RandomFileName_type(key="queryShell")
547 15 : if (RFN%Err%occurred) then
548 : ! LCOV_EXCL_START
549 : Shell%Err = RFN%Err
550 : Shell%Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring OS type." // NLC // Shell%Err%msg
551 : Shell%name = ""
552 : return
553 : end if
554 : ! LCOV_EXCL_STOP
555 :
556 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
557 : ! define the shell command. First try the bash command,
558 : ! as it does not lead to oddities on Windows terminal.
559 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
560 :
561 : !command = "echo $0 >" // RFN%path // " 2>&1 && echo $SHELL >" // RFN%path // " 2>&1"
562 15 : command = "echo $0 >" // RFN%path // " 2>&1"
563 15 : call executeCmd( command = command, Err = Shell%Err )
564 15 : inquire(file = RFN%path, exist = fileExists)
565 15 : if (Shell%Err%occurred .or. .not. fileExists) then
566 : ! LCOV_EXCL_START
567 : Shell%Err%msg = PROCEDURE_NAME // ": Error occurred while executing the Unix command "// command // NLC // Shell%Err%msg
568 : Shell%name = ""
569 : return
570 : end if
571 : ! LCOV_EXCL_STOP
572 :
573 : ! read the command output
574 :
575 15 : FileContents = FileContents_type(RFN%path, delEnabled = .true.)
576 15 : if (FileContents%Err%occurred) then
577 : ! LCOV_EXCL_START
578 : Shell%Err%occurred = .true.
579 : Shell%Err%msg = PROCEDURE_NAME // FileContents%Err%msg
580 : Shell%name = ""
581 : return
582 : end if
583 : ! LCOV_EXCL_STOP
584 :
585 15 : if (FileContents%numRecord>0_IK) then
586 15 : Shell%name = trim(adjustl(FileContents%Line(1)%record))
587 15 : Shell%isZsh = index(Shell%name,"zsh") > 0
588 15 : Shell%isCsh = index(Shell%name,"csh") > 0
589 15 : Shell%isBash = index(Shell%name,"bash") > 0
590 15 : Shell%isSh = .false.; if (.not. (Shell%isBash .or. Shell%isZsh .or. Shell%isCsh)) Shell%isSh = index(Shell%name,"sh") > 0
591 : #if defined OS_IS_WINDOWS
592 : Shell%isUnix = Shell%isBash .or. Shell%isZsh .or. Shell%isCsh .or. Shell%isSh
593 : #else
594 15 : Shell%isUnix = .true.
595 : #endif
596 15 : if (Shell%isUnix) Shell%slash = "/"
597 : end if
598 :
599 : #if defined OS_IS_WINDOWS
600 : if (.not. Shell%isUnix) then
601 :
602 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
603 : ! define the shell command, this time for Windows Batch.
604 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
605 :
606 : command = "(dir 2>&1 *`|echo CMD >"//RFN%path//");&<# rem #>echo PowerShell >"//RFN%path//" 2>&1"
607 :
608 : call executeCmd( command = command, Err = Shell%Err )
609 : if (Shell%Err%occurred .or. .not. fileExists) then
610 : ! LCOV_EXCL_START
611 : Shell%Err%msg = PROCEDURE_NAME // ": Error occurred while executing the Windows command "// command // NLC // Shell%Err%msg
612 : Shell%name = ""
613 : return
614 : end if
615 : ! LCOV_EXCL_STOP
616 :
617 : ! read the command output
618 :
619 : FileContents = FileContents_type(RFN%path, delEnabled = .true.)
620 : if (FileContents%Err%occurred) then
621 : ! LCOV_EXCL_START
622 : Shell%Err%occurred = .true.
623 : Shell%Err%msg = PROCEDURE_NAME // FileContents%Err%msg
624 : Shell%name = ""
625 : return
626 : end if
627 : ! LCOV_EXCL_STOP
628 :
629 : if (FileContents%numRecord>0_IK) then
630 : Shell%name = trim(adjustl(FileContents%Line(1)%record))
631 : Shell%isCMD = index(Shell%name,"CMD") > 0
632 : Shell%isPowerShell = index(Shell%name,"PowerShell") > 0
633 : if (Shell%isPowerShell .or. Shell%isCMD) Shell%slash = "\"
634 : end if
635 :
636 : end if
637 : #endif
638 :
639 : ! cache the results
640 :
641 15 : mv_shCacheActivated = .true.
642 15 : mv_OS%Shell = Shell
643 :
644 45 : end subroutine queryRuntimeShell
645 :
646 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
647 :
648 : !> \brief
649 : !> Generate a unique file path in the requested directory for temporary usage.
650 : !>
651 : !> \param[in] dir : The requested directory within which the unique new file is supposed to be generated (**optional**).
652 : !> \param[in] key : The requested input file name prefix (**optional**, default = "RandomFileName").
653 : !> \param[in] ext : The requested input file extension (**optional**, default = ".rfn", standing for random file name).
654 : !>
655 : !> \return
656 : !> `RFN` : An object of class [RandomFileName_type](@ref randomfilename_type) containing the attributes of the random file name.
657 101 : function getRandomFileName(dir,key,ext) result(RFN)
658 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
659 : !DEC$ ATTRIBUTES DLLEXPORT :: getRandomFileName
660 : #endif
661 15 : use Constants_mod, only: IK, RK
662 : use DateTime_mod, only: DateTime_type
663 : use String_mod, only: num2str
664 : implicit none
665 : character(*), intent(in), optional :: dir, key, ext
666 : type(RandomFileName_type) :: RFN
667 :
668 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getRandomFileName()"
669 :
670 : integer(IK) :: counter
671 : logical :: fileExists
672 : type(DateTime_type) :: DT
673 :
674 101 : if (present(dir)) then
675 32 : RFN%dir = dir
676 : else
677 69 : RFN%dir = ""
678 : end if
679 101 : if (present(key)) then
680 101 : RFN%key = key
681 : else
682 0 : RFN%key = "RandomFileName"
683 : end if
684 101 : if (present(ext)) then
685 32 : RFN%ext = ext
686 : else
687 69 : RFN%ext = ".rfn"
688 : end if
689 :
690 101 : counter = 0
691 0 : do
692 :
693 101 : counter = counter + 1
694 101 : call DT%query()
695 : #if defined CAF_ENABLED
696 101 : RFN%path = RFN%dir // RFN%key // '_' // DT%date // '_' // DT%time // '_process_' // num2str(this_image()) // '_' // num2str(counter) // RFN%ext
697 : #elif defined MPI_ENABLED
698 : block
699 : use mpi
700 : integer :: imageID, ierrMPI
701 : call mpi_comm_rank(mpi_comm_world, imageID, ierrMPI)
702 : RFN%path = RFN%dir // RFN%key // '_' // DT%date // '_' // DT%time // '_process_' // num2str(imageID+1) // '_' // num2str(counter) // RFN%ext
703 : end block
704 : #else
705 : RFN%path = RFN%dir // RFN%key // '_' // DT%date // '_' // DT%time // '_process_' // num2str(1_IK) // '_' // num2str(counter) // RFN%ext
706 : #endif
707 101 : inquire(file=RFN%path,exist=fileExists,iostat=RFN%Err%stat) ! check if the file already exists
708 : ! LCOV_EXCL_START
709 : if (RFN%Err%stat/=0) then
710 : RFN%Err%occurred = .true.
711 : RFN%Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the existence of file = '" // RFN%path // "'."
712 : RFN%path = ""
713 : return
714 : end if
715 : if (counter>1000_IK) then
716 : RFN%Err%occurred = .true.
717 : RFN%Err%msg = PROCEDURE_NAME//": Unbelievable! "//num2str(counter)//" filenames were tested and all seem to exist."
718 : RFN%path = ""
719 : return
720 : end if
721 : if (fileExists) cycle
722 : ! LCOV_EXCL_STOP
723 101 : exit
724 :
725 : end do
726 :
727 101 : end function getRandomFileName
728 :
729 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
730 :
731 : !> \brief
732 : !> Return the value of the requested input environmental variable.
733 : !>
734 : !> \param[in] name : The requested environmental variable name.
735 : !> \param[out] value : The value of the requested environmental variable name.
736 : !> \param[out] length : The length of the value of the requested environmental variable name.
737 : !> \param[out] Err : An object of class [Err_type](@ref err_mod::err_type)
738 : !! indicating whether any error has occurred during information collection.
739 18 : subroutine getEnvVar(name,value,length,Err)
740 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
741 : !DEC$ ATTRIBUTES DLLEXPORT :: getEnvVar
742 : #endif
743 101 : use Constants_mod, only: IK, MAX_REC_LEN
744 : use Err_mod, only: Err_type
745 : implicit none
746 : character(*), intent(in) :: name
747 : character(:), allocatable, intent(out) :: value
748 : integer(IK) , intent(out), optional :: length
749 : type(Err_type), intent(out), optional :: Err
750 :
751 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getEnvVar()"
752 9 : allocate( character(MAX_REC_LEN) :: value )
753 :
754 9 : Err%occurred = .false.
755 :
756 15 : if (present(Err)) then
757 9 : if (len_trim(adjustl(name))==0) then
758 3 : Err%occurred = .true.
759 3 : Err%msg = PROCEDURE_NAME // ": The input environment variable must have a non-zero length."
760 3 : return
761 : end if
762 6 : call get_environment_variable(name=name,value=value,length=length,status=Err%stat)
763 : ! LCOV_EXCL_START
764 : if (Err%stat==2) then
765 : Err%occurred = .true.
766 : Err%msg = PROCEDURE_NAME // ": Error occurred while fetching the value of the environment variable " // &
767 : name // ". The processor does not support environment variables."
768 : return
769 : elseif (Err%stat>2) then
770 : Err%occurred = .true.
771 : Err%msg = PROCEDURE_NAME//": Unknown error occurred while fetching the value of the environment variable "//name//"."
772 : return
773 : end if
774 : else
775 : call get_environment_variable(name=name,value=value,length=length)
776 : end if
777 : ! LCOV_EXCL_STOP
778 :
779 12 : value = trim(adjustl(value))
780 :
781 9 : end subroutine getEnvVar
782 :
783 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
784 :
785 : !> \brief
786 : !> The [SysCmd_type](@ref syscmd_type) class constructor.
787 : !> Execute the input system command `cmd` and return.
788 : !>
789 : !> \param[in] cmd : The requested input system command to be executed.
790 : !> \param[in] wait : A logical value indicating whether the program should wait for the control to be returned to it by the terminal.
791 : !>
792 : !> \return
793 : !> `SysCmd` : An object of class [SysCmd_type](@ref syscmd_type) containing the attributes and the statistics of the system command execution.
794 407 : function constructSysCmd(cmd,wait) result(SysCmd)
795 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
796 : !DEC$ ATTRIBUTES DLLEXPORT :: constructSysCmd
797 : #endif
798 : implicit none
799 : character(*), intent(in) :: cmd
800 : logical, intent(in), optional :: wait
801 : type(SysCmd_type) :: SysCmd
802 395 : SysCmd%cmd = cmd
803 395 : SysCmd%exitstat = -huge(0)
804 395 : if (present(wait)) then
805 12 : SysCmd%wait = wait
806 : else
807 383 : SysCmd%wait = .true.
808 : end if
809 395 : call SysCmd%run()
810 404 : end function constructSysCmd
811 :
812 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
813 :
814 : !> \brief
815 : !> A method of the [SysCmd_type](@ref syscmd_type) class.
816 : !> Execute the requested system command and return.
817 : !>
818 : !> \param[inout] SysCmd : An object of class [SysCmd_type](@ref syscmd_type) containing the attributes and
819 : !! the statistics of the system command execution.
820 395 : subroutine runSysCmd(SysCmd)
821 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
822 : !DEC$ ATTRIBUTES DLLEXPORT :: runSysCmd
823 : #endif
824 395 : use Constants_mod, only: MAX_REC_LEN
825 : implicit none
826 : class(SysCmd_type), intent(inout) :: SysCmd
827 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@runSysCmd()"
828 : if (allocated(SysCmd%Err%msg)) deallocate(SysCmd%Err%msg) ! LCOV_EXCL_LINE
829 395 : allocate( character(MAX_REC_LEN) :: SysCmd%Err%msg )
830 : call execute_command_line ( SysCmd%cmd & ! LCOV_EXCL_LINE
831 : , wait=SysCmd%wait & ! LCOV_EXCL_LINE
832 : , exitstat=SysCmd%exitstat & ! LCOV_EXCL_LINE
833 : , cmdstat=SysCmd%Err%stat & ! LCOV_EXCL_LINE
834 : , cmdmsg=SysCmd%Err%msg & ! LCOV_EXCL_LINE
835 395 : )
836 395 : if (SysCmd%Err%stat==0) then
837 395 : SysCmd%Err%occurred = .false.
838 395 : return
839 : ! LCOV_EXCL_START
840 : elseif (SysCmd%Err%stat==-1) then
841 : SysCmd%Err%occurred = .true.
842 : SysCmd%Err%msg = PROCEDURE_NAME // &
843 : ": Error occurred. The processor does not support command execution of the command: " // SysCmd%cmd
844 : return
845 : elseif (SysCmd%Err%stat==-2 .and. SysCmd%wait) then
846 : SysCmd%Err%occurred = .true.
847 : SysCmd%Err%msg = PROCEDURE_NAME // &
848 : ": Error occurred. The processor had to wait for the execution of the command: " // &
849 : SysCmd%cmd // ", but the processor does not support asynchronous command execution."
850 : return
851 : elseif (SysCmd%Err%stat>0 .and. SysCmd%wait) then
852 : SysCmd%Err%occurred = .true.
853 : SysCmd%Err%msg = PROCEDURE_NAME // &
854 : ": Unknown error occurred while attempting to execute the command: " // SysCmd%cmd // &
855 : ". The compiler/processor's explanatory message: " // trim(adjustl(SysCmd%Err%msg))
856 : return
857 : ! LCOV_EXCL_STOP
858 : end if
859 395 : end subroutine runSysCmd
860 :
861 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
862 :
863 : !> \brief
864 : !> Execute the input system command `cmd` and return.
865 : !>
866 : !> \param[in] command : The command to executed in the terminal.
867 : !> \param[in] wait : A logical argument indicating whether the program should wait until the control is
868 : !! returned to it or should not wait (**optional**, default = `.true.`).
869 : !> \param[inout] exitstat : An integer indicating the exit status flag upon exiting the terminal.
870 : !> \param[out] Err : An object of class [Err_type](@ref err_mod::err_type)
871 : !! indicating whether any error has occurred during information collection.
872 : !>
873 : !> \remark
874 : !> This is the procedural implementation of the object-oriented [runSysCmd](@ref runsyscmd) method,
875 : !! kept here only for legacy usage.
876 174 : subroutine executeCmd(command,wait,exitstat,Err)
877 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
878 : !DEC$ ATTRIBUTES DLLEXPORT :: executeCmd
879 : #endif
880 395 : use Constants_mod, only: MAX_REC_LEN
881 : use Err_mod, only: Err_type
882 : implicit none
883 : character(*), intent(in) :: command
884 : logical , intent(in) , optional :: wait
885 : integer , intent(inout) , optional :: exitstat
886 : type(Err_type), intent(out) , optional :: Err
887 :
888 : logical :: waitDefault
889 : integer :: exitstatDefault
890 :
891 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@executeCmd()"
892 :
893 87 : if (present(wait)) then
894 3 : waitDefault = wait
895 : else
896 84 : waitDefault = .true.
897 : end if
898 :
899 87 : if (present(exitstat)) then
900 3 : exitstatDefault = exitstat
901 : else
902 84 : exitstatDefault = -huge(0_IK)
903 : end if
904 :
905 87 : if (present(Err)) then
906 :
907 87 : Err%occurred = .false.
908 87 : allocate( character(MAX_REC_LEN) :: Err%msg )
909 :
910 87 : call execute_command_line( command, wait=waitDefault, exitstat=exitstatDefault, cmdstat=Err%stat, cmdmsg=Err%msg )
911 87 : if (Err%stat==0_IK) then
912 87 : return
913 : ! LCOV_EXCL_START
914 : elseif (Err%stat==-1_IK) then
915 : Err%occurred = .true.
916 : Err%msg = PROCEDURE_NAME // &
917 : ": Error occurred. The processor does not support command execution of the command: " // command
918 : return
919 : elseif (Err%stat==-2_IK .and. waitDefault) then
920 : Err%occurred = .true.
921 : Err%msg = PROCEDURE_NAME // ": Error occurred. The processor had to wait for the execution of the command: " // &
922 : command // ", but the processor does not support asynchronous command execution."
923 : return
924 : elseif (Err%stat>0_IK .and. waitDefault) then
925 : Err%occurred = .true.
926 : Err%msg = PROCEDURE_NAME // ": Unknown error occurred while attempting to execute the command: " // command // &
927 : ". The compiler/processor's explanatory message: " // trim(adjustl(Err%msg))
928 : return
929 : ! LCOV_EXCL_STOP
930 : end if
931 :
932 : ! LCOV_EXCL_START
933 : else
934 :
935 : call execute_command_line( command, wait=waitDefault, exitstat=exitstatDefault )
936 : return
937 :
938 : end if
939 : ! LCOV_EXCL_STOP
940 :
941 87 : end subroutine executeCmd
942 :
943 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
944 :
945 : !> \brief
946 : !> Fetch the input command-line arguments to the main program.
947 : !>
948 : !> \param[inout] CmdArg : An object of class [CmdArg_type](@ref cmdarg_type) which will contain the command line arguments.
949 : !>
950 : !> \remark
951 : !> This is a method of the class [CmdArg_type](@ref cmdarg_type).
952 3 : subroutine queryCmdArg(CmdArg)
953 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
954 : !DEC$ ATTRIBUTES DLLEXPORT :: queryCmdArg
955 : #endif
956 87 : use String_mod, only: num2str
957 : use Constants_mod, only: IK, MAX_REC_LEN
958 : use Err_mod, only: Err_type
959 : implicit none
960 : class(CmdArg_type), intent(inout) :: CmdArg
961 :
962 : integer :: i
963 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@queryCmdArg()"
964 :
965 3 : CmdArg%Err%occurred = .false.
966 3 : CmdArg%Err%msg = ""
967 :
968 : ! first get the full command line
969 3 : allocate( character(MAX_REC_LEN) :: CmdArg%cmd )
970 3 : call get_command( command=CmdArg%cmd , status = CmdArg%Err%stat )
971 3 : if (CmdArg%Err%stat==0) then
972 3 : CmdArg%cmd = trim(adjustl(CmdArg%cmd))
973 : ! LCOV_EXCL_START
974 : elseif (CmdArg%Err%stat>0) then
975 : CmdArg%Err%occurred = .true.
976 : CmdArg%Err%msg = PROCEDURE_NAME // ": Error occurred while fetching the command line."
977 : return
978 : elseif (CmdArg%Err%stat==-1) then
979 : CmdArg%Err%occurred = .true.
980 : CmdArg%Err%msg = PROCEDURE_NAME // ": Unbelievable error occurred while fetching the command line: &
981 : &The length of the command line is longer than " // num2str(MAX_REC_LEN) // "!"
982 : return
983 : ! LCOV_EXCL_STOP
984 : end if
985 :
986 : ! Now get the command line arguments count
987 3 : CmdArg%count = command_argument_count()
988 :
989 : ! Now get the individual command line arguments
990 6 : allocate( CmdArg%Arg( 0:CmdArg%count ) )
991 6 : do i = 0, CmdArg%count
992 3 : allocate( character(MAX_REC_LEN) :: CmdArg%Arg(i)%record )
993 3 : call get_command_argument( number=i, value=CmdArg%Arg(i)%record, status=CmdArg%Err%stat )
994 6 : if (CmdArg%Err%stat==0) then
995 3 : CmdArg%Arg(i)%record = trim(adjustl(CmdArg%Arg(i)%record))
996 : ! LCOV_EXCL_START
997 : elseif (CmdArg%Err%stat>0) then
998 : CmdArg%Err%occurred = .true.
999 : CmdArg%Err%msg = PROCEDURE_NAME // ": Error occurred while fetching the command line."
1000 : return
1001 : elseif (CmdArg%Err%stat==-1) then
1002 : CmdArg%Err%occurred = .true.
1003 : CmdArg%Err%msg = PROCEDURE_NAME // ": Unbelievable error occurred while fetching the command line: &
1004 : & The length of the command line argument is longer than " // num2str(MAX_REC_LEN) // "!"
1005 : return
1006 : ! LCOV_EXCL_STOP
1007 : end if
1008 : end do
1009 :
1010 6 : end subroutine queryCmdArg
1011 :
1012 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1013 :
1014 : !> \brief
1015 : !> Fetch a comprehensive report of the operating system and platform specifications.
1016 : !>
1017 : !> \param[out] List : A list of strings each of which represents one line of information about the system specs.
1018 : !> \param[out] Err : An object of class [Err_type](@ref err_mod::err_type)
1019 : !> indicating whether any error has occurred during information collection.
1020 : !> \param[in] OS : An object of class [OS_type](@ref os_type) containing information about the Operating System (**optional**).
1021 : !> \param[out] count : The count of elements in the output `List` (**optional**).
1022 : !> \param[in] cacheFile : The path to the external file where the results of the system information query will be stored and kept (**optional**).
1023 : !> If no file is specified, the system information will not be stored in an external file.
1024 : !> \todo
1025 : !> This code can be improved. See the extensive note in the body of the procedure.
1026 7 : subroutine getSystemInfo(List,Err,OS,count,cacheFile)
1027 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1028 : !DEC$ ATTRIBUTES DLLEXPORT :: getSystemInfo
1029 : #endif
1030 3 : use Err_mod, only: Err_type
1031 : use String_mod, only: num2str
1032 : use Constants_mod, only: IK, RK, MAX_REC_LEN
1033 : use JaggedArray_mod, only: CharVec_type
1034 : implicit none
1035 : type(CharVec_type) , intent(out), allocatable :: List(:)
1036 : type(Err_type) , intent(out) :: Err
1037 : type(OS_type) , intent(in) , optional :: OS
1038 : integer(IK) , intent(out), optional :: count
1039 : character(*) , intent(in), optional :: cacheFile
1040 :
1041 7 : type(OS_type) :: OpSy
1042 7 : character(len=:), allocatable :: command, stdErr !, filename
1043 : character(len=MAX_REC_LEN) :: record
1044 : integer(IK) :: fileUnit,counter,nRecord
1045 : logical :: fileIsOpen, cacheFileIsPresent
1046 7 : type(RandomFileName_type) :: RFN
1047 :
1048 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@getSystemInfo()"
1049 :
1050 7 : Err%occurred = .false.
1051 7 : Err%msg = ""
1052 :
1053 : ! generate a brand new, non-existing filename
1054 :
1055 7 : cacheFileIsPresent = present(cacheFile)
1056 7 : if (cacheFileIsPresent) then
1057 4 : RFN%path = cacheFile
1058 : else
1059 3 : RFN = RandomFileName_type(key=".getSystemInfo")
1060 : ! LCOV_EXCL_START
1061 : if (RFN%Err%occurred) then
1062 : RFN%Err%msg = PROCEDURE_NAME // RFN%Err%msg
1063 : return
1064 : end if
1065 : ! LCOV_EXCL_STOP
1066 : end if
1067 :
1068 7 : stdErr = RFN%path // ".stderr"
1069 :
1070 : #if defined OS_IS_DARWIN
1071 :
1072 : command = "uname -a >> " // RFN%path // "; sysctl -a | grep machdep.cpu >> " // RFN%path ! LCOV_EXCL_LINE
1073 :
1074 : #elif defined OS_IS_LINUX
1075 :
1076 : !command = "uname -a >> " // RFN%path // "; lshw -short >> " // RFN%path // "; lscpu >> " // RFN%path
1077 7 : command = "uname -a >> " // RFN%path // "; lscpu >> " // RFN%path
1078 :
1079 : #elif defined OS_IS_WINDOWS
1080 :
1081 : ! determine the runtime shell
1082 : if (present(OS)) then
1083 : OpSy = OS
1084 : else
1085 : call OpSy%query()
1086 : if (OpSy%Err%occurred) then
1087 : ! LCOV_EXCL_START
1088 : Err = OpSy%Err
1089 : Err%msg = PROCEDURE_NAME // Err%msg
1090 : return
1091 : end if
1092 : ! LCOV_EXCL_STOP
1093 : end if
1094 :
1095 : if (OpSy%Shell%isCMD .or. OpSy%Shell%isPowerShell) then
1096 : command = "systeminfo > " // RFN%path ! LCOV_EXCL_LINE
1097 : elseif (OpSy%Shell%isUnix) then
1098 : command = "uname -a >> " // RFN%path // "; lscpu >> " // RFN%path
1099 : end if
1100 :
1101 : #endif
1102 :
1103 7 : if (.not. allocated(command)) then
1104 : ! LCOV_EXCL_START
1105 : allocate(List(1))
1106 : List(1)%record = "Unknown operating system: " // OpSy%name
1107 : if (present(count)) count = 1_IK
1108 : return
1109 : end if
1110 : ! LCOV_EXCL_STOP
1111 :
1112 7 : call executeCmd( command=command // " 2> " // stdErr, Err=Err )
1113 7 : if (Err%occurred) then
1114 : ! LCOV_EXCL_START
1115 : Err%msg = PROCEDURE_NAME // ": Error occurred while attempting to write the system info to external file." // NLC // Err%msg
1116 : ! WARNING: XXX TODO
1117 : ! WARNING: On some platforms, such Windows Subsystem for Linux, the CMD exit status
1118 : ! WARNING: might not be returned reliably and therefore, cause `executeCmd()` to return
1119 : ! WARNING: an error. In such a case, no error for copy file should be really raised.
1120 : ! WARNING: If the file already exists upon copy action, no error should be raised.
1121 : ! WARNING: Note that this method may have some vulnerabilities, for example, when
1122 : ! WARNING: a file copy is created, but the copy action did not accomplish the
1123 : ! WARNING: task successfully and the copied file is broken.
1124 : ! WARNING: This needs a more robust solution in the future.
1125 : !return
1126 : end if
1127 : ! LCOV_EXCL_STOP
1128 :
1129 : ! now count the number of records in file:
1130 :
1131 7 : inquire(file=RFN%path,opened=fileIsOpen,number=fileUnit,iostat=Err%stat) ! check if the file already exists
1132 7 : if (Err%stat==0) then
1133 7 : Err%occurred = .false.
1134 : ! LCOV_EXCL_START
1135 : else
1136 : Err%occurred = .true.
1137 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the open status of file = '" // RFN%path // "'."
1138 : return
1139 : end if
1140 : ! LCOV_EXCL_STOP
1141 :
1142 : ! ensure the file is not already open
1143 :
1144 7 : if (fileIsOpen) close(fileUnit,iostat=Err%stat)
1145 7 : if (Err%stat/=0) then
1146 : ! LCOV_EXCL_START
1147 : Err%occurred = .true.
1148 : Err%msg = PROCEDURE_NAME // ": Error occurred while attempting to close the open file = '" // RFN%path // "'."
1149 : return
1150 : end if
1151 : ! LCOV_EXCL_STOP
1152 :
1153 : ! give the system a bit of time. This is mostly needed on Windows platform.
1154 :
1155 7 : call sleep(seconds=0.05_RK,Err=Err)
1156 7 : if (Err%occurred) then
1157 : ! LCOV_EXCL_START
1158 : Err%msg = PROCEDURE_NAME // Err%msg
1159 : return
1160 : end if
1161 : ! LCOV_EXCL_STOP
1162 :
1163 : ! open the file to count the number of lines in it.
1164 :
1165 : open( newunit = fileUnit & ! LCOV_EXCL_LINE
1166 : , file = RFN%path & ! LCOV_EXCL_LINE
1167 : , status = "old" & ! LCOV_EXCL_LINE
1168 : , iostat = Err%stat & ! LCOV_EXCL_LINE
1169 : #if defined INTEL_COMPILER_ENABLED && defined OS_IS_WINDOWS
1170 : , SHARED &
1171 : #endif
1172 7 : )
1173 7 : if (Err%stat>0) then
1174 : ! LCOV_EXCL_START
1175 : Err%occurred = .true.
1176 : Err%msg = PROCEDURE_NAME // ": Unknown error occurred while opening file = '" // RFN%path // "'."
1177 : return
1178 : end if
1179 : ! LCOV_EXCL_STOP
1180 :
1181 : ! count the number of lines in the file.
1182 :
1183 7 : nRecord = 0 ! number of filenames in the file
1184 231 : do
1185 238 : read(fileUnit,'(A)',iostat=Err%stat) record
1186 238 : if ( is_iostat_eor(Err%stat) ) then
1187 : ! LCOV_EXCL_START
1188 : Err%occurred = .true.
1189 : Err%msg = PROCEDURE_NAME // ": End-Of-Record error condition occurred while attempting to read &
1190 : & from file = '" // RFN%path // "'."
1191 : return
1192 : elseif ( is_iostat_end(Err%stat) ) then
1193 : ! LCOV_EXCL_STOP
1194 7 : exit
1195 : ! LCOV_EXCL_START
1196 : elseif ( Err%stat>0 ) then
1197 : Err%occurred = .true.
1198 : Err%msg = PROCEDURE_NAME // ": Unknown error condition occurred while attempting to read &
1199 : & from file = '" // RFN%path // "'."
1200 : return
1201 : ! LCOV_EXCL_STOP
1202 : else
1203 231 : nRecord = nRecord + 1
1204 231 : cycle
1205 : end if
1206 : end do
1207 7 : close(fileUnit,iostat=Err%stat)
1208 7 : if (Err%stat/=0) then
1209 : ! LCOV_EXCL_START
1210 : Err%occurred = .true.
1211 : Err%msg = PROCEDURE_NAME // ": Error occurred while attempting to close the open file = '" // RFN%path // "'."
1212 : return
1213 : end if
1214 : ! LCOV_EXCL_STOP
1215 :
1216 : ! give the system a bit of time. This is mostly needed on Windows platform.
1217 :
1218 7 : call sleep(seconds=0.05_RK,Err=Err)
1219 7 : if (Err%occurred) then
1220 : ! LCOV_EXCL_START
1221 : Err%msg = PROCEDURE_NAME // Err%msg
1222 : return
1223 : end if
1224 : ! LCOV_EXCL_STOP
1225 :
1226 : ! reopen the file, this time to read the contents.
1227 :
1228 : open( newunit = fileUnit & ! LCOV_EXCL_LINE
1229 : , file = RFN%path & ! LCOV_EXCL_LINE
1230 : , status = "old" & ! LCOV_EXCL_LINE
1231 : , iostat = Err%stat & ! LCOV_EXCL_LINE
1232 : #if defined INTEL_COMPILER_ENABLED && defined OS_IS_WINDOWS
1233 : , SHARED &
1234 : #endif
1235 7 : )
1236 7 : if (Err%stat>0) then
1237 : ! LCOV_EXCL_START
1238 : Err%occurred = .true.
1239 : Err%msg = PROCEDURE_NAME // ": Unknown error occurred while opening file = '" // RFN%path // "'."
1240 : return
1241 : end if
1242 : ! LCOV_EXCL_STOP
1243 :
1244 : ! now, allocate the memory and read the contents of the file.
1245 : ! NOTE: The performance of code can be improved here by merging
1246 : ! the line counting, allocating memory, and reopening of the file
1247 : ! to read the contents. But is it really significant at all to care?
1248 :
1249 238 : allocate(List(nRecord))
1250 238 : do counter = 1,nRecord
1251 231 : read(fileUnit,'(A)',iostat=Err%stat) record
1252 231 : if ( is_iostat_eor(Err%stat) ) then
1253 : ! LCOV_EXCL_START
1254 : Err%occurred = .true.
1255 : Err%msg = PROCEDURE_NAME // ": End-Of-Record error condition occurred while attempting to read &
1256 : & from file = '" // RFN%path // "'."
1257 : return
1258 : elseif ( is_iostat_end(Err%stat) ) then
1259 : exit
1260 : elseif ( Err%stat>0 ) then
1261 : Err%occurred = .true.
1262 : Err%msg = PROCEDURE_NAME // ": Unknown error condition occurred while attempting to read from file = '" // RFN%path // "'."
1263 : return
1264 : end if
1265 : ! LCOV_EXCL_STOP
1266 238 : List(counter)%record = trim(adjustl(record))
1267 : end do
1268 :
1269 : ! delete the stderr file
1270 :
1271 : open( newunit = fileUnit & ! LCOV_EXCL_LINE
1272 : , status = "replace" & ! LCOV_EXCL_LINE
1273 : , iostat = Err%stat & ! LCOV_EXCL_LINE
1274 : , file = stdErr & ! LCOV_EXCL_LINE
1275 : #if defined INTEL_COMPILER_ENABLED && defined OS_IS_WINDOWS
1276 : , SHARED &
1277 : #endif
1278 7 : )
1279 7 : close(fileUnit, status="delete", iostat = Err%stat) ! parallel processes cannot delete the same file
1280 : !if (Err%stat/=0) then
1281 : !! LCOV_EXCL_START
1282 : ! Err%occurred = .true.
1283 : ! Err%msg = PROCEDURE_NAME // ": Error occurred while attempting to close the open file = '" // RFN%path // "'."
1284 : ! return
1285 : !end if
1286 : !! LCOV_EXCL_STOP
1287 :
1288 7 : if (present(count)) count = nRecord
1289 :
1290 7 : end subroutine getSystemInfo
1291 :
1292 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1293 :
1294 : !> \brief
1295 : !> Sleep for the input number of seconds (real number).
1296 : !>
1297 : !> \param[in] seconds : The amount of time in seconds to sleep.
1298 : !> \param[out] Err : An object of class [Err_type](@ref err_mod::err_type)
1299 : !! indicating whether any error has occurred before, during, or after the sleep.
1300 2749 : subroutine sleep(seconds,Err)
1301 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1302 : !DEC$ ATTRIBUTES DLLEXPORT :: sleep
1303 : #endif
1304 :
1305 : use, intrinsic :: iso_fortran_env, only: int64
1306 7 : use Err_mod, only: Err_type
1307 : use Constants_mod, only: RK
1308 : implicit none
1309 :
1310 : real(RK), intent(in) :: seconds ! sleep time
1311 : type(Err_type) , intent(out) :: Err
1312 :
1313 : integer(int64) :: countOld, countNew, countMax
1314 2675 : real(RK) :: countRate
1315 :
1316 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@sleep()"
1317 :
1318 2675 : Err%occurred = .false.
1319 2675 : Err%msg = ""
1320 :
1321 2675 : call system_clock( count=countOld, count_rate=countRate, count_max=countMax )
1322 2675 : if (countOld==-huge(0) .or. nint(countRate)==0 .or. countMax==0) then
1323 : ! LCOV_EXCL_START
1324 : Err%occurred = .true.
1325 : Err%msg = PROCEDURE_NAME // ": Error occurred. There is no processor clock."
1326 : return
1327 : end if
1328 : ! LCOV_EXCL_STOP
1329 :
1330 2675 : countRate = 1._RK / countRate
1331 1061510000 : do
1332 1061520000 : call system_clock( count=countNew )
1333 1061520000 : if (countNew==countMax) then
1334 : ! LCOV_EXCL_START
1335 : Err%occurred = .true.
1336 : Err%msg = PROCEDURE_NAME // ": Error occurred. Maximum processor clock count reached."
1337 : end if
1338 : ! LCOV_EXCL_STOP
1339 1061520000 : if ( real(countNew-countOld,kind=RK) * countRate > seconds ) exit
1340 1061510000 : cycle
1341 : end do
1342 :
1343 2675 : end subroutine sleep
1344 :
1345 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1346 :
1347 : !> \brief
1348 : !> Copy file from the origin path to the destination path.
1349 : !>
1350 : !> \param[in] pathOld : The original path.
1351 : !> \param[in] pathNew : The destination path.
1352 : !> \param[in] isUnixShell : Logical value indicating whether the the runtime terminal is a Unix-like shell (as opposed to Windows CMD or Powershell).
1353 : !> \param[out] Err : An object of class [Err_type](@ref err_mod::err_type)
1354 : !! indicating whether any error has occurred the copy.
1355 : !> \todo
1356 : !> This code can be improved. See the extensive note in the body of the procedure.
1357 62 : subroutine copyFile(pathOld,pathNew,isUnixShell,Err)
1358 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1359 : !DEC$ ATTRIBUTES DLLEXPORT :: copyFile
1360 : #endif
1361 :
1362 2675 : use Err_mod, only: Err_type
1363 : use String_mod, only: num2str
1364 : implicit none
1365 : character(*), intent(in) :: pathOld, pathNew
1366 : logical , intent(in) :: isUnixShell
1367 : type(Err_type), intent(out) :: Err
1368 35 : character(:), allocatable :: cmd
1369 : integer :: counter
1370 : logical :: fileExists
1371 :
1372 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@copyFile()"
1373 :
1374 35 : Err%occurred = .false.
1375 :
1376 35 : if (len_trim(adjustl(pathOld))==0) return
1377 :
1378 : ! First check whether file exists:
1379 :
1380 35 : inquire(file=pathNew,exist=fileExists,iostat=Err%stat) ! check if the file already exists
1381 :
1382 35 : if (Err%stat/=0) then
1383 : ! LCOV_EXCL_START
1384 : Err%occurred = .true.
1385 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the existence of file = '" // pathNew // "'."
1386 : return
1387 : end if
1388 : ! LCOV_EXCL_STOP
1389 :
1390 35 : if (fileExists) then
1391 : ! LCOV_EXCL_START
1392 : Err%occurred = .true.
1393 : Err%msg = PROCEDURE_NAME // ": The requested copy file = '" // pathNew // "' already exists."
1394 : return
1395 : end if
1396 : ! LCOV_EXCL_STOP
1397 :
1398 : ! define platform specific copy command
1399 :
1400 35 : if (isUnixShell) then
1401 35 : cmd = "cp " // pathOld // " " // pathNew
1402 : #if defined OS_IS_WINDOWS
1403 : else
1404 : cmd = 'copy "' // pathOld // '" "' // pathNew // '" > nul' ! WARNING: it is important to keep the quotes as they are in the command.
1405 : #endif
1406 : end if
1407 :
1408 : ! attempt repeatedly to copy the file
1409 :
1410 35 : counter = 0
1411 35 : do
1412 :
1413 35 : counter = counter + 1
1414 35 : call executeCmd( command=cmd, Err=Err )
1415 35 : if (Err%occurred) then
1416 : ! LCOV_EXCL_START
1417 : Err%msg = PROCEDURE_NAME // ": Error occurred while executing command "// cmd // "'." // NLC
1418 : ! WARNING: XXX
1419 : ! WARNING: On some platforms, such Windows Subsystem for Linux, the CMD exit status
1420 : ! WARNING: might not be returned reliably and therefore, cause `executeCmd()` to return
1421 : ! WARNING: an error. In such a case, no error for copy file should be really raised.
1422 : ! WARNING: If the file already exists upon copy action, no error should be raised.
1423 : ! WARNING: Note that this method may have some vulnerabilities, for example, when
1424 : ! WARNING: a file copy is created, but the copy action did not accomplish the
1425 : ! WARNING: task successfully and the copied file is broken.
1426 : ! WARNING: This needs a more robust solution in the future.
1427 : !return
1428 : end if
1429 : ! LCOV_EXCL_STOP
1430 :
1431 : ! ensure file is copied
1432 :
1433 35 : inquire(file=pathNew,exist=fileExists,iostat=Err%stat) ! check if the file already exists
1434 35 : if (Err%stat/=0) then
1435 : ! LCOV_EXCL_START
1436 : Err%occurred = .true.
1437 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the existence of copied file = '" // pathNew // "'."
1438 : return
1439 : end if
1440 : ! LCOV_EXCL_STOP
1441 :
1442 35 : if (fileExists .or. counter>100) exit
1443 :
1444 : end do
1445 :
1446 35 : if (fileExists) then
1447 35 : Err%occurred = .false.
1448 : ! LCOV_EXCL_START
1449 : else
1450 : Err%occurred = .true.
1451 : Err%msg = PROCEDURE_NAME // ": Failed to copy file from '" // pathOld // "' to '" // pathNew // "' after " // num2str(counter) // " attempts."
1452 : return
1453 : end if
1454 : ! LCOV_EXCL_STOP
1455 :
1456 35 : end subroutine copyFile
1457 :
1458 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1459 :
1460 : !> \brief
1461 : !> Remove the requested file.
1462 : !>
1463 : !> \param[in] path : The path to the file to be removed.
1464 : !> \param[out] Err : An object of class [Err_type](@ref err_mod::err_type)
1465 : !! indicating whether any error has occurred before, during, or after the sleep.
1466 : !>
1467 : !> \warning
1468 : !> This subroutine can become extremely dangerous if one does not fully understands
1469 : !! the scopes of the removal of the requested file or pattern. **Use with caution**.
1470 : !>
1471 : !> \warning
1472 : !> Parallel processes cannot simultaneously delete the same file. So make sure
1473 : !> to provide the optional output `Err` argument to properly handle any exceptions.
1474 : !>
1475 : !> \remark
1476 : !> This procedure has been written as a subroutine vs. function to provide
1477 : !> the flexibility of passing `Err` as an *optional* input argument.
1478 : !>
1479 : !> \remark
1480 : !> Provide the output optional argument `Err`, to properly handle errors and exceptions.
1481 205 : subroutine removeFile(path,Err)
1482 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
1483 : !DEC$ ATTRIBUTES DLLEXPORT :: removeFile
1484 : #endif
1485 :
1486 35 : use Err_mod, only: Err_type
1487 : use String_mod, only: num2str
1488 : implicit none
1489 : character(*), intent(in) :: path
1490 : type(Err_type), intent(out), optional :: Err
1491 : !logical , intent(in), optional :: isWindows
1492 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME // "@removeFile()"
1493 : integer :: fileUnit, i
1494 : logical :: isPresentErr
1495 : logical :: fileExists
1496 : logical :: isOpen
1497 :
1498 107 : fileExists = .true.
1499 107 : isPresentErr = present(Err)
1500 :
1501 : ! attempt to delete the file repeatedly
1502 :
1503 186 : loopDeleteFile: do i = 1, 100
1504 :
1505 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1506 : ! First check whether file exists.
1507 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1508 :
1509 186 : if (isPresentErr) then
1510 168 : Err%occurred = .false.
1511 168 : inquire(file=path, opened=isOpen, exist=fileExists, iostat=Err%stat)
1512 168 : if (Err%stat/=0) then
1513 : ! LCOV_EXCL_START
1514 : Err%occurred = .true.
1515 : Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the existence of file = '" // path // "'."
1516 : return
1517 : end if
1518 : ! LCOV_EXCL_STOP
1519 : else
1520 18 : inquire(file=path, opened=isOpen, exist=fileExists)
1521 : end if
1522 :
1523 : ! If the file does not exist, return.
1524 :
1525 186 : if (.not. fileExists) return
1526 :
1527 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1528 : ! If the file is closed, open it.
1529 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1530 :
1531 107 : if (.not. isOpen) then
1532 :
1533 107 : if (isPresentErr) then
1534 98 : Err%occurred = .false.
1535 : open( newunit = fileUnit & ! LCOV_EXCL_LINE
1536 : , status = "replace" & ! LCOV_EXCL_LINE
1537 : , iostat = Err%stat & ! LCOV_EXCL_LINE
1538 : , file = path & ! LCOV_EXCL_LINE
1539 : #if defined INTEL_COMPILER_ENABLED && defined OS_IS_WINDOWS
1540 : , SHARED & ! LCOV_EXCL_LINE
1541 : #endif
1542 98 : )
1543 98 : if (Err%stat/=0) then
1544 : ! LCOV_EXCL_START
1545 : Err%occurred = .true.
1546 : Err%msg = PROCEDURE_NAME // ": Error occurred while opening the file = '" // path // "'."
1547 : return
1548 : end if
1549 : ! LCOV_EXCL_STOP
1550 : else
1551 : open( newunit = fileUnit & ! LCOV_EXCL_LINE
1552 : , status = "replace" & ! LCOV_EXCL_LINE
1553 : , file = path & ! LCOV_EXCL_LINE
1554 : #if defined INTEL_COMPILER_ENABLED && defined OS_IS_WINDOWS
1555 : , SHARED & ! LCOV_EXCL_LINE
1556 : #endif
1557 9 : )
1558 : end if
1559 :
1560 : end if
1561 :
1562 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1563 : ! Delete the file by closing it.
1564 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1565 :
1566 107 : if (isPresentErr) then
1567 :
1568 98 : Err%occurred = .false.
1569 :
1570 98 : close(fileUnit, status="delete", iostat = Err%stat)
1571 :
1572 98 : if (Err%stat/=0) then
1573 : ! LCOV_EXCL_START
1574 : Err%occurred = .true.
1575 : Err%msg = PROCEDURE_NAME // ": Error occurred while opening the file = '" // path // "'."
1576 : return
1577 : end if
1578 : ! LCOV_EXCL_STOP
1579 :
1580 : else
1581 :
1582 9 : close(fileUnit, status="delete")
1583 :
1584 : end if
1585 :
1586 : end do loopDeleteFile
1587 :
1588 0 : if (isPresentErr .and. fileExists) Then
1589 : ! LCOV_EXCL_START
1590 : Err%occurred = .true.
1591 : Err%msg = PROCEDURE_NAME // ": Failed to delete file = '" // path // "'."
1592 : return
1593 : end if
1594 : ! LCOV_EXCL_STOP
1595 :
1596 : !if (isPresentErr .and. present(isWindows)) then
1597 : !
1598 : ! blockBrittle: block
1599 : !
1600 : ! character(:), allocatable :: cmd
1601 : ! integer :: counter
1602 : !
1603 : ! if (isWindows) then
1604 : ! cmd = "del " // path // " > nul"
1605 : ! else
1606 : ! cmd = "rm " // path
1607 : ! end if
1608 : !
1609 : ! counter = 0
1610 : ! do
1611 : ! counter = counter + 1
1612 : ! call executeCmd( command=cmd, Err=Err )
1613 : ! if (Err%occurred) then
1614 : ! Err%msg = PROCEDURE_NAME // ": Error occurred while executing command "// cmd // "'." // NLC
1615 : ! return
1616 : ! end if
1617 : ! ! ensure file is removed
1618 : ! inquire(file=path,exist=fileExists,iostat=Err%stat) ! check if the file already exists
1619 : ! if (Err%stat/=0) then
1620 : ! Err%occurred = .true.
1621 : ! Err%msg = PROCEDURE_NAME // ": Error occurred while inquiring the existence of removed file = '" // path // "'."
1622 : ! return
1623 : ! end if
1624 : ! if (fileExists .and. counter<100) cycle
1625 : ! exit
1626 : ! end do
1627 : ! if (fileExists) then
1628 : ! Err%occurred = .true.
1629 : ! Err%msg = PROCEDURE_NAME // ": Failed to remove file = '" // path // "' after " // num2str(counter) // " attempts."
1630 : ! return
1631 : ! end if
1632 : !
1633 : ! end block blockBrittle
1634 : !
1635 : !else
1636 : !
1637 : ! blockRobust: block
1638 : ! logical :: isOpen
1639 : ! integer :: fileUnit
1640 : ! inquire(file=path,opened=isOpen)
1641 : ! if (.not. isOpen) open(newunit = fileUnit, file = path, status = "replace")
1642 : ! close(fileUnit, status="delete", iostat = iostat) ! parallel processes cannot delete the same file
1643 : ! if (isPresentErr) Err%stat = iostat
1644 : ! end block blockRobust
1645 : !
1646 : !end if
1647 :
1648 107 : end subroutine removeFile
1649 :
1650 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1651 :
1652 : end module System_mod ! LCOV_EXCL_LINE
|
