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
58 use dc_message, only: messagenotify
59 use dc_string, only: lchar
60 use dc_trace, only: beginsub, endsub
63 implicit none
64 character(*), intent(out), optional:: cal_type
65
66
67
68 integer, intent(out), optional:: month_in_year
69
70
71 integer, intent(out), optional:: day_in_month(:)
72
73
74
75
76
77
78
79
80
81 integer, pointer, optional:: day_in_month_ptr(:)
82
83
84
85
86
87
88
89
90
91 integer, intent(out), optional:: hour_in_day
92
93
94 integer, intent(out), optional:: min_in_hour
95
96
97 real(DP), intent(out), optional:: sec_in_min
98
99
100 type(DC_CAL), intent(in), optional, target:: cal
101
102
103
104
105 logical, intent(out), optional:: err
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124 type(DC_CAL), pointer:: calp =>null()
125 integer:: siz_dm
126 integer:: stat
127 character(STRING):: cause_c
128 character(*), parameter:: subname = 'DCCalInquire1'
129continue
130 call beginsub( subname )
132 cause_c = ''
133
134
135
136
137 if ( present( cal ) ) then
138 calp => cal
139 else
142 end if
143
144
145
146
147 if ( .not. calp % initialized ) then
149 cause_c = 'DC_CAL'
150 goto 999
151 end if
152
153
154
155
156 if ( present( cal_type ) ) then
158 end if
159 if ( present( month_in_year ) ) month_in_year = calp % month_in_year
160 if ( present( hour_in_day ) ) hour_in_day = calp % hour_in_day
161 if ( present( min_in_hour ) ) min_in_hour = calp % min_in_hour
162 if ( present( sec_in_min ) ) sec_in_min = calp % sec_in_min
163
164 if ( present( day_in_month ) ) then
165 if ( size( day_in_month ) > 0 ) then
166 day_in_month = 0
167 siz_dm = min( size( day_in_month ), size( calp % day_in_month ) )
168 day_in_month(1:siz_dm) = calp % day_in_month(1:siz_dm)
169 end if
170 end if
171
172 if ( present( day_in_month_ptr ) ) then
173 siz_dm = size( calp % day_in_month )
174 allocate( day_in_month_ptr(1:siz_dm) )
175 day_in_month_ptr(1:siz_dm) = calp % day_in_month(1:siz_dm)
176 end if
177
178
179
180
181999 continue
182 nullify( calp )
183 call storeerror( stat, subname, err, cause_c )
184 call endsub( subname )
type(dc_cal), target, save, public default_cal
character(token) function, public dccaltype_str(cal_type)
subroutine, public default_cal_set
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public dc_enotinit
integer, parameter, public dc_noerr
Provides kind type parameter values.
integer, parameter, public string
Character length for string
integer, parameter, public dp
Double Precision Real number