-
Notifications
You must be signed in to change notification settings - Fork 3
/
m_system.F90
182 lines (137 loc) · 5.72 KB
/
m_system.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
!! ----------------------------------------------------------------------------------------------------------------------------- !!
!>
!! Linux/Mac system routines, for processig command line argument, environment variables, and system call
!<
!! --
module m_system
!! -- Dependency
use m_std
!! -- Declarations
implicit none
private
public :: system__getarg
public :: system__getenv
public :: system__call
public :: system__iargc
public :: system__expenv
!! --------------------------------------------------------------------------------------------------------------------------- !!
!>
!! Obtain command line arguments for character, integer, single and double precision data
!!
!! It uses Fortran2003 statement
!<
!! --
interface system__getarg
module procedure getarg_a, getarg_i, getarg_f, getarg_d
end interface
!! --------------------------------------------------------------------------------------------------------------------------- !!
contains
!! --------------------------------------------------------------------------------------------------------------------------- !!
!>
!! Do system-call.
!!
!! @note It uses out-of-standard routines, but it works with most of modern fortran compilers.
!!
!<
!! --
subroutine system__call (cmd)
character(*), intent(in) :: cmd
!! ----
call system( cmd )
end subroutine system__call
!! --------------------------------------------------------------------------------------------------------------------------- !!
!! --------------------------------------------------------------------------------------------------------------------------- !!
!>
!! Returns a number of arguments. Fortran2003 wrapper function
!<
!! --
integer function system__iargc()
system__iargc = command_argument_count()
end function system__iargc
!! --------------------------------------------------------------------------------------------------------------------------- !!
!! --------------------------------------------------------------------------------------------------------------------------- !!
!>
!! Obtain environmental variable "name".
!<
!! --
subroutine system__getenv( name, value )
!! -- Arguments
character(*), intent(in) :: name
character(*), intent(out) :: value
!! ----
call get_environment_variable( name, value )
end subroutine system__getenv
!! --------------------------------------------------------------------------------------------------------------------------- !!
!! --------------------------------------------------------------------------------------------------------------------------- !!
!>
!! get i-th command line argument, Fortran2003 wrapper subroutine
!<
!! --
subroutine getarg_a (i, arg)
!! -- Arguments
integer, intent(in) :: i ! order of the arguments
character(*), intent(out) :: arg ! argument
call get_command_argument( i, arg )
end subroutine getarg_a
!! --------------------------------------------------------------------------------------------------------------------------- !!
!! --------------------------------------------------------------------------------------------------------------------------- !!
subroutine getarg_i (i, arg)
!! -- Arguments
integer, intent(in) :: i
integer, intent(out) :: arg
character(256) :: carg
!! ----
call getarg_a( i, carg )
read(carg,*) arg
end subroutine getarg_i
!! --------------------------------------------------------------------------------------------------------------------------- !!
!! --------------------------------------------------------------------------------------------------------------------------- !!
subroutine getarg_f (i, arg)
!! -- Arguments
integer, intent(in) :: i
real, intent(out) :: arg
character(256) :: carg
!! ----
call getarg_a( i, carg )
read(carg,*) arg
end subroutine getarg_f
!! --------------------------------------------------------------------------------------------------------------------------- !!
!! --------------------------------------------------------------------------------------------------------------------------- !!
subroutine getarg_d (i, arg)
!! -- Arguments
integer, intent(in) :: i
real(DP), intent(out) :: arg
character(256) :: carg
!! ----
call getarg_a( i, carg )
read(carg,*) arg
end subroutine getarg_d
!! --------------------------------------------------------------------------------------------------------------------------- !!
!! --------------------------------------------------------------------------------------------------------------------------- !!
!>
!! Expand shell environmental variables wrapped in ${...}
!<
!! --
subroutine system__expenv( str )
character(*), intent(inout) :: str
character(256) :: str2
integer :: ikey1, ikey2
integer :: iptr
character(256) :: str3
iptr = 1
str2 = ''
do
ikey1 = scan( str(iptr:), "${" ) + iptr - 1
if( ikey1==iptr-1 ) exit
ikey2 = scan( str(iptr:), "}" ) + iptr -1
str2=trim(str2) // str(iptr:ikey1-1)
call system__getenv( str(ikey1+2:ikey2-1), str3 )
str2 = trim(str2) // trim(str3)
iptr = ikey2+1
end do
str2 = trim(str2) // trim(str(iptr:))
str = trim(str2)
end subroutine system__expenv
!! --------------------------------------------------------------------------------------------------------------------------- !!
end module m_system
!! ----------------------------------------------------------------------------------------------------------------------------- !!