gtool5 Fortran 90/95 ライブラリ 1.0.0-rc5
English
Loading...
Searching...
No Matches
historyaddattr.f90
Go to the documentation of this file.
1!--
2! *** Caution!! ***
3!
4! This file is generated from "historyaddattr.rb2f90" by Ruby 3.3.8.
5! Please do not edit this file directly.
6!
7! [JAPANESE]
8!
9! ※※※ 注意!!! ※※※
10!
11! このファイルは "historyaddattr.rb2f90" から Ruby 3.3.8
12! によって自動生成されたファイルです.
13! このファイルを直接編集しませんようお願い致します.
14!
15!
16!++
30 subroutine historyaddattrchar0( &
31 & varname, attrname, value, history, err)
32 !
33 !
48 !
49 !
52 use gtdata_generic, only: put_attr
53 use gtdata_types, only: gt_variable
54 use dc_string, only: tochar
55 use dc_url, only: gt_plus
56 use dc_error, only: storeerror, dc_noerr, nf90_enotvar, hst_empinoaxisdata
57 use dc_message, only: messagenotify
58 use dc_trace, only: beginsub, endsub
59 use dc_types, only: string
60 implicit none
61 character(*), intent(in):: varname
62 ! 変数の名前。
63 !
64 ! ここで指定するものは、
65 ! HistoryCreateの *dims* 、
66 ! または HistoryAddVariable の
67 ! *varname* で既に指定されてい
68 ! なければなりません。
69 !
70 character(*), intent(in):: attrname
71 ! 変数またはファイル全体に付
72 ! 加する属性の名前
73 !
74 ! "<b><tt>+</tt></b>" (プラ
75 ! ス) を属性名の先頭につける
76 ! 場合には、ファイル全体に属
77 ! 性を付加します。
78 ! ファイル全体へ属性を付加
79 ! する場合でも、 HistoryCreate
80 ! の *dims* 、または
81 ! HistoryAddVariable の
82 ! *varname* で既に指定されてい
83 ! る変数を *varname* に指定する
84 ! 必要があります。
85 !
86 character(*), intent(in):: value
87 ! 属性の値
88 !
89 type(gt_history), intent(inout), target, optional:: history
90 ! 出力ファイルの設定に関する情報を
91 ! 格納した構造体
92 !
93 ! ここに指定するものは、
94 ! HistoryCreate によって初期設定
95 ! されていなければなりません。
96 !
97 logical, intent(out), optional:: err
98 ! 例外処理用フラグ.
99 ! デフォルトでは, この手続き内でエラーが
100 ! 生じた場合, プログラムは強制終了します.
101 ! 引数 *err* が与えられる場合,
102 ! プログラムは強制終了せず, 代わりに
103 ! *err* に .true. が代入されます.
104 !
105 ! Exception handling flag.
106 ! By default, when error occur in
107 ! this procedure, the program aborts.
108 ! If this *err* argument is given,
109 ! .true. is substituted to *err* and
110 ! the program does not abort.
111 type(gt_history), pointer:: hst =>null()
112 type(gt_variable):: var
113 integer:: v_ord
114 logical:: err_not_found
115 integer:: stat
116 character(STRING):: cause_c
117 character(len = *), parameter:: subname = "HistoryAddAttrChar0"
118 continue
119 call beginsub(subname, &
120 & 'varname=<%c> attrname=<%c>, value=<%c>', &
121 & c1=trim(varname), c2=trim(attrname), c3=trim(value))
122 stat = dc_noerr
123 cause_c = ''
124 ! 操作対象決定
125 if (present(history)) then
126 hst => history
127 else
128 hst => default
129 endif
130 if ( hst % mpi_gather .and. &
131 & .not. hst % mpi_fileinfo % already_output ) then
132 call messagenotify('W', subname, &
133 & 'Specify data of axes in whole area by "HistoryPutAxisMPI" explicitly ' // &
134 & 'before "call HistoryAddAttr".' )
135 stat = hst_empinoaxisdata
136 cause_c = ''
137 goto 999
138 end if
139 if ( .not. hst % mpi_gather &
140 & .or. ( hst % mpi_gather .and. hst % mpi_myrank == 0 ) ) then
141 if (varname == "") then
142 ! とりあえず無駄だが大域属性を何度もつける
143 do, v_ord = 1, size(hst % vars)
144 call put_attr(hst % vars(v_ord), gt_plus // attrname, value)
145 enddo
146 else
147 call lookup_var_or_dim( hst, varname, var, err_not_found )
148 if ( .not. err_not_found ) then
149 call put_attr(var, attrname, value)
150 else
151 stat = nf90_enotvar
152 cause_c = 'varname="' // trim(varname) // '" is not found'
153 goto 999
154 endif
155 endif
156 end if
157999 continue
158 call storeerror(stat, subname, err, cause_c=cause_c)
159 call endsub(subname)
160 end subroutine historyaddattrchar0
162 & varname, attrname, value, history, err)
163 !
164 !
167 use gtdata_generic, only: put_attr
168 use gtdata_types, only: gt_variable
169 use dc_string, only: tochar
170 use dc_url, only: gt_plus
171 use dc_error, only: storeerror, dc_noerr, nf90_enotvar, hst_empinoaxisdata
172 use dc_message, only: messagenotify
173 use dc_trace, only: beginsub, endsub
174 use dc_types, only: string
175 implicit none
176 character(*), intent(in):: varname
177 character(*), intent(in):: attrname
178 logical, intent(in):: value
179 type(gt_history), intent(inout), target, optional:: history
180 logical, intent(out), optional:: err
181 type(gt_history), pointer:: hst =>null()
182 type(gt_variable):: var
183 integer:: v_ord
184 logical:: err_not_found
185 integer:: stat
186 character(STRING):: cause_c
187 character(len = *), parameter:: subname = "HistoryAddAttrLogical0"
188 continue
189 call beginsub(subname, &
190 & 'varname=<%c> attrname=<%c>, value=<%c>', &
191 & c1=trim(varname), c2=trim(attrname), c3=trim(tochar(value)))
192 stat = dc_noerr
193 cause_c = ''
194 ! 操作対象決定
195 if (present(history)) then
196 hst => history
197 else
198 hst => default
199 endif
200 if ( hst % mpi_gather .and. &
201 & .not. hst % mpi_fileinfo % already_output ) then
202 call messagenotify('W', subname, &
203 & 'Specify data of axes in whole area by "HistoryPutAxisMPI" explicitly ' // &
204 & 'before "call HistoryAddAttr".' )
205 stat = hst_empinoaxisdata
206 cause_c = ''
207 goto 999
208 end if
209 if ( .not. hst % mpi_gather &
210 & .or. ( hst % mpi_gather .and. hst % mpi_myrank == 0 ) ) then
211 if (varname == "") then
212 ! とりあえず無駄だが大域属性を何度もつける
213 do, v_ord = 1, size(hst % vars)
214 call put_attr(hst % vars(v_ord), gt_plus // attrname, value)
215 enddo
216 else
217 call lookup_var_or_dim( hst, varname, var, err_not_found )
218 if ( .not. err_not_found ) then
219 call put_attr(var, attrname, value)
220 else
221 stat = nf90_enotvar
222 cause_c = 'varname="' // trim(varname) // '" is not found'
223 goto 999
224 endif
225 endif
226 end if
227999 continue
228 call storeerror(stat, subname, err, cause_c=cause_c)
229 call endsub(subname)
230 end subroutine historyaddattrlogical0
231 subroutine historyaddattrint0( &
232 & varname, attrname, value, history, err)
233 !
234 !
237 use gtdata_generic, only: put_attr
238 use gtdata_types, only: gt_variable
239 use dc_string, only: tochar
240 use dc_url, only: gt_plus
241 use dc_error, only: storeerror, dc_noerr, nf90_enotvar, hst_empinoaxisdata
242 use dc_message, only: messagenotify
243 use dc_trace, only: beginsub, endsub
244 use dc_types, only: string
245 implicit none
246 character(*), intent(in):: varname
247 character(*), intent(in):: attrname
248 integer, intent(in):: value
249 type(gt_history), intent(inout), target, optional:: history
250 logical, intent(out), optional:: err
251 type(gt_history), pointer:: hst =>null()
252 type(gt_variable):: var
253 integer:: v_ord
254 logical:: err_not_found
255 integer:: stat
256 character(STRING):: cause_c
257 character(len = *), parameter:: subname = "HistoryAddAttrInt0"
258 continue
259 call beginsub(subname, &
260 & 'varname=<%c> attrname=<%c>, value=<%c>', &
261 & c1=trim(varname), c2=trim(attrname), c3=trim(tochar(value)))
262 stat = dc_noerr
263 cause_c = ''
264 ! 操作対象決定
265 if (present(history)) then
266 hst => history
267 else
268 hst => default
269 endif
270 if ( hst % mpi_gather .and. &
271 & .not. hst % mpi_fileinfo % already_output ) then
272 call messagenotify('W', subname, &
273 & 'Specify data of axes in whole area by "HistoryPutAxisMPI" explicitly ' // &
274 & 'before "call HistoryAddAttr".' )
275 stat = hst_empinoaxisdata
276 cause_c = ''
277 goto 999
278 end if
279 if ( .not. hst % mpi_gather &
280 & .or. ( hst % mpi_gather .and. hst % mpi_myrank == 0 ) ) then
281 if (varname == "") then
282 ! とりあえず無駄だが大域属性を何度もつける
283 do, v_ord = 1, size(hst % vars)
284 call put_attr(hst % vars(v_ord), gt_plus // attrname, (/value/))
285 enddo
286 else
287 call lookup_var_or_dim( hst, varname, var, err_not_found )
288 if ( .not. err_not_found ) then
289 call put_attr(var, attrname, (/value/))
290 else
291 stat = nf90_enotvar
292 cause_c = 'varname="' // trim(varname) // '" is not found'
293 goto 999
294 endif
295 endif
296 end if
297999 continue
298 call storeerror(stat, subname, err, cause_c=cause_c)
299 call endsub(subname)
300 end subroutine historyaddattrint0
301 subroutine historyaddattrint1( &
302 & varname, attrname, value, history, err)
303 !
304 !
307 use gtdata_generic, only: put_attr
308 use gtdata_types, only: gt_variable
309 use dc_string, only: tochar
310 use dc_url, only: gt_plus
311 use dc_error, only: storeerror, dc_noerr, nf90_enotvar, hst_empinoaxisdata
312 use dc_message, only: messagenotify
313 use dc_trace, only: beginsub, endsub
314 use dc_types, only: string
315 implicit none
316 character(*), intent(in):: varname
317 character(*), intent(in):: attrname
318 integer, intent(in):: value(:)
319 type(gt_history), intent(inout), target, optional:: history
320 logical, intent(out), optional:: err
321 type(gt_history), pointer:: hst =>null()
322 type(gt_variable):: var
323 integer:: v_ord
324 logical:: err_not_found
325 integer:: stat
326 character(STRING):: cause_c
327 character(len = *), parameter:: subname = "HistoryAddAttrInt1"
328 continue
329 call beginsub(subname, &
330 & 'varname=<%c> attrname=<%c>, value=<%c>', &
331 & c1=trim(varname), c2=trim(attrname), c3=trim(tochar(value)))
332 stat = dc_noerr
333 cause_c = ''
334 ! 操作対象決定
335 if (present(history)) then
336 hst => history
337 else
338 hst => default
339 endif
340 if ( hst % mpi_gather .and. &
341 & .not. hst % mpi_fileinfo % already_output ) then
342 call messagenotify('W', subname, &
343 & 'Specify data of axes in whole area by "HistoryPutAxisMPI" explicitly ' // &
344 & 'before "call HistoryAddAttr".' )
345 stat = hst_empinoaxisdata
346 cause_c = ''
347 goto 999
348 end if
349 if ( .not. hst % mpi_gather &
350 & .or. ( hst % mpi_gather .and. hst % mpi_myrank == 0 ) ) then
351 if (varname == "") then
352 ! とりあえず無駄だが大域属性を何度もつける
353 do, v_ord = 1, size(hst % vars)
354 call put_attr(hst % vars(v_ord), gt_plus // attrname, (/value/))
355 enddo
356 else
357 call lookup_var_or_dim( hst, varname, var, err_not_found )
358 if ( .not. err_not_found ) then
359 call put_attr(var, attrname, (/value/))
360 else
361 stat = nf90_enotvar
362 cause_c = 'varname="' // trim(varname) // '" is not found'
363 goto 999
364 endif
365 endif
366 end if
367999 continue
368 call storeerror(stat, subname, err, cause_c=cause_c)
369 call endsub(subname)
370 end subroutine historyaddattrint1
372 & varname, attrname, value, history, err)
373 !
374 !
377 use gtdata_generic, only: put_attr
378 use gtdata_types, only: gt_variable
379 use dc_string, only: tochar
380 use dc_url, only: gt_plus
381 use dc_error, only: storeerror, dc_noerr, nf90_enotvar, hst_empinoaxisdata
382 use dc_message, only: messagenotify
383 use dc_trace, only: beginsub, endsub
384 use dc_types, only: string
385 implicit none
386 character(*), intent(in):: varname
387 character(*), intent(in):: attrname
388 real, intent(in):: value
389 type(gt_history), intent(inout), target, optional:: history
390 logical, intent(out), optional:: err
391 type(gt_history), pointer:: hst =>null()
392 type(gt_variable):: var
393 integer:: v_ord
394 logical:: err_not_found
395 integer:: stat
396 character(STRING):: cause_c
397 character(len = *), parameter:: subname = "HistoryAddAttrReal0"
398 continue
399 call beginsub(subname, &
400 & 'varname=<%c> attrname=<%c>, value=<%c>', &
401 & c1=trim(varname), c2=trim(attrname), c3=trim(tochar(value)))
402 stat = dc_noerr
403 cause_c = ''
404 ! 操作対象決定
405 if (present(history)) then
406 hst => history
407 else
408 hst => default
409 endif
410 if ( hst % mpi_gather .and. &
411 & .not. hst % mpi_fileinfo % already_output ) then
412 call messagenotify('W', subname, &
413 & 'Specify data of axes in whole area by "HistoryPutAxisMPI" explicitly ' // &
414 & 'before "call HistoryAddAttr".' )
415 stat = hst_empinoaxisdata
416 cause_c = ''
417 goto 999
418 end if
419 if ( .not. hst % mpi_gather &
420 & .or. ( hst % mpi_gather .and. hst % mpi_myrank == 0 ) ) then
421 if (varname == "") then
422 ! とりあえず無駄だが大域属性を何度もつける
423 do, v_ord = 1, size(hst % vars)
424 call put_attr(hst % vars(v_ord), gt_plus // attrname, (/value/))
425 enddo
426 else
427 call lookup_var_or_dim( hst, varname, var, err_not_found )
428 if ( .not. err_not_found ) then
429 call put_attr(var, attrname, (/value/))
430 else
431 stat = nf90_enotvar
432 cause_c = 'varname="' // trim(varname) // '" is not found'
433 goto 999
434 endif
435 endif
436 end if
437999 continue
438 call storeerror(stat, subname, err, cause_c=cause_c)
439 call endsub(subname)
440 end subroutine historyaddattrreal0
442 & varname, attrname, value, history, err)
443 !
444 !
447 use gtdata_generic, only: put_attr
448 use gtdata_types, only: gt_variable
449 use dc_string, only: tochar
450 use dc_url, only: gt_plus
451 use dc_error, only: storeerror, dc_noerr, nf90_enotvar, hst_empinoaxisdata
452 use dc_message, only: messagenotify
453 use dc_trace, only: beginsub, endsub
454 use dc_types, only: string
455 implicit none
456 character(*), intent(in):: varname
457 character(*), intent(in):: attrname
458 real, intent(in):: value(:)
459 type(gt_history), intent(inout), target, optional:: history
460 logical, intent(out), optional:: err
461 type(gt_history), pointer:: hst =>null()
462 type(gt_variable):: var
463 integer:: v_ord
464 logical:: err_not_found
465 integer:: stat
466 character(STRING):: cause_c
467 character(len = *), parameter:: subname = "HistoryAddAttrReal1"
468 continue
469 call beginsub(subname, &
470 & 'varname=<%c> attrname=<%c>, value=<%c>', &
471 & c1=trim(varname), c2=trim(attrname), c3=trim(tochar(value)))
472 stat = dc_noerr
473 cause_c = ''
474 ! 操作対象決定
475 if (present(history)) then
476 hst => history
477 else
478 hst => default
479 endif
480 if ( hst % mpi_gather .and. &
481 & .not. hst % mpi_fileinfo % already_output ) then
482 call messagenotify('W', subname, &
483 & 'Specify data of axes in whole area by "HistoryPutAxisMPI" explicitly ' // &
484 & 'before "call HistoryAddAttr".' )
485 stat = hst_empinoaxisdata
486 cause_c = ''
487 goto 999
488 end if
489 if ( .not. hst % mpi_gather &
490 & .or. ( hst % mpi_gather .and. hst % mpi_myrank == 0 ) ) then
491 if (varname == "") then
492 ! とりあえず無駄だが大域属性を何度もつける
493 do, v_ord = 1, size(hst % vars)
494 call put_attr(hst % vars(v_ord), gt_plus // attrname, (/value/))
495 enddo
496 else
497 call lookup_var_or_dim( hst, varname, var, err_not_found )
498 if ( .not. err_not_found ) then
499 call put_attr(var, attrname, (/value/))
500 else
501 stat = nf90_enotvar
502 cause_c = 'varname="' // trim(varname) // '" is not found'
503 goto 999
504 endif
505 endif
506 end if
507999 continue
508 call storeerror(stat, subname, err, cause_c=cause_c)
509 call endsub(subname)
510 end subroutine historyaddattrreal1
512 & varname, attrname, value, history, err)
513 !
514 !
517 use gtdata_generic, only: put_attr
518 use gtdata_types, only: gt_variable
519 use dc_string, only: tochar
520 use dc_url, only: gt_plus
521 use dc_error, only: storeerror, dc_noerr, nf90_enotvar, hst_empinoaxisdata
522 use dc_message, only: messagenotify
523 use dc_trace, only: beginsub, endsub
524 use dc_types, only: string, dp
525 implicit none
526 character(*), intent(in):: varname
527 character(*), intent(in):: attrname
528 real(DP), intent(in):: value
529 type(gt_history), intent(inout), target, optional:: history
530 logical, intent(out), optional:: err
531 type(gt_history), pointer:: hst =>null()
532 type(gt_variable):: var
533 integer:: v_ord
534 logical:: err_not_found
535 integer:: stat
536 character(STRING):: cause_c
537 character(len = *), parameter:: subname = "HistoryAddAttrDouble0"
538 continue
539 call beginsub(subname, &
540 & 'varname=<%c> attrname=<%c>, value=<%c>', &
541 & c1=trim(varname), c2=trim(attrname), c3=trim(tochar(value)))
542 stat = dc_noerr
543 cause_c = ''
544 ! 操作対象決定
545 if (present(history)) then
546 hst => history
547 else
548 hst => default
549 endif
550 if ( hst % mpi_gather .and. &
551 & .not. hst % mpi_fileinfo % already_output ) then
552 call messagenotify('W', subname, &
553 & 'Specify data of axes in whole area by "HistoryPutAxisMPI" explicitly ' // &
554 & 'before "call HistoryAddAttr".' )
555 stat = hst_empinoaxisdata
556 cause_c = ''
557 goto 999
558 end if
559 if ( .not. hst % mpi_gather &
560 & .or. ( hst % mpi_gather .and. hst % mpi_myrank == 0 ) ) then
561 if (varname == "") then
562 ! とりあえず無駄だが大域属性を何度もつける
563 do, v_ord = 1, size(hst % vars)
564 call put_attr(hst % vars(v_ord), gt_plus // attrname, (/value/))
565 enddo
566 else
567 call lookup_var_or_dim( hst, varname, var, err_not_found )
568 if ( .not. err_not_found ) then
569 call put_attr(var, attrname, (/value/))
570 else
571 stat = nf90_enotvar
572 cause_c = 'varname="' // trim(varname) // '" is not found'
573 goto 999
574 endif
575 endif
576 end if
577999 continue
578 call storeerror(stat, subname, err, cause_c=cause_c)
579 call endsub(subname)
580 end subroutine historyaddattrdouble0
582 & varname, attrname, value, history, err)
583 !
584 !
587 use gtdata_generic, only: put_attr
588 use gtdata_types, only: gt_variable
589 use dc_string, only: tochar
590 use dc_url, only: gt_plus
591 use dc_error, only: storeerror, dc_noerr, nf90_enotvar, hst_empinoaxisdata
592 use dc_message, only: messagenotify
593 use dc_trace, only: beginsub, endsub
594 use dc_types, only: string, dp
595 implicit none
596 character(*), intent(in):: varname
597 character(*), intent(in):: attrname
598 real(DP), intent(in):: value(:)
599 type(gt_history), intent(inout), target, optional:: history
600 logical, intent(out), optional:: err
601 type(gt_history), pointer:: hst =>null()
602 type(gt_variable):: var
603 integer:: v_ord
604 logical:: err_not_found
605 integer:: stat
606 character(STRING):: cause_c
607 character(len = *), parameter:: subname = "HistoryAddAttrDouble1"
608 continue
609 call beginsub(subname, &
610 & 'varname=<%c> attrname=<%c>, value=<%c>', &
611 & c1=trim(varname), c2=trim(attrname), c3=trim(tochar(value)))
612 stat = dc_noerr
613 cause_c = ''
614 ! 操作対象決定
615 if (present(history)) then
616 hst => history
617 else
618 hst => default
619 endif
620 if ( hst % mpi_gather .and. &
621 & .not. hst % mpi_fileinfo % already_output ) then
622 call messagenotify('W', subname, &
623 & 'Specify data of axes in whole area by "HistoryPutAxisMPI" explicitly ' // &
624 & 'before "call HistoryAddAttr".' )
625 stat = hst_empinoaxisdata
626 cause_c = ''
627 goto 999
628 end if
629 if ( .not. hst % mpi_gather &
630 & .or. ( hst % mpi_gather .and. hst % mpi_myrank == 0 ) ) then
631 if (varname == "") then
632 ! とりあえず無駄だが大域属性を何度もつける
633 do, v_ord = 1, size(hst % vars)
634 call put_attr(hst % vars(v_ord), gt_plus // attrname, (/value/))
635 enddo
636 else
637 call lookup_var_or_dim( hst, varname, var, err_not_found )
638 if ( .not. err_not_found ) then
639 call put_attr(var, attrname, (/value/))
640 else
641 stat = nf90_enotvar
642 cause_c = 'varname="' // trim(varname) // '" is not found'
643 goto 999
644 endif
645 endif
646 end if
647999 continue
648 call storeerror(stat, subname, err, cause_c=cause_c)
649 call endsub(subname)
650 end subroutine historyaddattrdouble1
651!--
652! vi:set readonly sw=4 ts=8:
653!
654!Local Variables:
655!mode: f90
656!buffer-read-only: t
657!End:
658!
659!++
subroutine historyaddattrreal0(varname, attrname, value, history, err)
subroutine historyaddattrdouble1(varname, attrname, value, history, err)
subroutine historyaddattrlogical0(varname, attrname, value, history, err)
subroutine historyaddattrchar0(varname, attrname, value, history, err)
gtool4 データ内の変数への属性付加
subroutine historyaddattrint0(varname, attrname, value, history, err)
subroutine historyaddattrdouble0(varname, attrname, value, history, err)
subroutine historyaddattrreal1(varname, attrname, value, history, err)
subroutine historyaddattrint1(varname, attrname, value, history, err)
エラー処理用モジュール
Definition dc_error.f90:454
subroutine, public storeerror(number, where, err, cause_c, cause_i)
Definition dc_error.f90:891
integer, parameter, public dc_noerr
エラー等を保持
Definition dc_error.f90:468
integer, parameter, public hst_empinoaxisdata
Definition dc_error.f90:574
メッセージの出力
文字型変数の操作
Definition dc_string.f90:83
デバッグ時の追跡用モジュール
Definition dc_trace.f90:150
subroutine, public beginsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca, version)
Definition dc_trace.f90:476
subroutine, public endsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca)
Definition dc_trace.f90:599
種別型パラメタを提供します。
Definition dc_types.f90:55
integer, parameter, public dp
倍精度実数型変数
Definition dc_types.f90:92
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition dc_types.f90:137
変数 URL の文字列解析
Definition dc_url.f90:61
character, parameter, public gt_plus
Definition dc_url.f90:109
type(gt_history), target, save, public default