historyvarinfoaddattr.f90
Go to the documentation of this file.
1 !--
2 ! *** Caution!! ***
3 !
4 ! This file is generated from "historyvarinfoaddattr.rb2f90" by Ruby 2.3.3.
5 ! Please do not edit this file directly.
6 !
7 ! [JAPANESE]
8 !
9 ! ※※※ 注意!!! ※※※
10 !
11 ! このファイルは "historyvarinfoaddattr.rb2f90" から Ruby 2.3.3
12 ! によって自動生成されたファイルです.
13 ! このファイルを直接編集しませんようお願い致します.
14 !
15 !
16 !++
17 !
18 != GT_HISTORY_VARINFO への属性付加
19 != Add attributes to GT_HISTORY_VARINFO
20 !
21 ! Authors:: Yasuhiro MORIKAWA
22 ! Version:: $Id: historyvarinfoaddattr.rb2f90,v 1.2 2009-05-25 09:45:19 morikawa Exp $
23 ! Tag Name:: $Name: $
24 ! Copyright:: Copyright (C) GFD Dennou Club, 2000-2009. All rights reserved.
25 ! License:: See COPYRIGHT[link:../../../COPYRIGHT]
26 !
27 
28  subroutine historyvarinfoaddattrchar0( &
29  & varinfo, attrname, value, err )
30  !
31  !
32  !== GT_HISTORY_VARINFO 型変数への属性付加
33  !
34  ! GT_HISTORY_VARINFO 型の変数 *varinfo* へ属性を付加します。
35  !
36  ! *HistoryVarinfoAddAttr* は複数のサブルーチンの総称名です。
37  ! value には様々な型の引数を与えることが可能です。
38  ! 下記のサブルーチンを参照ください。
39  !
40 
41  !
45  use gtdata_generic, only: put_attr
46  use dc_string, only: tochar, joinchar
47  use dc_url, only: gt_plus
49  use dc_trace, only: beginsub, endsub, dbgmessage
50  use dc_types, only: string, token, dp
51  implicit none
52  type(gt_history_varinfo),intent(inout) :: varinfo
53  character(*), intent(in):: attrname ! 属性の名前
54  character(*), intent(in):: value
55  ! 属性に与えられる値
56  !
57  ! 配列の場合でも、数値型以外
58  ! では配列の 1 つ目の要素のみ
59  ! 値として付加されます。
60  !
61 
62  logical, intent(out), optional:: err
63  ! 例外処理用フラグ.
64  ! デフォルトでは, この手続き内でエラーが
65  ! 生じた場合, プログラムは強制終了します.
66  ! 引数 *err* が与えられる場合,
67  ! プログラムは強制終了せず, 代わりに
68  ! *err* に .true. が代入されます.
69  !
70  ! Exception handling flag.
71  ! By default, when error occur in
72  ! this procedure, the program aborts.
73  ! If this *err* argument is given,
74  ! .true. is substituted to *err* and
75  ! the program does not abort.
76 
77  type(gt_history_attr), pointer:: attrs_tmp(:)
78  integer:: attrs_num, stat
79  character(STRING) :: name, cause_c
80  character(*), parameter:: subname = "HistoryVarinfoAddAttrChar0"
81  continue
82  call beginsub(subname, &
83  & 'attrname=<%c>, value=<%c>', &
84  & c1=trim(attrname), c2=trim(value))
85  stat = dc_noerr
86  cause_c = ''
87 
88  if ( .not. varinfo % initialized ) then
89  stat = dc_enotinit
90  cause_c = 'GT_HISTORY_VARINFO'
91  goto 999
92  end if
93 
94  call historyvarinfoinquire( varinfo, name )
95  call dbgmessage('varinfo name=<%c>', c1=trim(name))
96 
97  ! これまでの属性を保持しつつ配列を1つ増やす
98  if ( .not. associated(varinfo % attrs) ) then
99  allocate( varinfo % attrs(1) )
100  attrs_num = 1
101  else
102  attrs_num = size( varinfo % attrs ) + 1
103  ! 配列データの領域確保
104  allocate( attrs_tmp(attrs_num - 1) )
105  call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), &
106  & to = attrs_tmp(1:attrs_num - 1))
107  deallocate( varinfo % attrs )
108  allocate( varinfo % attrs(attrs_num) )
109  call copy_attrs( from = attrs_tmp(1:attrs_num - 1), &
110  & to = varinfo % attrs(1:attrs_num - 1))
111  deallocate( attrs_tmp )
112  endif
113 
114  varinfo % attrs(attrs_num) % attrname = attrname
115  varinfo % attrs(attrs_num) % attrtype = 'Char'
116  varinfo % attrs(attrs_num) % array = .false.
117  varinfo % attrs(attrs_num) % Charvalue = value
118 
119 
120 999 continue
121  call storeerror( stat, subname, err, cause_c )
122  call endsub(subname)
123  end subroutine historyvarinfoaddattrchar0
124 
125  !-------------------------------------------------------------------
126 
127  subroutine historyvarinfoaddattr2char0( &
128  & varinfo, attrname, value, err )
129  !
130  !
131  ! 使用方法は HistoryVarinfoAddAttr と同様です.
132  !
133  ! Usage is same as "HistoryVarinfoAddAttr".
134  !
135  !--
136  ! 総称名 Put_Attr として提供するための関数です.
137  ! 機能は HistoryVarinfoAttr と同じです.
138  !++
139 
140  !
143  use gtdata_generic, only: put_attr
144  use dc_trace, only: beginsub, endsub, dbgmessage
145  use dc_types, only: dp
146  implicit none
147  type(gt_history_varinfo),intent(inout) :: varinfo
148  character(*), intent(in):: attrname ! 属性の名前
149  character(*), intent(in):: value
150  logical, intent(out), optional:: err
151  character(*), parameter:: subname = "HistoryVarinfoAddAttr2Char0"
152  continue
153  call beginsub(subname)
154  call historyvarinfoaddattr( &
155  & varinfo, attrname, value, err )
156  call endsub(subname)
157  end subroutine historyvarinfoaddattr2char0
158 
159 
160  subroutine historyvarinfoaddattrlogical0( &
161  & varinfo, attrname, value, err )
162  !
163 
164  !
168  use gtdata_generic, only: put_attr
169  use dc_string, only: tochar, joinchar
170  use dc_url, only: gt_plus
172  use dc_trace, only: beginsub, endsub, dbgmessage
173  use dc_types, only: string, token, dp
174  implicit none
175  type(gt_history_varinfo),intent(inout) :: varinfo
176  character(*), intent(in):: attrname ! 属性の名前
177  logical, intent(in):: value
178 
179  logical, intent(out), optional:: err
180  ! 例外処理用フラグ.
181  ! デフォルトでは, この手続き内でエラーが
182  ! 生じた場合, プログラムは強制終了します.
183  ! 引数 *err* が与えられる場合,
184  ! プログラムは強制終了せず, 代わりに
185  ! *err* に .true. が代入されます.
186  !
187  ! Exception handling flag.
188  ! By default, when error occur in
189  ! this procedure, the program aborts.
190  ! If this *err* argument is given,
191  ! .true. is substituted to *err* and
192  ! the program does not abort.
193 
194  type(gt_history_attr), pointer:: attrs_tmp(:)
195  integer:: attrs_num, stat
196  character(STRING) :: name, cause_c
197  character(*), parameter:: subname = "HistoryVarinfoAddAttrLogical0"
198  continue
199  call beginsub(subname, &
200  & 'attrname=<%c>, value=<%c>', &
201  & c1=trim(attrname), c2=trim(tochar(value)))
202  stat = dc_noerr
203  cause_c = ''
204 
205  if ( .not. varinfo % initialized ) then
206  stat = dc_enotinit
207  cause_c = 'GT_HISTORY_VARINFO'
208  goto 999
209  end if
210 
211  call historyvarinfoinquire( varinfo, name )
212  call dbgmessage('varinfo name=<%c>', c1=trim(name))
213 
214  ! これまでの属性を保持しつつ配列を1つ増やす
215  if ( .not. associated(varinfo % attrs) ) then
216  allocate( varinfo % attrs(1) )
217  attrs_num = 1
218  else
219  attrs_num = size( varinfo % attrs ) + 1
220  ! 配列データの領域確保
221  allocate( attrs_tmp(attrs_num - 1) )
222  call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), &
223  & to = attrs_tmp(1:attrs_num - 1))
224  deallocate( varinfo % attrs )
225  allocate( varinfo % attrs(attrs_num) )
226  call copy_attrs( from = attrs_tmp(1:attrs_num - 1), &
227  & to = varinfo % attrs(1:attrs_num - 1))
228  deallocate( attrs_tmp )
229  endif
230 
231  varinfo % attrs(attrs_num) % attrname = attrname
232  varinfo % attrs(attrs_num) % attrtype = 'Logical'
233  varinfo % attrs(attrs_num) % array = .false.
234  varinfo % attrs(attrs_num) % Logicalvalue = value
235 
236 
237 999 continue
238  call storeerror( stat, subname, err, cause_c )
239  call endsub(subname)
240  end subroutine historyvarinfoaddattrlogical0
241 
242  !-------------------------------------------------------------------
243 
244  subroutine historyvarinfoaddattr2logical0( &
245  & varinfo, attrname, value, err )
246  !
247 
248  !
251  use gtdata_generic, only: put_attr
252  use dc_trace, only: beginsub, endsub, dbgmessage
253  use dc_types, only: dp
254  implicit none
255  type(gt_history_varinfo),intent(inout) :: varinfo
256  character(*), intent(in):: attrname ! 属性の名前
257  logical, intent(in):: value
258  logical, intent(out), optional:: err
259  character(*), parameter:: subname = "HistoryVarinfoAddAttr2Logical0"
260  continue
261  call beginsub(subname)
262  call historyvarinfoaddattr( &
263  & varinfo, attrname, value, err )
264  call endsub(subname)
265  end subroutine historyvarinfoaddattr2logical0
266 
267 
268  subroutine historyvarinfoaddattrint0( &
269  & varinfo, attrname, value, err )
270  !
271 
272  !
276  use gtdata_generic, only: put_attr
277  use dc_string, only: tochar, joinchar
278  use dc_url, only: gt_plus
280  use dc_trace, only: beginsub, endsub, dbgmessage
281  use dc_types, only: string, token, dp
282  implicit none
283  type(gt_history_varinfo),intent(inout) :: varinfo
284  character(*), intent(in):: attrname ! 属性の名前
285  integer, intent(in):: value
286 
287  logical, intent(out), optional:: err
288  ! 例外処理用フラグ.
289  ! デフォルトでは, この手続き内でエラーが
290  ! 生じた場合, プログラムは強制終了します.
291  ! 引数 *err* が与えられる場合,
292  ! プログラムは強制終了せず, 代わりに
293  ! *err* に .true. が代入されます.
294  !
295  ! Exception handling flag.
296  ! By default, when error occur in
297  ! this procedure, the program aborts.
298  ! If this *err* argument is given,
299  ! .true. is substituted to *err* and
300  ! the program does not abort.
301 
302  type(gt_history_attr), pointer:: attrs_tmp(:)
303  integer:: attrs_num, stat
304  character(STRING) :: name, cause_c
305  character(*), parameter:: subname = "HistoryVarinfoAddAttrInt0"
306  continue
307  call beginsub(subname, &
308  & 'attrname=<%c>, value=<%c>', &
309  & c1=trim(attrname), c2=trim(tochar(value)))
310  stat = dc_noerr
311  cause_c = ''
312 
313  if ( .not. varinfo % initialized ) then
314  stat = dc_enotinit
315  cause_c = 'GT_HISTORY_VARINFO'
316  goto 999
317  end if
318 
319  call historyvarinfoinquire( varinfo, name )
320  call dbgmessage('varinfo name=<%c>', c1=trim(name))
321 
322  ! これまでの属性を保持しつつ配列を1つ増やす
323  if ( .not. associated(varinfo % attrs) ) then
324  allocate( varinfo % attrs(1) )
325  attrs_num = 1
326  else
327  attrs_num = size( varinfo % attrs ) + 1
328  ! 配列データの領域確保
329  allocate( attrs_tmp(attrs_num - 1) )
330  call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), &
331  & to = attrs_tmp(1:attrs_num - 1))
332  deallocate( varinfo % attrs )
333  allocate( varinfo % attrs(attrs_num) )
334  call copy_attrs( from = attrs_tmp(1:attrs_num - 1), &
335  & to = varinfo % attrs(1:attrs_num - 1))
336  deallocate( attrs_tmp )
337  endif
338 
339  varinfo % attrs(attrs_num) % attrname = attrname
340  varinfo % attrs(attrs_num) % attrtype = 'Int'
341  varinfo % attrs(attrs_num) % array = .false.
342  varinfo % attrs(attrs_num) % Intvalue = value
343 
344 
345 999 continue
346  call storeerror( stat, subname, err, cause_c )
347  call endsub(subname)
348  end subroutine historyvarinfoaddattrint0
349 
350  !-------------------------------------------------------------------
351 
352  subroutine historyvarinfoaddattr2int0( &
353  & varinfo, attrname, value, err )
354  !
355 
356  !
359  use gtdata_generic, only: put_attr
360  use dc_trace, only: beginsub, endsub, dbgmessage
361  use dc_types, only: dp
362  implicit none
363  type(gt_history_varinfo),intent(inout) :: varinfo
364  character(*), intent(in):: attrname ! 属性の名前
365  integer, intent(in):: value
366  logical, intent(out), optional:: err
367  character(*), parameter:: subname = "HistoryVarinfoAddAttr2Int0"
368  continue
369  call beginsub(subname)
370  call historyvarinfoaddattr( &
371  & varinfo, attrname, value, err )
372  call endsub(subname)
373  end subroutine historyvarinfoaddattr2int0
374 
375 
376  subroutine historyvarinfoaddattrint1( &
377  & varinfo, attrname, value, err )
378  !
379 
380  !
384  use gtdata_generic, only: put_attr
385  use dc_string, only: tochar, joinchar
386  use dc_url, only: gt_plus
388  use dc_trace, only: beginsub, endsub, dbgmessage
389  use dc_types, only: string, token, dp
390  implicit none
391  type(gt_history_varinfo),intent(inout) :: varinfo
392  character(*), intent(in):: attrname ! 属性の名前
393  integer, intent(in):: value(:)
394 
395  logical, intent(out), optional:: err
396  ! 例外処理用フラグ.
397  ! デフォルトでは, この手続き内でエラーが
398  ! 生じた場合, プログラムは強制終了します.
399  ! 引数 *err* が与えられる場合,
400  ! プログラムは強制終了せず, 代わりに
401  ! *err* に .true. が代入されます.
402  !
403  ! Exception handling flag.
404  ! By default, when error occur in
405  ! this procedure, the program aborts.
406  ! If this *err* argument is given,
407  ! .true. is substituted to *err* and
408  ! the program does not abort.
409 
410  type(gt_history_attr), pointer:: attrs_tmp(:)
411  integer:: attrs_num, stat
412  character(STRING) :: name, cause_c
413  character(*), parameter:: subname = "HistoryVarinfoAddAttrInt1"
414  continue
415  call beginsub(subname, &
416  & 'attrname=<%c>, value=<%c>', &
417  & c1=trim(attrname), c2=trim(tochar(value)))
418  stat = dc_noerr
419  cause_c = ''
420 
421  if ( .not. varinfo % initialized ) then
422  stat = dc_enotinit
423  cause_c = 'GT_HISTORY_VARINFO'
424  goto 999
425  end if
426 
427  call historyvarinfoinquire( varinfo, name )
428  call dbgmessage('varinfo name=<%c>', c1=trim(name))
429 
430  ! これまでの属性を保持しつつ配列を1つ増やす
431  if ( .not. associated(varinfo % attrs) ) then
432  allocate( varinfo % attrs(1) )
433  attrs_num = 1
434  else
435  attrs_num = size( varinfo % attrs ) + 1
436  ! 配列データの領域確保
437  allocate( attrs_tmp(attrs_num - 1) )
438  call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), &
439  & to = attrs_tmp(1:attrs_num - 1))
440  deallocate( varinfo % attrs )
441  allocate( varinfo % attrs(attrs_num) )
442  call copy_attrs( from = attrs_tmp(1:attrs_num - 1), &
443  & to = varinfo % attrs(1:attrs_num - 1))
444  deallocate( attrs_tmp )
445  endif
446 
447  varinfo % attrs(attrs_num) % attrname = attrname
448  varinfo % attrs(attrs_num) % attrtype = 'Int'
449  varinfo % attrs(attrs_num) % array = .true.
450  allocate( varinfo % attrs(attrs_num) % Intarray( size(value) ) )
451  varinfo % attrs(attrs_num) % Intarray = value
452 
453 
454 999 continue
455  call storeerror( stat, subname, err, cause_c )
456  call endsub(subname)
457  end subroutine historyvarinfoaddattrint1
458 
459  !-------------------------------------------------------------------
460 
461  subroutine historyvarinfoaddattr2int1( &
462  & varinfo, attrname, value, err )
463  !
464 
465  !
468  use gtdata_generic, only: put_attr
469  use dc_trace, only: beginsub, endsub, dbgmessage
470  use dc_types, only: dp
471  implicit none
472  type(gt_history_varinfo),intent(inout) :: varinfo
473  character(*), intent(in):: attrname ! 属性の名前
474  integer, intent(in):: value(:)
475  logical, intent(out), optional:: err
476  character(*), parameter:: subname = "HistoryVarinfoAddAttr2Int1"
477  continue
478  call beginsub(subname)
479  call historyvarinfoaddattr( &
480  & varinfo, attrname, value, err )
481  call endsub(subname)
482  end subroutine historyvarinfoaddattr2int1
483 
484 
485  subroutine historyvarinfoaddattrreal0( &
486  & varinfo, attrname, value, err )
487  !
488 
489  !
493  use gtdata_generic, only: put_attr
494  use dc_string, only: tochar, joinchar
495  use dc_url, only: gt_plus
497  use dc_trace, only: beginsub, endsub, dbgmessage
498  use dc_types, only: string, token, dp
499  implicit none
500  type(gt_history_varinfo),intent(inout) :: varinfo
501  character(*), intent(in):: attrname ! 属性の名前
502  real, intent(in):: value
503 
504  logical, intent(out), optional:: err
505  ! 例外処理用フラグ.
506  ! デフォルトでは, この手続き内でエラーが
507  ! 生じた場合, プログラムは強制終了します.
508  ! 引数 *err* が与えられる場合,
509  ! プログラムは強制終了せず, 代わりに
510  ! *err* に .true. が代入されます.
511  !
512  ! Exception handling flag.
513  ! By default, when error occur in
514  ! this procedure, the program aborts.
515  ! If this *err* argument is given,
516  ! .true. is substituted to *err* and
517  ! the program does not abort.
518 
519  type(gt_history_attr), pointer:: attrs_tmp(:)
520  integer:: attrs_num, stat
521  character(STRING) :: name, cause_c
522  character(*), parameter:: subname = "HistoryVarinfoAddAttrReal0"
523  continue
524  call beginsub(subname, &
525  & 'attrname=<%c>, value=<%c>', &
526  & c1=trim(attrname), c2=trim(tochar(value)))
527  stat = dc_noerr
528  cause_c = ''
529 
530  if ( .not. varinfo % initialized ) then
531  stat = dc_enotinit
532  cause_c = 'GT_HISTORY_VARINFO'
533  goto 999
534  end if
535 
536  call historyvarinfoinquire( varinfo, name )
537  call dbgmessage('varinfo name=<%c>', c1=trim(name))
538 
539  ! これまでの属性を保持しつつ配列を1つ増やす
540  if ( .not. associated(varinfo % attrs) ) then
541  allocate( varinfo % attrs(1) )
542  attrs_num = 1
543  else
544  attrs_num = size( varinfo % attrs ) + 1
545  ! 配列データの領域確保
546  allocate( attrs_tmp(attrs_num - 1) )
547  call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), &
548  & to = attrs_tmp(1:attrs_num - 1))
549  deallocate( varinfo % attrs )
550  allocate( varinfo % attrs(attrs_num) )
551  call copy_attrs( from = attrs_tmp(1:attrs_num - 1), &
552  & to = varinfo % attrs(1:attrs_num - 1))
553  deallocate( attrs_tmp )
554  endif
555 
556  varinfo % attrs(attrs_num) % attrname = attrname
557  varinfo % attrs(attrs_num) % attrtype = 'Real'
558  varinfo % attrs(attrs_num) % array = .false.
559  varinfo % attrs(attrs_num) % Realvalue = value
560 
561 
562 999 continue
563  call storeerror( stat, subname, err, cause_c )
564  call endsub(subname)
565  end subroutine historyvarinfoaddattrreal0
566 
567  !-------------------------------------------------------------------
568 
569  subroutine historyvarinfoaddattr2real0( &
570  & varinfo, attrname, value, err )
571  !
572 
573  !
576  use gtdata_generic, only: put_attr
577  use dc_trace, only: beginsub, endsub, dbgmessage
578  use dc_types, only: dp
579  implicit none
580  type(gt_history_varinfo),intent(inout) :: varinfo
581  character(*), intent(in):: attrname ! 属性の名前
582  real, intent(in):: value
583  logical, intent(out), optional:: err
584  character(*), parameter:: subname = "HistoryVarinfoAddAttr2Real0"
585  continue
586  call beginsub(subname)
587  call historyvarinfoaddattr( &
588  & varinfo, attrname, value, err )
589  call endsub(subname)
590  end subroutine historyvarinfoaddattr2real0
591 
592 
593  subroutine historyvarinfoaddattrreal1( &
594  & varinfo, attrname, value, err )
595  !
596 
597  !
601  use gtdata_generic, only: put_attr
602  use dc_string, only: tochar, joinchar
603  use dc_url, only: gt_plus
605  use dc_trace, only: beginsub, endsub, dbgmessage
606  use dc_types, only: string, token, dp
607  implicit none
608  type(gt_history_varinfo),intent(inout) :: varinfo
609  character(*), intent(in):: attrname ! 属性の名前
610  real, intent(in):: value(:)
611 
612  logical, intent(out), optional:: err
613  ! 例外処理用フラグ.
614  ! デフォルトでは, この手続き内でエラーが
615  ! 生じた場合, プログラムは強制終了します.
616  ! 引数 *err* が与えられる場合,
617  ! プログラムは強制終了せず, 代わりに
618  ! *err* に .true. が代入されます.
619  !
620  ! Exception handling flag.
621  ! By default, when error occur in
622  ! this procedure, the program aborts.
623  ! If this *err* argument is given,
624  ! .true. is substituted to *err* and
625  ! the program does not abort.
626 
627  type(gt_history_attr), pointer:: attrs_tmp(:)
628  integer:: attrs_num, stat
629  character(STRING) :: name, cause_c
630  character(*), parameter:: subname = "HistoryVarinfoAddAttrReal1"
631  continue
632  call beginsub(subname, &
633  & 'attrname=<%c>, value=<%c>', &
634  & c1=trim(attrname), c2=trim(tochar(value)))
635  stat = dc_noerr
636  cause_c = ''
637 
638  if ( .not. varinfo % initialized ) then
639  stat = dc_enotinit
640  cause_c = 'GT_HISTORY_VARINFO'
641  goto 999
642  end if
643 
644  call historyvarinfoinquire( varinfo, name )
645  call dbgmessage('varinfo name=<%c>', c1=trim(name))
646 
647  ! これまでの属性を保持しつつ配列を1つ増やす
648  if ( .not. associated(varinfo % attrs) ) then
649  allocate( varinfo % attrs(1) )
650  attrs_num = 1
651  else
652  attrs_num = size( varinfo % attrs ) + 1
653  ! 配列データの領域確保
654  allocate( attrs_tmp(attrs_num - 1) )
655  call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), &
656  & to = attrs_tmp(1:attrs_num - 1))
657  deallocate( varinfo % attrs )
658  allocate( varinfo % attrs(attrs_num) )
659  call copy_attrs( from = attrs_tmp(1:attrs_num - 1), &
660  & to = varinfo % attrs(1:attrs_num - 1))
661  deallocate( attrs_tmp )
662  endif
663 
664  varinfo % attrs(attrs_num) % attrname = attrname
665  varinfo % attrs(attrs_num) % attrtype = 'Real'
666  varinfo % attrs(attrs_num) % array = .true.
667  allocate( varinfo % attrs(attrs_num) % Realarray( size(value) ) )
668  varinfo % attrs(attrs_num) % Realarray = value
669 
670 
671 999 continue
672  call storeerror( stat, subname, err, cause_c )
673  call endsub(subname)
674  end subroutine historyvarinfoaddattrreal1
675 
676  !-------------------------------------------------------------------
677 
678  subroutine historyvarinfoaddattr2real1( &
679  & varinfo, attrname, value, err )
680  !
681 
682  !
685  use gtdata_generic, only: put_attr
686  use dc_trace, only: beginsub, endsub, dbgmessage
687  use dc_types, only: dp
688  implicit none
689  type(gt_history_varinfo),intent(inout) :: varinfo
690  character(*), intent(in):: attrname ! 属性の名前
691  real, intent(in):: value(:)
692  logical, intent(out), optional:: err
693  character(*), parameter:: subname = "HistoryVarinfoAddAttr2Real1"
694  continue
695  call beginsub(subname)
696  call historyvarinfoaddattr( &
697  & varinfo, attrname, value, err )
698  call endsub(subname)
699  end subroutine historyvarinfoaddattr2real1
700 
701 
702  subroutine historyvarinfoaddattrdouble0( &
703  & varinfo, attrname, value, err )
704  !
705 
706  !
710  use gtdata_generic, only: put_attr
711  use dc_string, only: tochar, joinchar
712  use dc_url, only: gt_plus
714  use dc_trace, only: beginsub, endsub, dbgmessage
715  use dc_types, only: string, token, dp
716  implicit none
717  type(gt_history_varinfo),intent(inout) :: varinfo
718  character(*), intent(in):: attrname ! 属性の名前
719  real(DP), intent(in):: value
720 
721  logical, intent(out), optional:: err
722  ! 例外処理用フラグ.
723  ! デフォルトでは, この手続き内でエラーが
724  ! 生じた場合, プログラムは強制終了します.
725  ! 引数 *err* が与えられる場合,
726  ! プログラムは強制終了せず, 代わりに
727  ! *err* に .true. が代入されます.
728  !
729  ! Exception handling flag.
730  ! By default, when error occur in
731  ! this procedure, the program aborts.
732  ! If this *err* argument is given,
733  ! .true. is substituted to *err* and
734  ! the program does not abort.
735 
736  type(gt_history_attr), pointer:: attrs_tmp(:)
737  integer:: attrs_num, stat
738  character(STRING) :: name, cause_c
739  character(*), parameter:: subname = "HistoryVarinfoAddAttrDouble0"
740  continue
741  call beginsub(subname, &
742  & 'attrname=<%c>, value=<%c>', &
743  & c1=trim(attrname), c2=trim(tochar(value)))
744  stat = dc_noerr
745  cause_c = ''
746 
747  if ( .not. varinfo % initialized ) then
748  stat = dc_enotinit
749  cause_c = 'GT_HISTORY_VARINFO'
750  goto 999
751  end if
752 
753  call historyvarinfoinquire( varinfo, name )
754  call dbgmessage('varinfo name=<%c>', c1=trim(name))
755 
756  ! これまでの属性を保持しつつ配列を1つ増やす
757  if ( .not. associated(varinfo % attrs) ) then
758  allocate( varinfo % attrs(1) )
759  attrs_num = 1
760  else
761  attrs_num = size( varinfo % attrs ) + 1
762  ! 配列データの領域確保
763  allocate( attrs_tmp(attrs_num - 1) )
764  call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), &
765  & to = attrs_tmp(1:attrs_num - 1))
766  deallocate( varinfo % attrs )
767  allocate( varinfo % attrs(attrs_num) )
768  call copy_attrs( from = attrs_tmp(1:attrs_num - 1), &
769  & to = varinfo % attrs(1:attrs_num - 1))
770  deallocate( attrs_tmp )
771  endif
772 
773  varinfo % attrs(attrs_num) % attrname = attrname
774  varinfo % attrs(attrs_num) % attrtype = 'Double'
775  varinfo % attrs(attrs_num) % array = .false.
776  varinfo % attrs(attrs_num) % Doublevalue = value
777 
778 
779 999 continue
780  call storeerror( stat, subname, err, cause_c )
781  call endsub(subname)
782  end subroutine historyvarinfoaddattrdouble0
783 
784  !-------------------------------------------------------------------
785 
786  subroutine historyvarinfoaddattr2double0( &
787  & varinfo, attrname, value, err )
788  !
789 
790  !
793  use gtdata_generic, only: put_attr
794  use dc_trace, only: beginsub, endsub, dbgmessage
795  use dc_types, only: dp
796  implicit none
797  type(gt_history_varinfo),intent(inout) :: varinfo
798  character(*), intent(in):: attrname ! 属性の名前
799  real(DP), intent(in):: value
800  logical, intent(out), optional:: err
801  character(*), parameter:: subname = "HistoryVarinfoAddAttr2Double0"
802  continue
803  call beginsub(subname)
804  call historyvarinfoaddattr( &
805  & varinfo, attrname, value, err )
806  call endsub(subname)
807  end subroutine historyvarinfoaddattr2double0
808 
809 
810  subroutine historyvarinfoaddattrdouble1( &
811  & varinfo, attrname, value, err )
812  !
813 
814  !
818  use gtdata_generic, only: put_attr
819  use dc_string, only: tochar, joinchar
820  use dc_url, only: gt_plus
822  use dc_trace, only: beginsub, endsub, dbgmessage
823  use dc_types, only: string, token, dp
824  implicit none
825  type(gt_history_varinfo),intent(inout) :: varinfo
826  character(*), intent(in):: attrname ! 属性の名前
827  real(DP), intent(in):: value(:)
828 
829  logical, intent(out), optional:: err
830  ! 例外処理用フラグ.
831  ! デフォルトでは, この手続き内でエラーが
832  ! 生じた場合, プログラムは強制終了します.
833  ! 引数 *err* が与えられる場合,
834  ! プログラムは強制終了せず, 代わりに
835  ! *err* に .true. が代入されます.
836  !
837  ! Exception handling flag.
838  ! By default, when error occur in
839  ! this procedure, the program aborts.
840  ! If this *err* argument is given,
841  ! .true. is substituted to *err* and
842  ! the program does not abort.
843 
844  type(gt_history_attr), pointer:: attrs_tmp(:)
845  integer:: attrs_num, stat
846  character(STRING) :: name, cause_c
847  character(*), parameter:: subname = "HistoryVarinfoAddAttrDouble1"
848  continue
849  call beginsub(subname, &
850  & 'attrname=<%c>, value=<%c>', &
851  & c1=trim(attrname), c2=trim(tochar(value)))
852  stat = dc_noerr
853  cause_c = ''
854 
855  if ( .not. varinfo % initialized ) then
856  stat = dc_enotinit
857  cause_c = 'GT_HISTORY_VARINFO'
858  goto 999
859  end if
860 
861  call historyvarinfoinquire( varinfo, name )
862  call dbgmessage('varinfo name=<%c>', c1=trim(name))
863 
864  ! これまでの属性を保持しつつ配列を1つ増やす
865  if ( .not. associated(varinfo % attrs) ) then
866  allocate( varinfo % attrs(1) )
867  attrs_num = 1
868  else
869  attrs_num = size( varinfo % attrs ) + 1
870  ! 配列データの領域確保
871  allocate( attrs_tmp(attrs_num - 1) )
872  call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), &
873  & to = attrs_tmp(1:attrs_num - 1))
874  deallocate( varinfo % attrs )
875  allocate( varinfo % attrs(attrs_num) )
876  call copy_attrs( from = attrs_tmp(1:attrs_num - 1), &
877  & to = varinfo % attrs(1:attrs_num - 1))
878  deallocate( attrs_tmp )
879  endif
880 
881  varinfo % attrs(attrs_num) % attrname = attrname
882  varinfo % attrs(attrs_num) % attrtype = 'Double'
883  varinfo % attrs(attrs_num) % array = .true.
884  allocate( varinfo % attrs(attrs_num) % Doublearray( size(value) ) )
885  varinfo % attrs(attrs_num) % Doublearray = value
886 
887 
888 999 continue
889  call storeerror( stat, subname, err, cause_c )
890  call endsub(subname)
891  end subroutine historyvarinfoaddattrdouble1
892 
893  !-------------------------------------------------------------------
894 
895  subroutine historyvarinfoaddattr2double1( &
896  & varinfo, attrname, value, err )
897  !
898 
899  !
902  use gtdata_generic, only: put_attr
903  use dc_trace, only: beginsub, endsub, dbgmessage
904  use dc_types, only: dp
905  implicit none
906  type(gt_history_varinfo),intent(inout) :: varinfo
907  character(*), intent(in):: attrname ! 属性の名前
908  real(DP), intent(in):: value(:)
909  logical, intent(out), optional:: err
910  character(*), parameter:: subname = "HistoryVarinfoAddAttr2Double1"
911  continue
912  call beginsub(subname)
913  call historyvarinfoaddattr( &
914  & varinfo, attrname, value, err )
915  call endsub(subname)
916  end subroutine historyvarinfoaddattr2double1
917 
918 !--
919 ! vi:set readonly sw=4 ts=8:
920 !
921 !Local Variables:
922 !mode: f90
923 !buffer-read-only: t
924 !End:
925 !
926 !++
type(gt_history), target, save, public default
subroutine historyvarinfoaddattr2double1(varinfo, attrname, value, err)
integer, parameter, public dc_enotinit
Definition: dc_error.f90:557
subroutine historyvarinfoaddattr2real1(varinfo, attrname, value, err)
subroutine historyvarinfoaddattr2int0(varinfo, attrname, value, err)
subroutine historyvarinfoaddattr2logical0(varinfo, attrname, value, err)
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition: dc_types.f90:109
subroutine historyvarinfoaddattrreal1(varinfo, attrname, value, err)
character, parameter, public gt_plus
Definition: dc_url.f90:92
subroutine, public storeerror(number, where, err, cause_c, cause_i)
Definition: dc_error.f90:830
integer, parameter, public dc_noerr
Definition: dc_error.f90:509
subroutine historyvarinfoaddattr2char0(varinfo, attrname, value, err)
character(string) function, public joinchar(carray, expr)
Definition: dc_string.f90:861
subroutine historyvarinfoaddattrlogical0(varinfo, attrname, value, err)
subroutine historyvarinfoaddattrdouble0(varinfo, attrname, value, err)
subroutine historyvarinfoaddattrint1(varinfo, attrname, value, err)
integer, parameter, public dp
倍精度実数型変数
Definition: dc_types.f90:83
subroutine historyvarinfoaddattr2real0(varinfo, attrname, value, err)
subroutine, public dbgmessage(fmt, i, r, d, L, n, c1, c2, c3, ca)
Definition: dc_trace.f90:509
subroutine, public beginsub(name, fmt, i, r, d, L, n, c1, c2, c3, ca, version)
Definition: dc_trace.f90:351
subroutine historyvarinfoaddattrdouble1(varinfo, attrname, value, err)
subroutine historyvarinfoaddattr2int1(varinfo, attrname, value, err)
subroutine historyvarinfoaddattrint0(varinfo, attrname, value, err)
subroutine historyvarinfoaddattrchar0(varinfo, attrname, value, err)
文字型変数の操作.
Definition: dc_string.f90:24
種別型パラメタを提供します。
Definition: dc_types.f90:49
subroutine historyvarinfoaddattr2double0(varinfo, attrname, value, err)
subroutine, public endsub(name, fmt, i, r, d, L, n, c1, c2, c3, ca)
Definition: dc_trace.f90:446
subroutine historyvarinfoaddattrreal0(varinfo, attrname, value, err)
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118