libsim Versione 7.2.6
optional_values.f90
1! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2! authors:
3! Davide Cesari <dcesari@arpa.emr.it>
4! Paolo Patruno <ppatruno@arpa.emr.it>
5
6! This program is free software; you can redistribute it and/or
7! modify it under the terms of the GNU General Public License as
8! published by the Free Software Foundation; either version 2 of
9! the License, or (at your option) any later version.
10
11! This program is distributed in the hope that it will be useful,
12! but WITHOUT ANY WARRANTY; without even the implied warranty of
13! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14! GNU General Public License for more details.
15
16! You should have received a copy of the GNU General Public License
17! along with this program. If not, see <http://www.gnu.org/licenses/>.
18
19!> Module for quickly interpreting the \c OPTIONAL parameters passed
20!! to a subprogram.
21!! This module defines functions and subroutines that handle in a
22!! quick way \c OPTIONAL parameters in a subprogram by returning a
23!! useable missing value if a given parameter has not been provided.
24!! The module provides a generic subroutine, valid for almost all
25!! intrinsic types, and specific functions.
26!!
27!! \ingroup base
30IMPLICIT NONE
31
32!> Generic subroutine for checking \c OPTIONAL parameters.
33!! The generic interface has to be used instead of the specific
34!! one. It sets the output value to input, if input is present,
35!! otherwise it sets it to missing value.
36INTERFACE optio
37 MODULE PROCEDURE soptio_b, soptio_s, soptio_l, soptio_r, soptio_d, &
38 soptio_c, soptio_log
39END INTERFACE
40
41PRIVATE
42PUBLIC optio, &
43 optio_b, optio_s, optio_i, optio_l, optio_r, optio_d, optio_c, optio_log, &
44 soptio_b, soptio_s, soptio_l, soptio_r, soptio_d, soptio_c, soptio_log
45
46CONTAINS
47
48! Functions
49
50!> Return the optional value if present, otherwise return missing value.
51ELEMENTAL INTEGER(kind=int_b) FUNCTION optio_b(var)
52INTEGER(kind=int_b),INTENT(in),OPTIONAL :: var !< variable to be checked
53
54if (present(var))then
55 optio_b=var
56else
57 optio_b=ibmiss
58end if
59
60END FUNCTION optio_b
61
62!> Return the optional value if present, otherwise return missing value.
63ELEMENTAL INTEGER(kind=int_s) FUNCTION optio_s(var)
64INTEGER(kind=int_s),INTENT(in),OPTIONAL :: var !< variable to be checked
65
66if (present(var))then
67 optio_s=var
68else
69 optio_s=ismiss
70end if
71
72END FUNCTION optio_s
73
74!> Return the optional value if present, otherwise return missing value.
75ELEMENTAL INTEGER(kind=int_l) FUNCTION optio_i(var)
76INTEGER(kind=int_l),INTENT(in),OPTIONAL :: var !< variable to be checked
77
78if (present(var))then
79 optio_i=var
80else
81 optio_i=imiss
82end if
83
84END FUNCTION optio_i
85
86!> Return the optional value if present, otherwise return missing value.
87ELEMENTAL INTEGER(kind=int_l) FUNCTION optio_l(var)
88INTEGER(kind=int_l),INTENT(in),OPTIONAL :: var !< variable to be checked
89
90if (present(var))then
91 optio_l=var
92else
93 optio_l=ilmiss
94end if
95
96END FUNCTION optio_l
97
98!> Return the optional value if present, otherwise return missing value.
99ELEMENTAL REAL FUNCTION optio_r(var)
100REAL,INTENT(in),OPTIONAL :: var !< variable to be checked
101
102if (present(var))then
103 optio_r=var
104else
105 optio_r=rmiss
106end if
107
108END FUNCTION optio_r
109
110!> Return the optional value if present, otherwise return missing value.
111ELEMENTAL DOUBLE PRECISION FUNCTION optio_d(var)
112DOUBLE PRECISION,INTENT(in),OPTIONAL :: var !< variable to be checked
113
114if (present(var))then
115 optio_d=var
116else
117 optio_d=rdmiss
118end if
119
120END FUNCTION optio_d
121
122!> Return the optional value if present, otherwise return missing value.
123!! Unfortunately elemental is not possible here.
124FUNCTION optio_c(var,len) RESULT(char)
125CHARACTER (len=*),INTENT(in),OPTIONAL :: var !< variable to be checked
126INTEGER,INTENT(in) :: len !< length of the result
127
128CHARACTER(len=len) :: char
129
130if (present(var))then
131 char=var
132else
133 char=cmiss
134end if
135
136END FUNCTION optio_c
137
138!> Return the optional value if present, otherwise return \c .FALSE.
139ELEMENTAL LOGICAL FUNCTION optio_log(var)
140LOGICAL,INTENT(in),OPTIONAL :: var !< variable to be checked
141
142if (present(var))then
143 optio_log=var
144else
145 optio_log=.false.
146end if
147
148END FUNCTION optio_log
149
150
151! Subroutines
152
153!> Set the output value to input, if input is present, otherwise set it
154!! to missing value.
155ELEMENTAL SUBROUTINE soptio_b(var,optio_b)
156INTEGER(kind=int_b),INTENT(in),OPTIONAL :: var !< variable to be checked
157INTEGER(kind=int_b),INTENT(out) :: optio_b !< equal to \a var if present, otherwise equal to the corresponding missing value
158
159if (present(var))then
160 optio_b=var
161else
162 optio_b=ibmiss
163end if
164
165END SUBROUTINE soptio_b
166
167!> Set the output value to input, if input is present, otherwise set it
168!! to missing value.
169ELEMENTAL SUBROUTINE soptio_s(var,optio_s)
170INTEGER(kind=int_s),INTENT(in),OPTIONAL :: var !< variable to be checked
171INTEGER(kind=int_s),INTENT(out) :: optio_s !< equal to \a var if present, otherwise equal to the corresponding missing value
172
173if (present(var))then
174 optio_s=var
175else
176 optio_s=ismiss
177end if
178
179END SUBROUTINE soptio_s
180
181!> Set the output value to input, if input is present, otherwise set it
182!! to missing value.
183ELEMENTAL SUBROUTINE soptio_l(var,optio_l)
184INTEGER(kind=int_l),INTENT(in),OPTIONAL :: var !< variable to be checked
185INTEGER(kind=int_l),INTENT(out) :: optio_l !< equal to \a var if present, otherwise equal to the corresponding missing value
186
187if (present(var))then
188 optio_l=var
189else
190 optio_l=ilmiss
191end if
192
193END SUBROUTINE soptio_l
194
195!> Set the output value to input, if input is present, otherwise set it
196!! to missing value.
197ELEMENTAL SUBROUTINE soptio_r(var,optio_r)
198REAL,INTENT(in),OPTIONAL :: var !< variable to be checked
199REAL,INTENT(out) :: optio_r !< equal to \a var if present, otherwise equal to the corresponding missing value
200
201if (present(var))then
202 optio_r=var
203else
204 optio_r=rmiss
205end if
206
207END SUBROUTINE soptio_r
208
209!> Set the output value to input, if input is present, otherwise set it
210!! to missing value.
211ELEMENTAL SUBROUTINE soptio_d(var,optio_d)
212DOUBLE PRECISION,INTENT(in),OPTIONAL :: var !< variable to be checked
213DOUBLE PRECISION,INTENT(out) :: optio_d !< equal to \a var if present, otherwise equal to the corresponding missing value
214
215if (present(var))then
216 optio_d=var
217else
218 optio_d=rdmiss
219end if
220
221END SUBROUTINE soptio_d
222
223
224!> Set the output value to input, if input is present, otherwise set it
225!! to missing value.
226ELEMENTAL SUBROUTINE soptio_c(var,optio_c)
227CHARACTER (len=*),INTENT(in),OPTIONAL :: var !< variable to be checked
228CHARACTER (len=*),INTENT(out) :: optio_c !< equal to \a var if present, otherwise equal to the corresponding missing value
229
230if (present(var))then
231 optio_c=var
232else
233 optio_c=cmiss
234end if
235
236END SUBROUTINE soptio_c
237
238!> Set the output value to input, if input is present, otherwise set it
239!! to \c .FALSE.
240ELEMENTAL SUBROUTINE soptio_log(var,optio_log)
241LOGICAL,INTENT(in),OPTIONAL :: var !< variable to be checked
242LOGICAL,INTENT(out) :: optio_log !< equal to \a var if present, otherwise equal to .false.
243
244if (present(var))then
245 optio_log=var
246else
247 optio_log=.false.
248end if
249
250END SUBROUTINE soptio_log
251
252
253END MODULE optional_values
254
Generic subroutine for checking OPTIONAL parameters.
Definitions of constants and functions for working with missing values.
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.

Generated with Doxygen.