Loading...
Searching...
No Matches
dccalconvertbyunit.f90
Go to the documentation of this file.
1function dccalconvertbyunit1( in_time, in_unit, out_unit, cal ) result( out_time )
2 !
3 ! 単位の変換を行います.
4 !
5 ! 時間の単位として有効な文字列については以下を参照下さい.
6 !
7 ! dc_calendar_types#UNIT_SEC :: 秒の単位
8 ! dc_calendar_types#UNIT_MIN :: 分の単位
9 ! dc_calendar_types#UNIT_HOUR :: 時間の単位
10 ! dc_calendar_types#UNIT_DAY :: 日の単位
11 !
12 ! 省略可能引数 *cal* が省略された場合には, dc_calendar 内部で
13 ! 保持される暦に関する情報を用いた単位の変換が行われます.
14 ! *cal* が省略されない場合にはその変数に設定された暦の情報を
15 ! 用いて単位の変換が行われます.
16 !
17 ! Convert of unit.
18 !
19 ! Valid strings as units of time are follows.
20 !
21 ! dc_calendar_types#UNIT_SEC :: Units of second
22 ! dc_calendar_types#UNIT_MIN :: Units of minute
23 ! dc_calendar_types#UNIT_HOUR :: Units of hour
24 ! dc_calendar_types#UNIT_DAY :: Units of day
25 !
26 ! If an optional argument *cal* is omitted,
27 ! unit is converted with information of a calendar
28 ! that is stored in the "dc_calendar".
29 ! If *cal* is not omitted, unit is converted with information of the variable.
30 !
33 use dc_calendar_types, only: dc_cal, &
38 use dc_message, only: messagenotify
39 use dc_trace, only: beginsub, endsub
40 use dc_types, only: dp, token, string
41 implicit none
42 real(dp):: out_time
43 ! 変換後の時間の数値.
44 !
45 ! Numerical value of time after conversion.
46
47 real(dp), intent(in):: in_time
48 ! 変換前の時間の数値.
49 !
50 ! Numerical value of time before conversion.
51 character(*), intent(in):: in_unit
52 ! 変換前の時間の単位.
53 !
54 ! Units of time before conversion.
55 character(*), intent(in):: out_unit
56 ! 変換後の時間の単位.
57 !
58 ! Units of time after conversion.
59 type(dc_cal), intent(in), optional, target:: cal
60 ! 暦情報を収めたオブジェクト.
61 !
62 ! An object that stores information of
63 ! calendar.
64
65 ! 作業変数
66 ! Work variables
67 !
68 type(dc_cal), pointer:: calp =>null()
69 real(dp):: in_timew
70 integer:: in_unit_sym, out_unit_sym
71!!$ integer:: stat
72!!$ character(STRING):: cause_c
73 character(*), parameter:: subname = 'DCCalConvertByUnit1'
74continue
75!!$ call BeginSub( subname )
76!!$ stat = DC_NOERR
77!!$ cause_c = ''
78
79 out_time = -1.0
80
81 ! オブジェクトのポインタ割付
82 ! Associate pointer of an object
83 !
84 if ( present( cal ) ) then
85 calp => cal
86 else
87 calp => default_cal
88 if ( .not. calp % initialized ) call default_cal_set
89 end if
90
91 ! 初期設定のチェック
92 ! Check initialization
93 !
94 if ( .not. calp % initialized ) then
95 call messagenotify('W', subname, '"cal" is not initialized. <-1> is returned.' )
96!!$ stat = DC_ENOTINIT
97!!$ cause_c = 'DC_CAL'
98 goto 999
99 end if
100
101 ! 単位の解釈
102 ! Parse units
103 !
104 in_unit_sym = dccaldate_str2usym( in_unit )
105 out_unit_sym = dccaldate_str2usym( out_unit )
106
107 ! 数値の変換
108 ! Convert a value
109 !
110 out_time = dccalconvertbyunit( in_time, in_unit_sym, out_unit_sym, cal )
111
112 ! 終了処理, 例外処理
113 ! Termination and Exception handling
114 !
115999 continue
116 nullify( calp )
117!!$ call StoreError( stat, subname, err, cause_c )
118!!$ call EndSub( subname )
119end function dccalconvertbyunit1
120
121!---------------------------------------------------------------------
122
123function dccalconvertbyunit2( in_time, in_unit, out_unit, cal ) result( out_time )
124 !
125 ! 単位の変換を行います.
126 !
127 ! 時間の単位として有効な整数型変数については以下を参照下さい.
128 ! 単位として整数値を直接与えることはせず, 以下の変数を
129 ! 与えてください.
130 !
131 ! dc_calendar_types#UNIT_SYMBOL_SEC :: 秒の単位
132 ! dc_calendar_types#UNIT_SYMBOL_MIN :: 分の単位
133 ! dc_calendar_types#UNIT_SYMBOL_HOUR :: 時間の単位
134 ! dc_calendar_types#UNIT_SYMBOL_DAY :: 日の単位
135 !
136 ! 省略可能引数 *cal* が省略された場合には, dc_calendar 内部で
137 ! 保持される暦に関する情報を用いた単位の変換が行われます.
138 ! *cal* が省略されない場合にはその変数に設定された暦の情報を
139 ! 用いて単位の変換が行われます.
140 !
141 ! Convert of unit.
142 !
143 ! Valid integer variables as units of time are follows.
144 ! Do not specify integer directly, but specify following variables.
145 !
146 ! dc_calendar_types#UNIT_SYMBOL_SEC :: Units of second
147 ! dc_calendar_types#UNIT_SYMBOL_MIN :: Units of minute
148 ! dc_calendar_types#UNIT_SYMBOL_HOUR :: Units of hour
149 ! dc_calendar_types#UNIT_SYMBOL_DAY :: Units of day
150 !
151 ! If an optional argument *cal* is omitted,
152 ! unit is converted with information of a calendar
153 ! that is stored in the "dc_calendar".
154 ! If *cal* is not omitted, unit is converted with information of the variable.
155 !
158 use dc_calendar_types, only: dc_cal, &
162 use dc_message, only: messagenotify
163 use dc_trace, only: beginsub, endsub
164 use dc_types, only: dp, token, string
165 implicit none
166 real(dp):: out_time
167 ! 変換後の時間の数値.
168 !
169 ! Numerical value of time after conversion.
170 real(dp), intent(in):: in_time
171 ! 変換前の時間の数値.
172 !
173 ! Numerical value of time before conversion.
174 integer, intent(in):: in_unit
175 ! 変換前の時間の単位.
176 !
177 ! Units of time before conversion.
178 integer, intent(in):: out_unit
179 ! 変換後の時間の単位.
180 !
181 ! Units of time after conversion.
182 type(dc_cal), intent(in), optional, target:: cal
183 ! 暦情報を収めたオブジェクト.
184 !
185 ! An object that stores information of
186 ! calendar.
187
188 ! 作業変数
189 ! Work variables
190 !
191 type(dc_cal), pointer:: calp =>null()
192 real(dp):: in_timew
193!!$ integer:: stat
194!!$ character(STRING):: cause_c
195 character(*), parameter:: subname = 'DCCalConvertByUnit2'
196continue
197!!$ call BeginSub( subname )
198!!$ stat = DC_NOERR
199!!$ cause_c = ''
200
201 out_time = -1.0
202
203 ! オブジェクトのポインタ割付
204 ! Associate pointer of an object
205 !
206 if ( present( cal ) ) then
207 calp => cal
208 else
209 calp => default_cal
210 if ( .not. calp % initialized ) call default_cal_set
211 end if
212
213 ! 初期設定のチェック
214 ! Check initialization
215 !
216 if ( .not. calp % initialized ) then
217 call messagenotify('W', subname, '"cal" is not initialized. <-1> is returned.' )
218!!$ stat = DC_ENOTINIT
219!!$ cause_c = 'DC_CAL'
220 goto 999
221 end if
222
223 ! 数値の変換
224 ! Convert a value
225 !
226 select case(in_unit)
227 case(unit_symbol_day)
228 in_timew = in_time * calp % hour_in_day &
229 & * calp % min_in_hour &
230 & * calp % sec_in_min
231 case(unit_symbol_hour)
232 in_timew = in_time * calp % min_in_hour &
233 & * calp % sec_in_min
234 case(unit_symbol_min)
235 in_timew = in_time * calp % sec_in_min
236 case(unit_symbol_sec)
237 in_timew = in_time
238 case default
239! cause_c = in_unit
240 call messagenotify('W', subname, 'in_unit=<%d> is invalid. (ONLY day,hour,min,sec are valid).' // &
241 & ' <-1> is returned.', &
242 & i = (/ in_unit /) )
243!!$ stat = DC_EBADUNIT
244 goto 999
245 end select
246
247 select case(out_unit)
248 case(unit_symbol_day)
249 out_time = in_timew / calp % hour_in_day &
250 & / calp % min_in_hour &
251 & / calp % sec_in_min
252 case(unit_symbol_hour)
253 out_time = in_timew / calp % min_in_hour &
254 & / calp % sec_in_min
255 case(unit_symbol_min)
256 out_time = in_timew / calp % sec_in_min
257 case(unit_symbol_sec)
258 out_time = in_timew
259 case default
260! cause_c = out_unit
261 call messagenotify('W', subname, 'out_unit=<%d> is invalid. (ONLY day,hour,min,sec are valid).' // &
262 & ' <-1> is returned.', &
263 & i = (/ out_unit /) )
264!!$ stat = DC_EBADUNIT
265 goto 999
266 end select
267
268 ! 終了処理, 例外処理
269 ! Termination and Exception handling
270 !
271999 continue
272 nullify( calp )
273!!$ call StoreError( stat, subname, err, cause_c )
274!!$ call EndSub( subname )
275end function dccalconvertbyunit2
real(dp) function dccalconvertbyunit1(in_time, in_unit, out_unit, cal)
real(dp) function dccalconvertbyunit2(in_time, in_unit, out_unit, cal)
type(dc_cal), target, save, public default_cal
character(token) function, public dccaltype_str(cal_type)
subroutine, public default_cal_set
integer function, public dccaldate_str2usym(str)
integer, parameter, public unit_symbol_sec
integer, parameter, public unit_symbol_month
integer, parameter, public unit_symbol_year
integer, parameter, public unit_symbol_hour
integer, parameter, public unit_symbol_day
integer, parameter, public unit_symbol_min
subroutine, public storeerror(number, where, err, cause_c, cause_i)
Definition dc_error.f90:830
integer, parameter, public dc_ebadunit
Definition dc_error.f90:559
integer, parameter, public dc_enotinit
Definition dc_error.f90:557
integer, parameter, public dc_noerr
Definition dc_error.f90:509
Provides kind type parameter values.
Definition dc_types.f90:49
integer, parameter, public token
Character length for word, token
Definition dc_types.f90:109
integer, parameter, public string
Character length for string
Definition dc_types.f90:118
integer, parameter, public dp
Double Precision Real number
Definition dc_types.f90:83