dcstringputline.f90
Go to the documentation of this file.
1 !--
2 ! *** Caution!! ***
3 !
4 ! This file is generated from "dcstringputline.rb2f90" by Ruby 2.3.3.
5 ! Please do not edit this file directly.
6 !
7 ! [JAPANESE]
8 !
9 ! ※※※ 注意!!! ※※※
10 !
11 ! このファイルは "dcstringputline.rb2f90" から Ruby 2.3.3
12 ! によって自動生成されたファイルです.
13 ! このファイルを直接編集しませんようお願い致します.
14 !
15 !
16 !++
17 
18 subroutine putlineint1( array, lbounds, ubounds, unit, indent, sd )
19  !
20  ! 数値型配列の要約を以下のように印字します.
21  ! avg は平均値, sd は標準偏差です.
22  ! 標準偏差は, 論理型オプショナル引数 sd に真を与えたときのみ
23  ! 表示します.
24  !
25  ! Summary of numerical array is printed as follows.
26  ! "avg" is average value, "sd" is standard deviation.
27  ! Standard deviation is displayed only when .true. is set to
28  ! logical optional argument "sd".
29  !
30  ! #<INT-ARRAY:: @size=(1:3), @max=3, @min=1, @avg=2. @sd=0.816496611>
31  ! #<SP-ARRAY:: @size=(1:1), @max=0., @min=0., @avg=0. @sd=0.>
32  ! #<DP-ARRAY:: @size=(1:3,1:3,1:3), @max=20., @min=7., @avg=13.5 @sd=3.29140282>
33  !
34  ! *array* には整数, 単精度実数, 倍精度実数の配列 (1 〜 7) を
35  ! 与えます. 配列添字の下限と上限を表示したい場合には,
36  ! 以下のように *lbounds* と *ubounds* を指定します.
37  ! これらを指定しない場合には,
38  ! 表示される配列添字は 1:<配列サイズ> となります.
39  !
40  ! Integer, single precision, and double precision array
41  ! (1 -- 7) is given to *array*.
42  ! In order to print the upper bound and the lower bound
43  ! for subscript of array,
44  ! specify *lbounds* and *ubounds* as follows.
45  ! Otherwise, 1:<size of array> is printed as subscript of array.
46  !
47  ! program putline_test
48  ! use dc_string, only: PutLine
49  ! real:: rarray(-2:2, -3:3)
50  !
51  ! rarray(-2:0, -3:0) = -1.0
52  ! rarray(-2:0, 1:3) = -2.0
53  ! rarray(1:2, -3:0) = 1.0
54  ! rarray(1:2, 1:3) = 2.0
55  ! call PutLine ( rarray, &
56  ! & lbounds = lbound(rarray), ubounds = ubound(rarray) )
57  ! end program putline_test
58  !
59  ! *unit* には印字する装置番号を指定します. デフォルトは標準出力です.
60  ! *indent* には字下げのための空白を与えます.
61  !
62  ! Unit number for print is specified to *unit*. Default is standard output.
63  ! Blank for indent is specified to *indent*.
64  !
65 
66 
67 
68  use dc_types, only: dp, string, stdout
69  use dc_string, only: tochar
70  use dc_string, only: printf, cprintf
71  use dc_present, only: present_and_true
72  implicit none
73  integer, intent(in):: array(:)
74  integer, intent(in), optional:: lbounds(1)
75  integer, intent(in), optional:: ubounds(1)
76  integer, intent(in), optional:: unit
77  character(*), intent(in), optional:: indent
78  logical, intent(in), optional:: sd
79  integer:: out_unit
80  integer:: indent_len
81  character(STRING):: indent_str
82  integer:: i
83  integer:: alldim_size, lbound_nums(1), ubound_nums(1)
84  character(STRING):: size_str, sd_str
85  integer:: max_value, min_value
86  integer, allocatable:: array_packed(:)
87  real:: avg_value, variance_value, sd_value
88 continue
89 
90  !-----------------------------------------------------------------
91  ! オプショナル引数のチェック
92  ! Check optional arguments
93  !-----------------------------------------------------------------
94  if ( present(unit) ) then
95  out_unit = unit
96  else
97  out_unit = stdout
98  end if
99 
100  indent_len = 0
101  indent_str = ''
102  if ( present(indent) ) then
103  if (len(indent) /= 0) then
104  indent_len = len(indent)
105  indent_str(1:indent_len) = indent
106  end if
107  end if
108 
109  !-------------------------------------------------------------------
110  ! 配列サイズ
111  ! Array size
112  !-------------------------------------------------------------------
113 
114  if ( present(lbounds) .and. present(ubounds) ) then
115  lbound_nums = lbounds
116  ubound_nums = ubounds
117  else
118  lbound_nums(1) = lbound( array, 1 )
119  ubound_nums(1) = ubound( array, 1 )
120 
121  end if
122 
123  size_str = '('
124  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
125  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
126 
127  size_str = trim(size_str) // ')'
128 
129  !-------------------------------------------------------------------
130  ! 最大値
131  ! Maximum value
132  !-------------------------------------------------------------------
133  max_value = maxval(array)
134 
135  !-------------------------------------------------------------------
136  ! 最小値
137  ! Minimum value
138  !-------------------------------------------------------------------
139  min_value = minval(array)
140 
141  !-------------------------------------------------------------------
142  ! 平均値
143  ! Average value
144  !-------------------------------------------------------------------
145  alldim_size = size(array)
146  avg_value = sum(array) / real(alldim_size)
147 
148  !-------------------------------------------------------------------
149  ! 標準偏差
150  ! Standard deviation
151  !-------------------------------------------------------------------
152  sd_value = 0.0
153  variance_value = 0.0
154  sd_str = ''
155  if ( present_and_true( sd ) ) then
156  if ( alldim_size > 1 ) then
157  if (allocated(array_packed)) then
158  deallocate(array_packed)
159  end if
160  allocate( array_packed(alldim_size) )
161 
162  array_packed = array
163 
164 
165  do i = 1, alldim_size
166  variance_value = variance_value + &
167  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
168  end do
169  variance_value = variance_value / real(alldim_size)
170  sd_value = sqrt( variance_value )
171  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
172  end if
173  end if
174 
175  !-------------------------------------------------------------------
176  ! 印字
177  ! Print
178  !-------------------------------------------------------------------
179  call printf(out_unit, &
180  & indent_str(1:indent_len) // &
181  & '#<INT-ARRAY:: @size=%c, @max=%d, @min=%d, @avg=%r%c>', &
182  & i = (/max_value, min_value/), r = (/avg_value/), &
183 
184 
185  & c1 = trim(size_str), c2 = trim(sd_str) )
186 
187 end subroutine putlineint1
188 
189 
190 subroutine putlineint2( array, lbounds, ubounds, unit, indent, sd )
191 
192 
193  use dc_types, only: dp, string, stdout
194  use dc_string, only: tochar
195  use dc_string, only: printf, cprintf
196  use dc_present, only: present_and_true
197  implicit none
198  integer, intent(in):: array(:,:)
199  integer, intent(in), optional:: lbounds(2)
200  integer, intent(in), optional:: ubounds(2)
201  integer, intent(in), optional:: unit
202  character(*), intent(in), optional:: indent
203  logical, intent(in), optional:: sd
204  integer:: out_unit
205  integer:: indent_len
206  character(STRING):: indent_str
207  integer:: i
208  integer:: alldim_size, lbound_nums(2), ubound_nums(2)
209  character(STRING):: size_str, sd_str
210  integer:: max_value, min_value
211  integer, allocatable:: array_packed(:)
212  real:: avg_value, variance_value, sd_value
213 continue
214 
215  !-----------------------------------------------------------------
216  ! オプショナル引数のチェック
217  ! Check optional arguments
218  !-----------------------------------------------------------------
219  if ( present(unit) ) then
220  out_unit = unit
221  else
222  out_unit = stdout
223  end if
224 
225  indent_len = 0
226  indent_str = ''
227  if ( present(indent) ) then
228  if (len(indent) /= 0) then
229  indent_len = len(indent)
230  indent_str(1:indent_len) = indent
231  end if
232  end if
233 
234  !-------------------------------------------------------------------
235  ! 配列サイズ
236  ! Array size
237  !-------------------------------------------------------------------
238 
239  if ( present(lbounds) .and. present(ubounds) ) then
240  lbound_nums = lbounds
241  ubound_nums = ubounds
242  else
243  lbound_nums(1) = lbound( array, 1 )
244  ubound_nums(1) = ubound( array, 1 )
245 
246  lbound_nums(2) = lbound( array, 2 )
247  ubound_nums(2) = ubound( array, 2 )
248 
249  end if
250 
251  size_str = '('
252  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
253  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
254  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(2)))
255  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(2)))
256 
257  size_str = trim(size_str) // ')'
258 
259  !-------------------------------------------------------------------
260  ! 最大値
261  ! Maximum value
262  !-------------------------------------------------------------------
263  max_value = maxval(array)
264 
265  !-------------------------------------------------------------------
266  ! 最小値
267  ! Minimum value
268  !-------------------------------------------------------------------
269  min_value = minval(array)
270 
271  !-------------------------------------------------------------------
272  ! 平均値
273  ! Average value
274  !-------------------------------------------------------------------
275  alldim_size = size(array)
276  avg_value = sum(array) / real(alldim_size)
277 
278  !-------------------------------------------------------------------
279  ! 標準偏差
280  ! Standard deviation
281  !-------------------------------------------------------------------
282  sd_value = 0.0
283  variance_value = 0.0
284  sd_str = ''
285  if ( present_and_true( sd ) ) then
286  if ( alldim_size > 1 ) then
287  if (allocated(array_packed)) then
288  deallocate(array_packed)
289  end if
290  allocate( array_packed(alldim_size) )
291 
292  array_packed = pack(array, .true.)
293 
294 
295  do i = 1, alldim_size
296  variance_value = variance_value + &
297  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
298  end do
299  variance_value = variance_value / real(alldim_size)
300  sd_value = sqrt( variance_value )
301  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
302  end if
303  end if
304 
305  !-------------------------------------------------------------------
306  ! 印字
307  ! Print
308  !-------------------------------------------------------------------
309  call printf(out_unit, &
310  & indent_str(1:indent_len) // &
311  & '#<INT-ARRAY:: @size=%c, @max=%d, @min=%d, @avg=%r%c>', &
312  & i = (/max_value, min_value/), r = (/avg_value/), &
313 
314 
315  & c1 = trim(size_str), c2 = trim(sd_str) )
316 
317 end subroutine putlineint2
318 
319 
320 subroutine putlineint3( array, lbounds, ubounds, unit, indent, sd )
321 
322 
323  use dc_types, only: dp, string, stdout
324  use dc_string, only: tochar
325  use dc_string, only: printf, cprintf
326  use dc_present, only: present_and_true
327  implicit none
328  integer, intent(in):: array(:,:,:)
329  integer, intent(in), optional:: lbounds(3)
330  integer, intent(in), optional:: ubounds(3)
331  integer, intent(in), optional:: unit
332  character(*), intent(in), optional:: indent
333  logical, intent(in), optional:: sd
334  integer:: out_unit
335  integer:: indent_len
336  character(STRING):: indent_str
337  integer:: i
338  integer:: alldim_size, lbound_nums(3), ubound_nums(3)
339  character(STRING):: size_str, sd_str
340  integer:: max_value, min_value
341  integer, allocatable:: array_packed(:)
342  real:: avg_value, variance_value, sd_value
343 continue
344 
345  !-----------------------------------------------------------------
346  ! オプショナル引数のチェック
347  ! Check optional arguments
348  !-----------------------------------------------------------------
349  if ( present(unit) ) then
350  out_unit = unit
351  else
352  out_unit = stdout
353  end if
354 
355  indent_len = 0
356  indent_str = ''
357  if ( present(indent) ) then
358  if (len(indent) /= 0) then
359  indent_len = len(indent)
360  indent_str(1:indent_len) = indent
361  end if
362  end if
363 
364  !-------------------------------------------------------------------
365  ! 配列サイズ
366  ! Array size
367  !-------------------------------------------------------------------
368 
369  if ( present(lbounds) .and. present(ubounds) ) then
370  lbound_nums = lbounds
371  ubound_nums = ubounds
372  else
373  lbound_nums(1) = lbound( array, 1 )
374  ubound_nums(1) = ubound( array, 1 )
375 
376  lbound_nums(2) = lbound( array, 2 )
377  ubound_nums(2) = ubound( array, 2 )
378 
379  lbound_nums(3) = lbound( array, 3 )
380  ubound_nums(3) = ubound( array, 3 )
381 
382  end if
383 
384  size_str = '('
385  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
386  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
387  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(2)))
388  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(2)))
389 
390  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(3)))
391  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(3)))
392 
393  size_str = trim(size_str) // ')'
394 
395  !-------------------------------------------------------------------
396  ! 最大値
397  ! Maximum value
398  !-------------------------------------------------------------------
399  max_value = maxval(array)
400 
401  !-------------------------------------------------------------------
402  ! 最小値
403  ! Minimum value
404  !-------------------------------------------------------------------
405  min_value = minval(array)
406 
407  !-------------------------------------------------------------------
408  ! 平均値
409  ! Average value
410  !-------------------------------------------------------------------
411  alldim_size = size(array)
412  avg_value = sum(array) / real(alldim_size)
413 
414  !-------------------------------------------------------------------
415  ! 標準偏差
416  ! Standard deviation
417  !-------------------------------------------------------------------
418  sd_value = 0.0
419  variance_value = 0.0
420  sd_str = ''
421  if ( present_and_true( sd ) ) then
422  if ( alldim_size > 1 ) then
423  if (allocated(array_packed)) then
424  deallocate(array_packed)
425  end if
426  allocate( array_packed(alldim_size) )
427 
428  array_packed = pack(array, .true.)
429 
430 
431  do i = 1, alldim_size
432  variance_value = variance_value + &
433  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
434  end do
435  variance_value = variance_value / real(alldim_size)
436  sd_value = sqrt( variance_value )
437  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
438  end if
439  end if
440 
441  !-------------------------------------------------------------------
442  ! 印字
443  ! Print
444  !-------------------------------------------------------------------
445  call printf(out_unit, &
446  & indent_str(1:indent_len) // &
447  & '#<INT-ARRAY:: @size=%c, @max=%d, @min=%d, @avg=%r%c>', &
448  & i = (/max_value, min_value/), r = (/avg_value/), &
449 
450 
451  & c1 = trim(size_str), c2 = trim(sd_str) )
452 
453 end subroutine putlineint3
454 
455 
456 subroutine putlineint4( array, lbounds, ubounds, unit, indent, sd )
457 
458 
459  use dc_types, only: dp, string, stdout
460  use dc_string, only: tochar
461  use dc_string, only: printf, cprintf
462  use dc_present, only: present_and_true
463  implicit none
464  integer, intent(in):: array(:,:,:,:)
465  integer, intent(in), optional:: lbounds(4)
466  integer, intent(in), optional:: ubounds(4)
467  integer, intent(in), optional:: unit
468  character(*), intent(in), optional:: indent
469  logical, intent(in), optional:: sd
470  integer:: out_unit
471  integer:: indent_len
472  character(STRING):: indent_str
473  integer:: i
474  integer:: alldim_size, lbound_nums(4), ubound_nums(4)
475  character(STRING):: size_str, sd_str
476  integer:: max_value, min_value
477  integer, allocatable:: array_packed(:)
478  real:: avg_value, variance_value, sd_value
479 continue
480 
481  !-----------------------------------------------------------------
482  ! オプショナル引数のチェック
483  ! Check optional arguments
484  !-----------------------------------------------------------------
485  if ( present(unit) ) then
486  out_unit = unit
487  else
488  out_unit = stdout
489  end if
490 
491  indent_len = 0
492  indent_str = ''
493  if ( present(indent) ) then
494  if (len(indent) /= 0) then
495  indent_len = len(indent)
496  indent_str(1:indent_len) = indent
497  end if
498  end if
499 
500  !-------------------------------------------------------------------
501  ! 配列サイズ
502  ! Array size
503  !-------------------------------------------------------------------
504 
505  if ( present(lbounds) .and. present(ubounds) ) then
506  lbound_nums = lbounds
507  ubound_nums = ubounds
508  else
509  lbound_nums(1) = lbound( array, 1 )
510  ubound_nums(1) = ubound( array, 1 )
511 
512  lbound_nums(2) = lbound( array, 2 )
513  ubound_nums(2) = ubound( array, 2 )
514 
515  lbound_nums(3) = lbound( array, 3 )
516  ubound_nums(3) = ubound( array, 3 )
517 
518  lbound_nums(4) = lbound( array, 4 )
519  ubound_nums(4) = ubound( array, 4 )
520 
521  end if
522 
523  size_str = '('
524  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
525  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
526  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(2)))
527  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(2)))
528 
529  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(3)))
530  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(3)))
531 
532  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(4)))
533  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(4)))
534 
535  size_str = trim(size_str) // ')'
536 
537  !-------------------------------------------------------------------
538  ! 最大値
539  ! Maximum value
540  !-------------------------------------------------------------------
541  max_value = maxval(array)
542 
543  !-------------------------------------------------------------------
544  ! 最小値
545  ! Minimum value
546  !-------------------------------------------------------------------
547  min_value = minval(array)
548 
549  !-------------------------------------------------------------------
550  ! 平均値
551  ! Average value
552  !-------------------------------------------------------------------
553  alldim_size = size(array)
554  avg_value = sum(array) / real(alldim_size)
555 
556  !-------------------------------------------------------------------
557  ! 標準偏差
558  ! Standard deviation
559  !-------------------------------------------------------------------
560  sd_value = 0.0
561  variance_value = 0.0
562  sd_str = ''
563  if ( present_and_true( sd ) ) then
564  if ( alldim_size > 1 ) then
565  if (allocated(array_packed)) then
566  deallocate(array_packed)
567  end if
568  allocate( array_packed(alldim_size) )
569 
570  array_packed = pack(array, .true.)
571 
572 
573  do i = 1, alldim_size
574  variance_value = variance_value + &
575  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
576  end do
577  variance_value = variance_value / real(alldim_size)
578  sd_value = sqrt( variance_value )
579  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
580  end if
581  end if
582 
583  !-------------------------------------------------------------------
584  ! 印字
585  ! Print
586  !-------------------------------------------------------------------
587  call printf(out_unit, &
588  & indent_str(1:indent_len) // &
589  & '#<INT-ARRAY:: @size=%c, @max=%d, @min=%d, @avg=%r%c>', &
590  & i = (/max_value, min_value/), r = (/avg_value/), &
591 
592 
593  & c1 = trim(size_str), c2 = trim(sd_str) )
594 
595 end subroutine putlineint4
596 
597 
598 subroutine putlineint5( array, lbounds, ubounds, unit, indent, sd )
599 
600 
601  use dc_types, only: dp, string, stdout
602  use dc_string, only: tochar
603  use dc_string, only: printf, cprintf
604  use dc_present, only: present_and_true
605  implicit none
606  integer, intent(in):: array(:,:,:,:,:)
607  integer, intent(in), optional:: lbounds(5)
608  integer, intent(in), optional:: ubounds(5)
609  integer, intent(in), optional:: unit
610  character(*), intent(in), optional:: indent
611  logical, intent(in), optional:: sd
612  integer:: out_unit
613  integer:: indent_len
614  character(STRING):: indent_str
615  integer:: i
616  integer:: alldim_size, lbound_nums(5), ubound_nums(5)
617  character(STRING):: size_str, sd_str
618  integer:: max_value, min_value
619  integer, allocatable:: array_packed(:)
620  real:: avg_value, variance_value, sd_value
621 continue
622 
623  !-----------------------------------------------------------------
624  ! オプショナル引数のチェック
625  ! Check optional arguments
626  !-----------------------------------------------------------------
627  if ( present(unit) ) then
628  out_unit = unit
629  else
630  out_unit = stdout
631  end if
632 
633  indent_len = 0
634  indent_str = ''
635  if ( present(indent) ) then
636  if (len(indent) /= 0) then
637  indent_len = len(indent)
638  indent_str(1:indent_len) = indent
639  end if
640  end if
641 
642  !-------------------------------------------------------------------
643  ! 配列サイズ
644  ! Array size
645  !-------------------------------------------------------------------
646 
647  if ( present(lbounds) .and. present(ubounds) ) then
648  lbound_nums = lbounds
649  ubound_nums = ubounds
650  else
651  lbound_nums(1) = lbound( array, 1 )
652  ubound_nums(1) = ubound( array, 1 )
653 
654  lbound_nums(2) = lbound( array, 2 )
655  ubound_nums(2) = ubound( array, 2 )
656 
657  lbound_nums(3) = lbound( array, 3 )
658  ubound_nums(3) = ubound( array, 3 )
659 
660  lbound_nums(4) = lbound( array, 4 )
661  ubound_nums(4) = ubound( array, 4 )
662 
663  lbound_nums(5) = lbound( array, 5 )
664  ubound_nums(5) = ubound( array, 5 )
665 
666  end if
667 
668  size_str = '('
669  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
670  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
671  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(2)))
672  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(2)))
673 
674  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(3)))
675  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(3)))
676 
677  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(4)))
678  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(4)))
679 
680  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(5)))
681  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(5)))
682 
683  size_str = trim(size_str) // ')'
684 
685  !-------------------------------------------------------------------
686  ! 最大値
687  ! Maximum value
688  !-------------------------------------------------------------------
689  max_value = maxval(array)
690 
691  !-------------------------------------------------------------------
692  ! 最小値
693  ! Minimum value
694  !-------------------------------------------------------------------
695  min_value = minval(array)
696 
697  !-------------------------------------------------------------------
698  ! 平均値
699  ! Average value
700  !-------------------------------------------------------------------
701  alldim_size = size(array)
702  avg_value = sum(array) / real(alldim_size)
703 
704  !-------------------------------------------------------------------
705  ! 標準偏差
706  ! Standard deviation
707  !-------------------------------------------------------------------
708  sd_value = 0.0
709  variance_value = 0.0
710  sd_str = ''
711  if ( present_and_true( sd ) ) then
712  if ( alldim_size > 1 ) then
713  if (allocated(array_packed)) then
714  deallocate(array_packed)
715  end if
716  allocate( array_packed(alldim_size) )
717 
718  array_packed = pack(array, .true.)
719 
720 
721  do i = 1, alldim_size
722  variance_value = variance_value + &
723  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
724  end do
725  variance_value = variance_value / real(alldim_size)
726  sd_value = sqrt( variance_value )
727  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
728  end if
729  end if
730 
731  !-------------------------------------------------------------------
732  ! 印字
733  ! Print
734  !-------------------------------------------------------------------
735  call printf(out_unit, &
736  & indent_str(1:indent_len) // &
737  & '#<INT-ARRAY:: @size=%c, @max=%d, @min=%d, @avg=%r%c>', &
738  & i = (/max_value, min_value/), r = (/avg_value/), &
739 
740 
741  & c1 = trim(size_str), c2 = trim(sd_str) )
742 
743 end subroutine putlineint5
744 
745 
746 subroutine putlineint6( array, lbounds, ubounds, unit, indent, sd )
747 
748 
749  use dc_types, only: dp, string, stdout
750  use dc_string, only: tochar
751  use dc_string, only: printf, cprintf
752  use dc_present, only: present_and_true
753  implicit none
754  integer, intent(in):: array(:,:,:,:,:,:)
755  integer, intent(in), optional:: lbounds(6)
756  integer, intent(in), optional:: ubounds(6)
757  integer, intent(in), optional:: unit
758  character(*), intent(in), optional:: indent
759  logical, intent(in), optional:: sd
760  integer:: out_unit
761  integer:: indent_len
762  character(STRING):: indent_str
763  integer:: i
764  integer:: alldim_size, lbound_nums(6), ubound_nums(6)
765  character(STRING):: size_str, sd_str
766  integer:: max_value, min_value
767  integer, allocatable:: array_packed(:)
768  real:: avg_value, variance_value, sd_value
769 continue
770 
771  !-----------------------------------------------------------------
772  ! オプショナル引数のチェック
773  ! Check optional arguments
774  !-----------------------------------------------------------------
775  if ( present(unit) ) then
776  out_unit = unit
777  else
778  out_unit = stdout
779  end if
780 
781  indent_len = 0
782  indent_str = ''
783  if ( present(indent) ) then
784  if (len(indent) /= 0) then
785  indent_len = len(indent)
786  indent_str(1:indent_len) = indent
787  end if
788  end if
789 
790  !-------------------------------------------------------------------
791  ! 配列サイズ
792  ! Array size
793  !-------------------------------------------------------------------
794 
795  if ( present(lbounds) .and. present(ubounds) ) then
796  lbound_nums = lbounds
797  ubound_nums = ubounds
798  else
799  lbound_nums(1) = lbound( array, 1 )
800  ubound_nums(1) = ubound( array, 1 )
801 
802  lbound_nums(2) = lbound( array, 2 )
803  ubound_nums(2) = ubound( array, 2 )
804 
805  lbound_nums(3) = lbound( array, 3 )
806  ubound_nums(3) = ubound( array, 3 )
807 
808  lbound_nums(4) = lbound( array, 4 )
809  ubound_nums(4) = ubound( array, 4 )
810 
811  lbound_nums(5) = lbound( array, 5 )
812  ubound_nums(5) = ubound( array, 5 )
813 
814  lbound_nums(6) = lbound( array, 6 )
815  ubound_nums(6) = ubound( array, 6 )
816 
817  end if
818 
819  size_str = '('
820  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
821  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
822  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(2)))
823  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(2)))
824 
825  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(3)))
826  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(3)))
827 
828  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(4)))
829  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(4)))
830 
831  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(5)))
832  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(5)))
833 
834  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(6)))
835  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(6)))
836 
837  size_str = trim(size_str) // ')'
838 
839  !-------------------------------------------------------------------
840  ! 最大値
841  ! Maximum value
842  !-------------------------------------------------------------------
843  max_value = maxval(array)
844 
845  !-------------------------------------------------------------------
846  ! 最小値
847  ! Minimum value
848  !-------------------------------------------------------------------
849  min_value = minval(array)
850 
851  !-------------------------------------------------------------------
852  ! 平均値
853  ! Average value
854  !-------------------------------------------------------------------
855  alldim_size = size(array)
856  avg_value = sum(array) / real(alldim_size)
857 
858  !-------------------------------------------------------------------
859  ! 標準偏差
860  ! Standard deviation
861  !-------------------------------------------------------------------
862  sd_value = 0.0
863  variance_value = 0.0
864  sd_str = ''
865  if ( present_and_true( sd ) ) then
866  if ( alldim_size > 1 ) then
867  if (allocated(array_packed)) then
868  deallocate(array_packed)
869  end if
870  allocate( array_packed(alldim_size) )
871 
872  array_packed = pack(array, .true.)
873 
874 
875  do i = 1, alldim_size
876  variance_value = variance_value + &
877  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
878  end do
879  variance_value = variance_value / real(alldim_size)
880  sd_value = sqrt( variance_value )
881  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
882  end if
883  end if
884 
885  !-------------------------------------------------------------------
886  ! 印字
887  ! Print
888  !-------------------------------------------------------------------
889  call printf(out_unit, &
890  & indent_str(1:indent_len) // &
891  & '#<INT-ARRAY:: @size=%c, @max=%d, @min=%d, @avg=%r%c>', &
892  & i = (/max_value, min_value/), r = (/avg_value/), &
893 
894 
895  & c1 = trim(size_str), c2 = trim(sd_str) )
896 
897 end subroutine putlineint6
898 
899 
900 subroutine putlineint7( array, lbounds, ubounds, unit, indent, sd )
901 
902 
903  use dc_types, only: dp, string, stdout
904  use dc_string, only: tochar
905  use dc_string, only: printf, cprintf
906  use dc_present, only: present_and_true
907  implicit none
908  integer, intent(in):: array(:,:,:,:,:,:,:)
909  integer, intent(in), optional:: lbounds(7)
910  integer, intent(in), optional:: ubounds(7)
911  integer, intent(in), optional:: unit
912  character(*), intent(in), optional:: indent
913  logical, intent(in), optional:: sd
914  integer:: out_unit
915  integer:: indent_len
916  character(STRING):: indent_str
917  integer:: i
918  integer:: alldim_size, lbound_nums(7), ubound_nums(7)
919  character(STRING):: size_str, sd_str
920  integer:: max_value, min_value
921  integer, allocatable:: array_packed(:)
922  real:: avg_value, variance_value, sd_value
923 continue
924 
925  !-----------------------------------------------------------------
926  ! オプショナル引数のチェック
927  ! Check optional arguments
928  !-----------------------------------------------------------------
929  if ( present(unit) ) then
930  out_unit = unit
931  else
932  out_unit = stdout
933  end if
934 
935  indent_len = 0
936  indent_str = ''
937  if ( present(indent) ) then
938  if (len(indent) /= 0) then
939  indent_len = len(indent)
940  indent_str(1:indent_len) = indent
941  end if
942  end if
943 
944  !-------------------------------------------------------------------
945  ! 配列サイズ
946  ! Array size
947  !-------------------------------------------------------------------
948 
949  if ( present(lbounds) .and. present(ubounds) ) then
950  lbound_nums = lbounds
951  ubound_nums = ubounds
952  else
953  lbound_nums(1) = lbound( array, 1 )
954  ubound_nums(1) = ubound( array, 1 )
955 
956  lbound_nums(2) = lbound( array, 2 )
957  ubound_nums(2) = ubound( array, 2 )
958 
959  lbound_nums(3) = lbound( array, 3 )
960  ubound_nums(3) = ubound( array, 3 )
961 
962  lbound_nums(4) = lbound( array, 4 )
963  ubound_nums(4) = ubound( array, 4 )
964 
965  lbound_nums(5) = lbound( array, 5 )
966  ubound_nums(5) = ubound( array, 5 )
967 
968  lbound_nums(6) = lbound( array, 6 )
969  ubound_nums(6) = ubound( array, 6 )
970 
971  lbound_nums(7) = lbound( array, 7 )
972  ubound_nums(7) = ubound( array, 7 )
973 
974  end if
975 
976  size_str = '('
977  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
978  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
979  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(2)))
980  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(2)))
981 
982  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(3)))
983  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(3)))
984 
985  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(4)))
986  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(4)))
987 
988  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(5)))
989  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(5)))
990 
991  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(6)))
992  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(6)))
993 
994  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(7)))
995  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(7)))
996 
997  size_str = trim(size_str) // ')'
998 
999  !-------------------------------------------------------------------
1000  ! 最大値
1001  ! Maximum value
1002  !-------------------------------------------------------------------
1003  max_value = maxval(array)
1004 
1005  !-------------------------------------------------------------------
1006  ! 最小値
1007  ! Minimum value
1008  !-------------------------------------------------------------------
1009  min_value = minval(array)
1010 
1011  !-------------------------------------------------------------------
1012  ! 平均値
1013  ! Average value
1014  !-------------------------------------------------------------------
1015  alldim_size = size(array)
1016  avg_value = sum(array) / real(alldim_size)
1017 
1018  !-------------------------------------------------------------------
1019  ! 標準偏差
1020  ! Standard deviation
1021  !-------------------------------------------------------------------
1022  sd_value = 0.0
1023  variance_value = 0.0
1024  sd_str = ''
1025  if ( present_and_true( sd ) ) then
1026  if ( alldim_size > 1 ) then
1027  if (allocated(array_packed)) then
1028  deallocate(array_packed)
1029  end if
1030  allocate( array_packed(alldim_size) )
1031 
1032  array_packed = pack(array, .true.)
1033 
1034 
1035  do i = 1, alldim_size
1036  variance_value = variance_value + &
1037  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
1038  end do
1039  variance_value = variance_value / real(alldim_size)
1040  sd_value = sqrt( variance_value )
1041  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
1042  end if
1043  end if
1044 
1045  !-------------------------------------------------------------------
1046  ! 印字
1047  ! Print
1048  !-------------------------------------------------------------------
1049  call printf(out_unit, &
1050  & indent_str(1:indent_len) // &
1051  & '#<INT-ARRAY:: @size=%c, @max=%d, @min=%d, @avg=%r%c>', &
1052  & i = (/max_value, min_value/), r = (/avg_value/), &
1053 
1054 
1055  & c1 = trim(size_str), c2 = trim(sd_str) )
1056 
1057 end subroutine putlineint7
1058 
1059 
1060 subroutine putlinereal1( array, lbounds, ubounds, unit, indent, sd )
1061 
1062 
1063 
1064  use dc_types, only: dp, string, stdout
1065  use dc_string, only: tochar
1066  use dc_string, only: printf, cprintf
1067  use dc_present, only: present_and_true
1068  implicit none
1069  real, intent(in):: array(:)
1070  integer, intent(in), optional:: lbounds(1)
1071  integer, intent(in), optional:: ubounds(1)
1072  integer, intent(in), optional:: unit
1073  character(*), intent(in), optional:: indent
1074  logical, intent(in), optional:: sd
1075  integer:: out_unit
1076  integer:: indent_len
1077  character(STRING):: indent_str
1078  integer:: i
1079  integer:: alldim_size, lbound_nums(1), ubound_nums(1)
1080  character(STRING):: size_str, sd_str
1081  real:: max_value, min_value
1082  real, allocatable:: array_packed(:)
1083  real:: avg_value, variance_value, sd_value
1084 continue
1085 
1086  !-----------------------------------------------------------------
1087  ! オプショナル引数のチェック
1088  ! Check optional arguments
1089  !-----------------------------------------------------------------
1090  if ( present(unit) ) then
1091  out_unit = unit
1092  else
1093  out_unit = stdout
1094  end if
1095 
1096  indent_len = 0
1097  indent_str = ''
1098  if ( present(indent) ) then
1099  if (len(indent) /= 0) then
1100  indent_len = len(indent)
1101  indent_str(1:indent_len) = indent
1102  end if
1103  end if
1104 
1105  !-------------------------------------------------------------------
1106  ! 配列サイズ
1107  ! Array size
1108  !-------------------------------------------------------------------
1109 
1110  if ( present(lbounds) .and. present(ubounds) ) then
1111  lbound_nums = lbounds
1112  ubound_nums = ubounds
1113  else
1114  lbound_nums(1) = lbound( array, 1 )
1115  ubound_nums(1) = ubound( array, 1 )
1116 
1117  end if
1118 
1119  size_str = '('
1120  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
1121  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
1122 
1123  size_str = trim(size_str) // ')'
1124 
1125  !-------------------------------------------------------------------
1126  ! 最大値
1127  ! Maximum value
1128  !-------------------------------------------------------------------
1129  max_value = maxval(array)
1130 
1131  !-------------------------------------------------------------------
1132  ! 最小値
1133  ! Minimum value
1134  !-------------------------------------------------------------------
1135  min_value = minval(array)
1136 
1137  !-------------------------------------------------------------------
1138  ! 平均値
1139  ! Average value
1140  !-------------------------------------------------------------------
1141  alldim_size = size(array)
1142  avg_value = sum(array) / real(alldim_size)
1143 
1144  !-------------------------------------------------------------------
1145  ! 標準偏差
1146  ! Standard deviation
1147  !-------------------------------------------------------------------
1148  sd_value = 0.0
1149  variance_value = 0.0
1150  sd_str = ''
1151  if ( present_and_true( sd ) ) then
1152  if ( alldim_size > 1 ) then
1153  if (allocated(array_packed)) then
1154  deallocate(array_packed)
1155  end if
1156  allocate( array_packed(alldim_size) )
1157 
1158  array_packed = array
1159 
1160 
1161  do i = 1, alldim_size
1162  variance_value = variance_value + &
1163  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
1164  end do
1165  variance_value = variance_value / real(alldim_size)
1166  sd_value = sqrt( variance_value )
1167  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
1168  end if
1169  end if
1170 
1171  !-------------------------------------------------------------------
1172  ! 印字
1173  ! Print
1174  !-------------------------------------------------------------------
1175  call printf(out_unit, &
1176  & indent_str(1:indent_len) // &
1177  & '#<SP-ARRAY:: @size=%c, @max=%r, @min=%r, @avg=%r%c>', &
1178  & r = (/max_value, min_value, avg_value/), &
1179 
1180 
1181  & c1 = trim(size_str), c2 = trim(sd_str) )
1182 
1183 end subroutine putlinereal1
1184 
1185 
1186 subroutine putlinereal2( array, lbounds, ubounds, unit, indent, sd )
1187 
1188 
1189  use dc_types, only: dp, string, stdout
1190  use dc_string, only: tochar
1191  use dc_string, only: printf, cprintf
1192  use dc_present, only: present_and_true
1193  implicit none
1194  real, intent(in):: array(:,:)
1195  integer, intent(in), optional:: lbounds(2)
1196  integer, intent(in), optional:: ubounds(2)
1197  integer, intent(in), optional:: unit
1198  character(*), intent(in), optional:: indent
1199  logical, intent(in), optional:: sd
1200  integer:: out_unit
1201  integer:: indent_len
1202  character(STRING):: indent_str
1203  integer:: i
1204  integer:: alldim_size, lbound_nums(2), ubound_nums(2)
1205  character(STRING):: size_str, sd_str
1206  real:: max_value, min_value
1207  real, allocatable:: array_packed(:)
1208  real:: avg_value, variance_value, sd_value
1209 continue
1210 
1211  !-----------------------------------------------------------------
1212  ! オプショナル引数のチェック
1213  ! Check optional arguments
1214  !-----------------------------------------------------------------
1215  if ( present(unit) ) then
1216  out_unit = unit
1217  else
1218  out_unit = stdout
1219  end if
1220 
1221  indent_len = 0
1222  indent_str = ''
1223  if ( present(indent) ) then
1224  if (len(indent) /= 0) then
1225  indent_len = len(indent)
1226  indent_str(1:indent_len) = indent
1227  end if
1228  end if
1229 
1230  !-------------------------------------------------------------------
1231  ! 配列サイズ
1232  ! Array size
1233  !-------------------------------------------------------------------
1234 
1235  if ( present(lbounds) .and. present(ubounds) ) then
1236  lbound_nums = lbounds
1237  ubound_nums = ubounds
1238  else
1239  lbound_nums(1) = lbound( array, 1 )
1240  ubound_nums(1) = ubound( array, 1 )
1241 
1242  lbound_nums(2) = lbound( array, 2 )
1243  ubound_nums(2) = ubound( array, 2 )
1244 
1245  end if
1246 
1247  size_str = '('
1248  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
1249  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
1250  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(2)))
1251  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(2)))
1252 
1253  size_str = trim(size_str) // ')'
1254 
1255  !-------------------------------------------------------------------
1256  ! 最大値
1257  ! Maximum value
1258  !-------------------------------------------------------------------
1259  max_value = maxval(array)
1260 
1261  !-------------------------------------------------------------------
1262  ! 最小値
1263  ! Minimum value
1264  !-------------------------------------------------------------------
1265  min_value = minval(array)
1266 
1267  !-------------------------------------------------------------------
1268  ! 平均値
1269  ! Average value
1270  !-------------------------------------------------------------------
1271  alldim_size = size(array)
1272  avg_value = sum(array) / real(alldim_size)
1273 
1274  !-------------------------------------------------------------------
1275  ! 標準偏差
1276  ! Standard deviation
1277  !-------------------------------------------------------------------
1278  sd_value = 0.0
1279  variance_value = 0.0
1280  sd_str = ''
1281  if ( present_and_true( sd ) ) then
1282  if ( alldim_size > 1 ) then
1283  if (allocated(array_packed)) then
1284  deallocate(array_packed)
1285  end if
1286  allocate( array_packed(alldim_size) )
1287 
1288  array_packed = pack(array, .true.)
1289 
1290 
1291  do i = 1, alldim_size
1292  variance_value = variance_value + &
1293  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
1294  end do
1295  variance_value = variance_value / real(alldim_size)
1296  sd_value = sqrt( variance_value )
1297  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
1298  end if
1299  end if
1300 
1301  !-------------------------------------------------------------------
1302  ! 印字
1303  ! Print
1304  !-------------------------------------------------------------------
1305  call printf(out_unit, &
1306  & indent_str(1:indent_len) // &
1307  & '#<SP-ARRAY:: @size=%c, @max=%r, @min=%r, @avg=%r%c>', &
1308  & r = (/max_value, min_value, avg_value/), &
1309 
1310 
1311  & c1 = trim(size_str), c2 = trim(sd_str) )
1312 
1313 end subroutine putlinereal2
1314 
1315 
1316 subroutine putlinereal3( array, lbounds, ubounds, unit, indent, sd )
1317 
1318 
1319  use dc_types, only: dp, string, stdout
1320  use dc_string, only: tochar
1321  use dc_string, only: printf, cprintf
1322  use dc_present, only: present_and_true
1323  implicit none
1324  real, intent(in):: array(:,:,:)
1325  integer, intent(in), optional:: lbounds(3)
1326  integer, intent(in), optional:: ubounds(3)
1327  integer, intent(in), optional:: unit
1328  character(*), intent(in), optional:: indent
1329  logical, intent(in), optional:: sd
1330  integer:: out_unit
1331  integer:: indent_len
1332  character(STRING):: indent_str
1333  integer:: i
1334  integer:: alldim_size, lbound_nums(3), ubound_nums(3)
1335  character(STRING):: size_str, sd_str
1336  real:: max_value, min_value
1337  real, allocatable:: array_packed(:)
1338  real:: avg_value, variance_value, sd_value
1339 continue
1340 
1341  !-----------------------------------------------------------------
1342  ! オプショナル引数のチェック
1343  ! Check optional arguments
1344  !-----------------------------------------------------------------
1345  if ( present(unit) ) then
1346  out_unit = unit
1347  else
1348  out_unit = stdout
1349  end if
1350 
1351  indent_len = 0
1352  indent_str = ''
1353  if ( present(indent) ) then
1354  if (len(indent) /= 0) then
1355  indent_len = len(indent)
1356  indent_str(1:indent_len) = indent
1357  end if
1358  end if
1359 
1360  !-------------------------------------------------------------------
1361  ! 配列サイズ
1362  ! Array size
1363  !-------------------------------------------------------------------
1364 
1365  if ( present(lbounds) .and. present(ubounds) ) then
1366  lbound_nums = lbounds
1367  ubound_nums = ubounds
1368  else
1369  lbound_nums(1) = lbound( array, 1 )
1370  ubound_nums(1) = ubound( array, 1 )
1371 
1372  lbound_nums(2) = lbound( array, 2 )
1373  ubound_nums(2) = ubound( array, 2 )
1374 
1375  lbound_nums(3) = lbound( array, 3 )
1376  ubound_nums(3) = ubound( array, 3 )
1377 
1378  end if
1379 
1380  size_str = '('
1381  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
1382  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
1383  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(2)))
1384  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(2)))
1385 
1386  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(3)))
1387  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(3)))
1388 
1389  size_str = trim(size_str) // ')'
1390 
1391  !-------------------------------------------------------------------
1392  ! 最大値
1393  ! Maximum value
1394  !-------------------------------------------------------------------
1395  max_value = maxval(array)
1396 
1397  !-------------------------------------------------------------------
1398  ! 最小値
1399  ! Minimum value
1400  !-------------------------------------------------------------------
1401  min_value = minval(array)
1402 
1403  !-------------------------------------------------------------------
1404  ! 平均値
1405  ! Average value
1406  !-------------------------------------------------------------------
1407  alldim_size = size(array)
1408  avg_value = sum(array) / real(alldim_size)
1409 
1410  !-------------------------------------------------------------------
1411  ! 標準偏差
1412  ! Standard deviation
1413  !-------------------------------------------------------------------
1414  sd_value = 0.0
1415  variance_value = 0.0
1416  sd_str = ''
1417  if ( present_and_true( sd ) ) then
1418  if ( alldim_size > 1 ) then
1419  if (allocated(array_packed)) then
1420  deallocate(array_packed)
1421  end if
1422  allocate( array_packed(alldim_size) )
1423 
1424  array_packed = pack(array, .true.)
1425 
1426 
1427  do i = 1, alldim_size
1428  variance_value = variance_value + &
1429  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
1430  end do
1431  variance_value = variance_value / real(alldim_size)
1432  sd_value = sqrt( variance_value )
1433  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
1434  end if
1435  end if
1436 
1437  !-------------------------------------------------------------------
1438  ! 印字
1439  ! Print
1440  !-------------------------------------------------------------------
1441  call printf(out_unit, &
1442  & indent_str(1:indent_len) // &
1443  & '#<SP-ARRAY:: @size=%c, @max=%r, @min=%r, @avg=%r%c>', &
1444  & r = (/max_value, min_value, avg_value/), &
1445 
1446 
1447  & c1 = trim(size_str), c2 = trim(sd_str) )
1448 
1449 end subroutine putlinereal3
1450 
1451 
1452 subroutine putlinereal4( array, lbounds, ubounds, unit, indent, sd )
1453 
1454 
1455  use dc_types, only: dp, string, stdout
1456  use dc_string, only: tochar
1457  use dc_string, only: printf, cprintf
1458  use dc_present, only: present_and_true
1459  implicit none
1460  real, intent(in):: array(:,:,:,:)
1461  integer, intent(in), optional:: lbounds(4)
1462  integer, intent(in), optional:: ubounds(4)
1463  integer, intent(in), optional:: unit
1464  character(*), intent(in), optional:: indent
1465  logical, intent(in), optional:: sd
1466  integer:: out_unit
1467  integer:: indent_len
1468  character(STRING):: indent_str
1469  integer:: i
1470  integer:: alldim_size, lbound_nums(4), ubound_nums(4)
1471  character(STRING):: size_str, sd_str
1472  real:: max_value, min_value
1473  real, allocatable:: array_packed(:)
1474  real:: avg_value, variance_value, sd_value
1475 continue
1476 
1477  !-----------------------------------------------------------------
1478  ! オプショナル引数のチェック
1479  ! Check optional arguments
1480  !-----------------------------------------------------------------
1481  if ( present(unit) ) then
1482  out_unit = unit
1483  else
1484  out_unit = stdout
1485  end if
1486 
1487  indent_len = 0
1488  indent_str = ''
1489  if ( present(indent) ) then
1490  if (len(indent) /= 0) then
1491  indent_len = len(indent)
1492  indent_str(1:indent_len) = indent
1493  end if
1494  end if
1495 
1496  !-------------------------------------------------------------------
1497  ! 配列サイズ
1498  ! Array size
1499  !-------------------------------------------------------------------
1500 
1501  if ( present(lbounds) .and. present(ubounds) ) then
1502  lbound_nums = lbounds
1503  ubound_nums = ubounds
1504  else
1505  lbound_nums(1) = lbound( array, 1 )
1506  ubound_nums(1) = ubound( array, 1 )
1507 
1508  lbound_nums(2) = lbound( array, 2 )
1509  ubound_nums(2) = ubound( array, 2 )
1510 
1511  lbound_nums(3) = lbound( array, 3 )
1512  ubound_nums(3) = ubound( array, 3 )
1513 
1514  lbound_nums(4) = lbound( array, 4 )
1515  ubound_nums(4) = ubound( array, 4 )
1516 
1517  end if
1518 
1519  size_str = '('
1520  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
1521  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
1522  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(2)))
1523  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(2)))
1524 
1525  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(3)))
1526  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(3)))
1527 
1528  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(4)))
1529  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(4)))
1530 
1531  size_str = trim(size_str) // ')'
1532 
1533  !-------------------------------------------------------------------
1534  ! 最大値
1535  ! Maximum value
1536  !-------------------------------------------------------------------
1537  max_value = maxval(array)
1538 
1539  !-------------------------------------------------------------------
1540  ! 最小値
1541  ! Minimum value
1542  !-------------------------------------------------------------------
1543  min_value = minval(array)
1544 
1545  !-------------------------------------------------------------------
1546  ! 平均値
1547  ! Average value
1548  !-------------------------------------------------------------------
1549  alldim_size = size(array)
1550  avg_value = sum(array) / real(alldim_size)
1551 
1552  !-------------------------------------------------------------------
1553  ! 標準偏差
1554  ! Standard deviation
1555  !-------------------------------------------------------------------
1556  sd_value = 0.0
1557  variance_value = 0.0
1558  sd_str = ''
1559  if ( present_and_true( sd ) ) then
1560  if ( alldim_size > 1 ) then
1561  if (allocated(array_packed)) then
1562  deallocate(array_packed)
1563  end if
1564  allocate( array_packed(alldim_size) )
1565 
1566  array_packed = pack(array, .true.)
1567 
1568 
1569  do i = 1, alldim_size
1570  variance_value = variance_value + &
1571  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
1572  end do
1573  variance_value = variance_value / real(alldim_size)
1574  sd_value = sqrt( variance_value )
1575  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
1576  end if
1577  end if
1578 
1579  !-------------------------------------------------------------------
1580  ! 印字
1581  ! Print
1582  !-------------------------------------------------------------------
1583  call printf(out_unit, &
1584  & indent_str(1:indent_len) // &
1585  & '#<SP-ARRAY:: @size=%c, @max=%r, @min=%r, @avg=%r%c>', &
1586  & r = (/max_value, min_value, avg_value/), &
1587 
1588 
1589  & c1 = trim(size_str), c2 = trim(sd_str) )
1590 
1591 end subroutine putlinereal4
1592 
1593 
1594 subroutine putlinereal5( array, lbounds, ubounds, unit, indent, sd )
1595 
1596 
1597  use dc_types, only: dp, string, stdout
1598  use dc_string, only: tochar
1599  use dc_string, only: printf, cprintf
1600  use dc_present, only: present_and_true
1601  implicit none
1602  real, intent(in):: array(:,:,:,:,:)
1603  integer, intent(in), optional:: lbounds(5)
1604  integer, intent(in), optional:: ubounds(5)
1605  integer, intent(in), optional:: unit
1606  character(*), intent(in), optional:: indent
1607  logical, intent(in), optional:: sd
1608  integer:: out_unit
1609  integer:: indent_len
1610  character(STRING):: indent_str
1611  integer:: i
1612  integer:: alldim_size, lbound_nums(5), ubound_nums(5)
1613  character(STRING):: size_str, sd_str
1614  real:: max_value, min_value
1615  real, allocatable:: array_packed(:)
1616  real:: avg_value, variance_value, sd_value
1617 continue
1618 
1619  !-----------------------------------------------------------------
1620  ! オプショナル引数のチェック
1621  ! Check optional arguments
1622  !-----------------------------------------------------------------
1623  if ( present(unit) ) then
1624  out_unit = unit
1625  else
1626  out_unit = stdout
1627  end if
1628 
1629  indent_len = 0
1630  indent_str = ''
1631  if ( present(indent) ) then
1632  if (len(indent) /= 0) then
1633  indent_len = len(indent)
1634  indent_str(1:indent_len) = indent
1635  end if
1636  end if
1637 
1638  !-------------------------------------------------------------------
1639  ! 配列サイズ
1640  ! Array size
1641  !-------------------------------------------------------------------
1642 
1643  if ( present(lbounds) .and. present(ubounds) ) then
1644  lbound_nums = lbounds
1645  ubound_nums = ubounds
1646  else
1647  lbound_nums(1) = lbound( array, 1 )
1648  ubound_nums(1) = ubound( array, 1 )
1649 
1650  lbound_nums(2) = lbound( array, 2 )
1651  ubound_nums(2) = ubound( array, 2 )
1652 
1653  lbound_nums(3) = lbound( array, 3 )
1654  ubound_nums(3) = ubound( array, 3 )
1655 
1656  lbound_nums(4) = lbound( array, 4 )
1657  ubound_nums(4) = ubound( array, 4 )
1658 
1659  lbound_nums(5) = lbound( array, 5 )
1660  ubound_nums(5) = ubound( array, 5 )
1661 
1662  end if
1663 
1664  size_str = '('
1665  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
1666  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
1667  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(2)))
1668  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(2)))
1669 
1670  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(3)))
1671  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(3)))
1672 
1673  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(4)))
1674  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(4)))
1675 
1676  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(5)))
1677  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(5)))
1678 
1679  size_str = trim(size_str) // ')'
1680 
1681  !-------------------------------------------------------------------
1682  ! 最大値
1683  ! Maximum value
1684  !-------------------------------------------------------------------
1685  max_value = maxval(array)
1686 
1687  !-------------------------------------------------------------------
1688  ! 最小値
1689  ! Minimum value
1690  !-------------------------------------------------------------------
1691  min_value = minval(array)
1692 
1693  !-------------------------------------------------------------------
1694  ! 平均値
1695  ! Average value
1696  !-------------------------------------------------------------------
1697  alldim_size = size(array)
1698  avg_value = sum(array) / real(alldim_size)
1699 
1700  !-------------------------------------------------------------------
1701  ! 標準偏差
1702  ! Standard deviation
1703  !-------------------------------------------------------------------
1704  sd_value = 0.0
1705  variance_value = 0.0
1706  sd_str = ''
1707  if ( present_and_true( sd ) ) then
1708  if ( alldim_size > 1 ) then
1709  if (allocated(array_packed)) then
1710  deallocate(array_packed)
1711  end if
1712  allocate( array_packed(alldim_size) )
1713 
1714  array_packed = pack(array, .true.)
1715 
1716 
1717  do i = 1, alldim_size
1718  variance_value = variance_value + &
1719  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
1720  end do
1721  variance_value = variance_value / real(alldim_size)
1722  sd_value = sqrt( variance_value )
1723  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
1724  end if
1725  end if
1726 
1727  !-------------------------------------------------------------------
1728  ! 印字
1729  ! Print
1730  !-------------------------------------------------------------------
1731  call printf(out_unit, &
1732  & indent_str(1:indent_len) // &
1733  & '#<SP-ARRAY:: @size=%c, @max=%r, @min=%r, @avg=%r%c>', &
1734  & r = (/max_value, min_value, avg_value/), &
1735 
1736 
1737  & c1 = trim(size_str), c2 = trim(sd_str) )
1738 
1739 end subroutine putlinereal5
1740 
1741 
1742 subroutine putlinereal6( array, lbounds, ubounds, unit, indent, sd )
1743 
1744 
1745  use dc_types, only: dp, string, stdout
1746  use dc_string, only: tochar
1747  use dc_string, only: printf, cprintf
1748  use dc_present, only: present_and_true
1749  implicit none
1750  real, intent(in):: array(:,:,:,:,:,:)
1751  integer, intent(in), optional:: lbounds(6)
1752  integer, intent(in), optional:: ubounds(6)
1753  integer, intent(in), optional:: unit
1754  character(*), intent(in), optional:: indent
1755  logical, intent(in), optional:: sd
1756  integer:: out_unit
1757  integer:: indent_len
1758  character(STRING):: indent_str
1759  integer:: i
1760  integer:: alldim_size, lbound_nums(6), ubound_nums(6)
1761  character(STRING):: size_str, sd_str
1762  real:: max_value, min_value
1763  real, allocatable:: array_packed(:)
1764  real:: avg_value, variance_value, sd_value
1765 continue
1766 
1767  !-----------------------------------------------------------------
1768  ! オプショナル引数のチェック
1769  ! Check optional arguments
1770  !-----------------------------------------------------------------
1771  if ( present(unit) ) then
1772  out_unit = unit
1773  else
1774  out_unit = stdout
1775  end if
1776 
1777  indent_len = 0
1778  indent_str = ''
1779  if ( present(indent) ) then
1780  if (len(indent) /= 0) then
1781  indent_len = len(indent)
1782  indent_str(1:indent_len) = indent
1783  end if
1784  end if
1785 
1786  !-------------------------------------------------------------------
1787  ! 配列サイズ
1788  ! Array size
1789  !-------------------------------------------------------------------
1790 
1791  if ( present(lbounds) .and. present(ubounds) ) then
1792  lbound_nums = lbounds
1793  ubound_nums = ubounds
1794  else
1795  lbound_nums(1) = lbound( array, 1 )
1796  ubound_nums(1) = ubound( array, 1 )
1797 
1798  lbound_nums(2) = lbound( array, 2 )
1799  ubound_nums(2) = ubound( array, 2 )
1800 
1801  lbound_nums(3) = lbound( array, 3 )
1802  ubound_nums(3) = ubound( array, 3 )
1803 
1804  lbound_nums(4) = lbound( array, 4 )
1805  ubound_nums(4) = ubound( array, 4 )
1806 
1807  lbound_nums(5) = lbound( array, 5 )
1808  ubound_nums(5) = ubound( array, 5 )
1809 
1810  lbound_nums(6) = lbound( array, 6 )
1811  ubound_nums(6) = ubound( array, 6 )
1812 
1813  end if
1814 
1815  size_str = '('
1816  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
1817  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
1818  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(2)))
1819  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(2)))
1820 
1821  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(3)))
1822  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(3)))
1823 
1824  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(4)))
1825  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(4)))
1826 
1827  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(5)))
1828  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(5)))
1829 
1830  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(6)))
1831  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(6)))
1832 
1833  size_str = trim(size_str) // ')'
1834 
1835  !-------------------------------------------------------------------
1836  ! 最大値
1837  ! Maximum value
1838  !-------------------------------------------------------------------
1839  max_value = maxval(array)
1840 
1841  !-------------------------------------------------------------------
1842  ! 最小値
1843  ! Minimum value
1844  !-------------------------------------------------------------------
1845  min_value = minval(array)
1846 
1847  !-------------------------------------------------------------------
1848  ! 平均値
1849  ! Average value
1850  !-------------------------------------------------------------------
1851  alldim_size = size(array)
1852  avg_value = sum(array) / real(alldim_size)
1853 
1854  !-------------------------------------------------------------------
1855  ! 標準偏差
1856  ! Standard deviation
1857  !-------------------------------------------------------------------
1858  sd_value = 0.0
1859  variance_value = 0.0
1860  sd_str = ''
1861  if ( present_and_true( sd ) ) then
1862  if ( alldim_size > 1 ) then
1863  if (allocated(array_packed)) then
1864  deallocate(array_packed)
1865  end if
1866  allocate( array_packed(alldim_size) )
1867 
1868  array_packed = pack(array, .true.)
1869 
1870 
1871  do i = 1, alldim_size
1872  variance_value = variance_value + &
1873  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
1874  end do
1875  variance_value = variance_value / real(alldim_size)
1876  sd_value = sqrt( variance_value )
1877  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
1878  end if
1879  end if
1880 
1881  !-------------------------------------------------------------------
1882  ! 印字
1883  ! Print
1884  !-------------------------------------------------------------------
1885  call printf(out_unit, &
1886  & indent_str(1:indent_len) // &
1887  & '#<SP-ARRAY:: @size=%c, @max=%r, @min=%r, @avg=%r%c>', &
1888  & r = (/max_value, min_value, avg_value/), &
1889 
1890 
1891  & c1 = trim(size_str), c2 = trim(sd_str) )
1892 
1893 end subroutine putlinereal6
1894 
1895 
1896 subroutine putlinereal7( array, lbounds, ubounds, unit, indent, sd )
1897 
1898 
1899  use dc_types, only: dp, string, stdout
1900  use dc_string, only: tochar
1901  use dc_string, only: printf, cprintf
1902  use dc_present, only: present_and_true
1903  implicit none
1904  real, intent(in):: array(:,:,:,:,:,:,:)
1905  integer, intent(in), optional:: lbounds(7)
1906  integer, intent(in), optional:: ubounds(7)
1907  integer, intent(in), optional:: unit
1908  character(*), intent(in), optional:: indent
1909  logical, intent(in), optional:: sd
1910  integer:: out_unit
1911  integer:: indent_len
1912  character(STRING):: indent_str
1913  integer:: i
1914  integer:: alldim_size, lbound_nums(7), ubound_nums(7)
1915  character(STRING):: size_str, sd_str
1916  real:: max_value, min_value
1917  real, allocatable:: array_packed(:)
1918  real:: avg_value, variance_value, sd_value
1919 continue
1920 
1921  !-----------------------------------------------------------------
1922  ! オプショナル引数のチェック
1923  ! Check optional arguments
1924  !-----------------------------------------------------------------
1925  if ( present(unit) ) then
1926  out_unit = unit
1927  else
1928  out_unit = stdout
1929  end if
1930 
1931  indent_len = 0
1932  indent_str = ''
1933  if ( present(indent) ) then
1934  if (len(indent) /= 0) then
1935  indent_len = len(indent)
1936  indent_str(1:indent_len) = indent
1937  end if
1938  end if
1939 
1940  !-------------------------------------------------------------------
1941  ! 配列サイズ
1942  ! Array size
1943  !-------------------------------------------------------------------
1944 
1945  if ( present(lbounds) .and. present(ubounds) ) then
1946  lbound_nums = lbounds
1947  ubound_nums = ubounds
1948  else
1949  lbound_nums(1) = lbound( array, 1 )
1950  ubound_nums(1) = ubound( array, 1 )
1951 
1952  lbound_nums(2) = lbound( array, 2 )
1953  ubound_nums(2) = ubound( array, 2 )
1954 
1955  lbound_nums(3) = lbound( array, 3 )
1956  ubound_nums(3) = ubound( array, 3 )
1957 
1958  lbound_nums(4) = lbound( array, 4 )
1959  ubound_nums(4) = ubound( array, 4 )
1960 
1961  lbound_nums(5) = lbound( array, 5 )
1962  ubound_nums(5) = ubound( array, 5 )
1963 
1964  lbound_nums(6) = lbound( array, 6 )
1965  ubound_nums(6) = ubound( array, 6 )
1966 
1967  lbound_nums(7) = lbound( array, 7 )
1968  ubound_nums(7) = ubound( array, 7 )
1969 
1970  end if
1971 
1972  size_str = '('
1973  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
1974  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
1975  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(2)))
1976  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(2)))
1977 
1978  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(3)))
1979  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(3)))
1980 
1981  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(4)))
1982  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(4)))
1983 
1984  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(5)))
1985  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(5)))
1986 
1987  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(6)))
1988  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(6)))
1989 
1990  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(7)))
1991  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(7)))
1992 
1993  size_str = trim(size_str) // ')'
1994 
1995  !-------------------------------------------------------------------
1996  ! 最大値
1997  ! Maximum value
1998  !-------------------------------------------------------------------
1999  max_value = maxval(array)
2000 
2001  !-------------------------------------------------------------------
2002  ! 最小値
2003  ! Minimum value
2004  !-------------------------------------------------------------------
2005  min_value = minval(array)
2006 
2007  !-------------------------------------------------------------------
2008  ! 平均値
2009  ! Average value
2010  !-------------------------------------------------------------------
2011  alldim_size = size(array)
2012  avg_value = sum(array) / real(alldim_size)
2013 
2014  !-------------------------------------------------------------------
2015  ! 標準偏差
2016  ! Standard deviation
2017  !-------------------------------------------------------------------
2018  sd_value = 0.0
2019  variance_value = 0.0
2020  sd_str = ''
2021  if ( present_and_true( sd ) ) then
2022  if ( alldim_size > 1 ) then
2023  if (allocated(array_packed)) then
2024  deallocate(array_packed)
2025  end if
2026  allocate( array_packed(alldim_size) )
2027 
2028  array_packed = pack(array, .true.)
2029 
2030 
2031  do i = 1, alldim_size
2032  variance_value = variance_value + &
2033  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
2034  end do
2035  variance_value = variance_value / real(alldim_size)
2036  sd_value = sqrt( variance_value )
2037  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
2038  end if
2039  end if
2040 
2041  !-------------------------------------------------------------------
2042  ! 印字
2043  ! Print
2044  !-------------------------------------------------------------------
2045  call printf(out_unit, &
2046  & indent_str(1:indent_len) // &
2047  & '#<SP-ARRAY:: @size=%c, @max=%r, @min=%r, @avg=%r%c>', &
2048  & r = (/max_value, min_value, avg_value/), &
2049 
2050 
2051  & c1 = trim(size_str), c2 = trim(sd_str) )
2052 
2053 end subroutine putlinereal7
2054 
2055 
2056 subroutine putlinedouble1( array, lbounds, ubounds, unit, indent, sd )
2057 
2058 
2059 
2060  use dc_types, only: dp, string, stdout
2061  use dc_string, only: tochar
2062  use dc_string, only: printf, cprintf
2063  use dc_present, only: present_and_true
2064  implicit none
2065  real(DP), intent(in):: array(:)
2066  integer, intent(in), optional:: lbounds(1)
2067  integer, intent(in), optional:: ubounds(1)
2068  integer, intent(in), optional:: unit
2069  character(*), intent(in), optional:: indent
2070  logical, intent(in), optional:: sd
2071  integer:: out_unit
2072  integer:: indent_len
2073  character(STRING):: indent_str
2074  integer:: i
2075  integer:: alldim_size, lbound_nums(1), ubound_nums(1)
2076  character(STRING):: size_str, sd_str
2077  real(DP):: max_value, min_value
2078  real(DP), allocatable:: array_packed(:)
2079  real:: avg_value, variance_value, sd_value
2080 continue
2081 
2082  !-----------------------------------------------------------------
2083  ! オプショナル引数のチェック
2084  ! Check optional arguments
2085  !-----------------------------------------------------------------
2086  if ( present(unit) ) then
2087  out_unit = unit
2088  else
2089  out_unit = stdout
2090  end if
2091 
2092  indent_len = 0
2093  indent_str = ''
2094  if ( present(indent) ) then
2095  if (len(indent) /= 0) then
2096  indent_len = len(indent)
2097  indent_str(1:indent_len) = indent
2098  end if
2099  end if
2100 
2101  !-------------------------------------------------------------------
2102  ! 配列サイズ
2103  ! Array size
2104  !-------------------------------------------------------------------
2105 
2106  if ( present(lbounds) .and. present(ubounds) ) then
2107  lbound_nums = lbounds
2108  ubound_nums = ubounds
2109  else
2110  lbound_nums(1) = lbound( array, 1 )
2111  ubound_nums(1) = ubound( array, 1 )
2112 
2113  end if
2114 
2115  size_str = '('
2116  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
2117  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
2118 
2119  size_str = trim(size_str) // ')'
2120 
2121  !-------------------------------------------------------------------
2122  ! 最大値
2123  ! Maximum value
2124  !-------------------------------------------------------------------
2125  max_value = maxval(array)
2126 
2127  !-------------------------------------------------------------------
2128  ! 最小値
2129  ! Minimum value
2130  !-------------------------------------------------------------------
2131  min_value = minval(array)
2132 
2133  !-------------------------------------------------------------------
2134  ! 平均値
2135  ! Average value
2136  !-------------------------------------------------------------------
2137  alldim_size = size(array)
2138  avg_value = sum(array) / real(alldim_size)
2139 
2140  !-------------------------------------------------------------------
2141  ! 標準偏差
2142  ! Standard deviation
2143  !-------------------------------------------------------------------
2144  sd_value = 0.0
2145  variance_value = 0.0
2146  sd_str = ''
2147  if ( present_and_true( sd ) ) then
2148  if ( alldim_size > 1 ) then
2149  if (allocated(array_packed)) then
2150  deallocate(array_packed)
2151  end if
2152  allocate( array_packed(alldim_size) )
2153 
2154  array_packed = array
2155 
2156 
2157  do i = 1, alldim_size
2158  variance_value = variance_value + &
2159  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
2160  end do
2161  variance_value = variance_value / real(alldim_size)
2162  sd_value = sqrt( variance_value )
2163  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
2164  end if
2165  end if
2166 
2167  !-------------------------------------------------------------------
2168  ! 印字
2169  ! Print
2170  !-------------------------------------------------------------------
2171  call printf(out_unit, &
2172  & indent_str(1:indent_len) // &
2173  & '#<DP-ARRAY:: @size=%c, @max=%f, @min=%f, @avg=%r%c>', &
2174  & d = (/max_value, min_value/), r = (/avg_value/), &
2175 
2176 
2177  & c1 = trim(size_str), c2 = trim(sd_str) )
2178 
2179 end subroutine putlinedouble1
2180 
2181 
2182 subroutine putlinedouble2( array, lbounds, ubounds, unit, indent, sd )
2183 
2184 
2185  use dc_types, only: dp, string, stdout
2186  use dc_string, only: tochar
2187  use dc_string, only: printf, cprintf
2188  use dc_present, only: present_and_true
2189  implicit none
2190  real(DP), intent(in):: array(:,:)
2191  integer, intent(in), optional:: lbounds(2)
2192  integer, intent(in), optional:: ubounds(2)
2193  integer, intent(in), optional:: unit
2194  character(*), intent(in), optional:: indent
2195  logical, intent(in), optional:: sd
2196  integer:: out_unit
2197  integer:: indent_len
2198  character(STRING):: indent_str
2199  integer:: i
2200  integer:: alldim_size, lbound_nums(2), ubound_nums(2)
2201  character(STRING):: size_str, sd_str
2202  real(DP):: max_value, min_value
2203  real(DP), allocatable:: array_packed(:)
2204  real:: avg_value, variance_value, sd_value
2205 continue
2206 
2207  !-----------------------------------------------------------------
2208  ! オプショナル引数のチェック
2209  ! Check optional arguments
2210  !-----------------------------------------------------------------
2211  if ( present(unit) ) then
2212  out_unit = unit
2213  else
2214  out_unit = stdout
2215  end if
2216 
2217  indent_len = 0
2218  indent_str = ''
2219  if ( present(indent) ) then
2220  if (len(indent) /= 0) then
2221  indent_len = len(indent)
2222  indent_str(1:indent_len) = indent
2223  end if
2224  end if
2225 
2226  !-------------------------------------------------------------------
2227  ! 配列サイズ
2228  ! Array size
2229  !-------------------------------------------------------------------
2230 
2231  if ( present(lbounds) .and. present(ubounds) ) then
2232  lbound_nums = lbounds
2233  ubound_nums = ubounds
2234  else
2235  lbound_nums(1) = lbound( array, 1 )
2236  ubound_nums(1) = ubound( array, 1 )
2237 
2238  lbound_nums(2) = lbound( array, 2 )
2239  ubound_nums(2) = ubound( array, 2 )
2240 
2241  end if
2242 
2243  size_str = '('
2244  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
2245  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
2246  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(2)))
2247  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(2)))
2248 
2249  size_str = trim(size_str) // ')'
2250 
2251  !-------------------------------------------------------------------
2252  ! 最大値
2253  ! Maximum value
2254  !-------------------------------------------------------------------
2255  max_value = maxval(array)
2256 
2257  !-------------------------------------------------------------------
2258  ! 最小値
2259  ! Minimum value
2260  !-------------------------------------------------------------------
2261  min_value = minval(array)
2262 
2263  !-------------------------------------------------------------------
2264  ! 平均値
2265  ! Average value
2266  !-------------------------------------------------------------------
2267  alldim_size = size(array)
2268  avg_value = sum(array) / real(alldim_size)
2269 
2270  !-------------------------------------------------------------------
2271  ! 標準偏差
2272  ! Standard deviation
2273  !-------------------------------------------------------------------
2274  sd_value = 0.0
2275  variance_value = 0.0
2276  sd_str = ''
2277  if ( present_and_true( sd ) ) then
2278  if ( alldim_size > 1 ) then
2279  if (allocated(array_packed)) then
2280  deallocate(array_packed)
2281  end if
2282  allocate( array_packed(alldim_size) )
2283 
2284  array_packed = pack(array, .true.)
2285 
2286 
2287  do i = 1, alldim_size
2288  variance_value = variance_value + &
2289  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
2290  end do
2291  variance_value = variance_value / real(alldim_size)
2292  sd_value = sqrt( variance_value )
2293  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
2294  end if
2295  end if
2296 
2297  !-------------------------------------------------------------------
2298  ! 印字
2299  ! Print
2300  !-------------------------------------------------------------------
2301  call printf(out_unit, &
2302  & indent_str(1:indent_len) // &
2303  & '#<DP-ARRAY:: @size=%c, @max=%f, @min=%f, @avg=%r%c>', &
2304  & d = (/max_value, min_value/), r = (/avg_value/), &
2305 
2306 
2307  & c1 = trim(size_str), c2 = trim(sd_str) )
2308 
2309 end subroutine putlinedouble2
2310 
2311 
2312 subroutine putlinedouble3( array, lbounds, ubounds, unit, indent, sd )
2313 
2314 
2315  use dc_types, only: dp, string, stdout
2316  use dc_string, only: tochar
2317  use dc_string, only: printf, cprintf
2318  use dc_present, only: present_and_true
2319  implicit none
2320  real(DP), intent(in):: array(:,:,:)
2321  integer, intent(in), optional:: lbounds(3)
2322  integer, intent(in), optional:: ubounds(3)
2323  integer, intent(in), optional:: unit
2324  character(*), intent(in), optional:: indent
2325  logical, intent(in), optional:: sd
2326  integer:: out_unit
2327  integer:: indent_len
2328  character(STRING):: indent_str
2329  integer:: i
2330  integer:: alldim_size, lbound_nums(3), ubound_nums(3)
2331  character(STRING):: size_str, sd_str
2332  real(DP):: max_value, min_value
2333  real(DP), allocatable:: array_packed(:)
2334  real:: avg_value, variance_value, sd_value
2335 continue
2336 
2337  !-----------------------------------------------------------------
2338  ! オプショナル引数のチェック
2339  ! Check optional arguments
2340  !-----------------------------------------------------------------
2341  if ( present(unit) ) then
2342  out_unit = unit
2343  else
2344  out_unit = stdout
2345  end if
2346 
2347  indent_len = 0
2348  indent_str = ''
2349  if ( present(indent) ) then
2350  if (len(indent) /= 0) then
2351  indent_len = len(indent)
2352  indent_str(1:indent_len) = indent
2353  end if
2354  end if
2355 
2356  !-------------------------------------------------------------------
2357  ! 配列サイズ
2358  ! Array size
2359  !-------------------------------------------------------------------
2360 
2361  if ( present(lbounds) .and. present(ubounds) ) then
2362  lbound_nums = lbounds
2363  ubound_nums = ubounds
2364  else
2365  lbound_nums(1) = lbound( array, 1 )
2366  ubound_nums(1) = ubound( array, 1 )
2367 
2368  lbound_nums(2) = lbound( array, 2 )
2369  ubound_nums(2) = ubound( array, 2 )
2370 
2371  lbound_nums(3) = lbound( array, 3 )
2372  ubound_nums(3) = ubound( array, 3 )
2373 
2374  end if
2375 
2376  size_str = '('
2377  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
2378  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
2379  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(2)))
2380  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(2)))
2381 
2382  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(3)))
2383  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(3)))
2384 
2385  size_str = trim(size_str) // ')'
2386 
2387  !-------------------------------------------------------------------
2388  ! 最大値
2389  ! Maximum value
2390  !-------------------------------------------------------------------
2391  max_value = maxval(array)
2392 
2393  !-------------------------------------------------------------------
2394  ! 最小値
2395  ! Minimum value
2396  !-------------------------------------------------------------------
2397  min_value = minval(array)
2398 
2399  !-------------------------------------------------------------------
2400  ! 平均値
2401  ! Average value
2402  !-------------------------------------------------------------------
2403  alldim_size = size(array)
2404  avg_value = sum(array) / real(alldim_size)
2405 
2406  !-------------------------------------------------------------------
2407  ! 標準偏差
2408  ! Standard deviation
2409  !-------------------------------------------------------------------
2410  sd_value = 0.0
2411  variance_value = 0.0
2412  sd_str = ''
2413  if ( present_and_true( sd ) ) then
2414  if ( alldim_size > 1 ) then
2415  if (allocated(array_packed)) then
2416  deallocate(array_packed)
2417  end if
2418  allocate( array_packed(alldim_size) )
2419 
2420  array_packed = pack(array, .true.)
2421 
2422 
2423  do i = 1, alldim_size
2424  variance_value = variance_value + &
2425  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
2426  end do
2427  variance_value = variance_value / real(alldim_size)
2428  sd_value = sqrt( variance_value )
2429  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
2430  end if
2431  end if
2432 
2433  !-------------------------------------------------------------------
2434  ! 印字
2435  ! Print
2436  !-------------------------------------------------------------------
2437  call printf(out_unit, &
2438  & indent_str(1:indent_len) // &
2439  & '#<DP-ARRAY:: @size=%c, @max=%f, @min=%f, @avg=%r%c>', &
2440  & d = (/max_value, min_value/), r = (/avg_value/), &
2441 
2442 
2443  & c1 = trim(size_str), c2 = trim(sd_str) )
2444 
2445 end subroutine putlinedouble3
2446 
2447 
2448 subroutine putlinedouble4( array, lbounds, ubounds, unit, indent, sd )
2449 
2450 
2451  use dc_types, only: dp, string, stdout
2452  use dc_string, only: tochar
2453  use dc_string, only: printf, cprintf
2454  use dc_present, only: present_and_true
2455  implicit none
2456  real(DP), intent(in):: array(:,:,:,:)
2457  integer, intent(in), optional:: lbounds(4)
2458  integer, intent(in), optional:: ubounds(4)
2459  integer, intent(in), optional:: unit
2460  character(*), intent(in), optional:: indent
2461  logical, intent(in), optional:: sd
2462  integer:: out_unit
2463  integer:: indent_len
2464  character(STRING):: indent_str
2465  integer:: i
2466  integer:: alldim_size, lbound_nums(4), ubound_nums(4)
2467  character(STRING):: size_str, sd_str
2468  real(DP):: max_value, min_value
2469  real(DP), allocatable:: array_packed(:)
2470  real:: avg_value, variance_value, sd_value
2471 continue
2472 
2473  !-----------------------------------------------------------------
2474  ! オプショナル引数のチェック
2475  ! Check optional arguments
2476  !-----------------------------------------------------------------
2477  if ( present(unit) ) then
2478  out_unit = unit
2479  else
2480  out_unit = stdout
2481  end if
2482 
2483  indent_len = 0
2484  indent_str = ''
2485  if ( present(indent) ) then
2486  if (len(indent) /= 0) then
2487  indent_len = len(indent)
2488  indent_str(1:indent_len) = indent
2489  end if
2490  end if
2491 
2492  !-------------------------------------------------------------------
2493  ! 配列サイズ
2494  ! Array size
2495  !-------------------------------------------------------------------
2496 
2497  if ( present(lbounds) .and. present(ubounds) ) then
2498  lbound_nums = lbounds
2499  ubound_nums = ubounds
2500  else
2501  lbound_nums(1) = lbound( array, 1 )
2502  ubound_nums(1) = ubound( array, 1 )
2503 
2504  lbound_nums(2) = lbound( array, 2 )
2505  ubound_nums(2) = ubound( array, 2 )
2506 
2507  lbound_nums(3) = lbound( array, 3 )
2508  ubound_nums(3) = ubound( array, 3 )
2509 
2510  lbound_nums(4) = lbound( array, 4 )
2511  ubound_nums(4) = ubound( array, 4 )
2512 
2513  end if
2514 
2515  size_str = '('
2516  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
2517  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
2518  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(2)))
2519  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(2)))
2520 
2521  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(3)))
2522  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(3)))
2523 
2524  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(4)))
2525  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(4)))
2526 
2527  size_str = trim(size_str) // ')'
2528 
2529  !-------------------------------------------------------------------
2530  ! 最大値
2531  ! Maximum value
2532  !-------------------------------------------------------------------
2533  max_value = maxval(array)
2534 
2535  !-------------------------------------------------------------------
2536  ! 最小値
2537  ! Minimum value
2538  !-------------------------------------------------------------------
2539  min_value = minval(array)
2540 
2541  !-------------------------------------------------------------------
2542  ! 平均値
2543  ! Average value
2544  !-------------------------------------------------------------------
2545  alldim_size = size(array)
2546  avg_value = sum(array) / real(alldim_size)
2547 
2548  !-------------------------------------------------------------------
2549  ! 標準偏差
2550  ! Standard deviation
2551  !-------------------------------------------------------------------
2552  sd_value = 0.0
2553  variance_value = 0.0
2554  sd_str = ''
2555  if ( present_and_true( sd ) ) then
2556  if ( alldim_size > 1 ) then
2557  if (allocated(array_packed)) then
2558  deallocate(array_packed)
2559  end if
2560  allocate( array_packed(alldim_size) )
2561 
2562  array_packed = pack(array, .true.)
2563 
2564 
2565  do i = 1, alldim_size
2566  variance_value = variance_value + &
2567  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
2568  end do
2569  variance_value = variance_value / real(alldim_size)
2570  sd_value = sqrt( variance_value )
2571  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
2572  end if
2573  end if
2574 
2575  !-------------------------------------------------------------------
2576  ! 印字
2577  ! Print
2578  !-------------------------------------------------------------------
2579  call printf(out_unit, &
2580  & indent_str(1:indent_len) // &
2581  & '#<DP-ARRAY:: @size=%c, @max=%f, @min=%f, @avg=%r%c>', &
2582  & d = (/max_value, min_value/), r = (/avg_value/), &
2583 
2584 
2585  & c1 = trim(size_str), c2 = trim(sd_str) )
2586 
2587 end subroutine putlinedouble4
2588 
2589 
2590 subroutine putlinedouble5( array, lbounds, ubounds, unit, indent, sd )
2591 
2592 
2593  use dc_types, only: dp, string, stdout
2594  use dc_string, only: tochar
2595  use dc_string, only: printf, cprintf
2596  use dc_present, only: present_and_true
2597  implicit none
2598  real(DP), intent(in):: array(:,:,:,:,:)
2599  integer, intent(in), optional:: lbounds(5)
2600  integer, intent(in), optional:: ubounds(5)
2601  integer, intent(in), optional:: unit
2602  character(*), intent(in), optional:: indent
2603  logical, intent(in), optional:: sd
2604  integer:: out_unit
2605  integer:: indent_len
2606  character(STRING):: indent_str
2607  integer:: i
2608  integer:: alldim_size, lbound_nums(5), ubound_nums(5)
2609  character(STRING):: size_str, sd_str
2610  real(DP):: max_value, min_value
2611  real(DP), allocatable:: array_packed(:)
2612  real:: avg_value, variance_value, sd_value
2613 continue
2614 
2615  !-----------------------------------------------------------------
2616  ! オプショナル引数のチェック
2617  ! Check optional arguments
2618  !-----------------------------------------------------------------
2619  if ( present(unit) ) then
2620  out_unit = unit
2621  else
2622  out_unit = stdout
2623  end if
2624 
2625  indent_len = 0
2626  indent_str = ''
2627  if ( present(indent) ) then
2628  if (len(indent) /= 0) then
2629  indent_len = len(indent)
2630  indent_str(1:indent_len) = indent
2631  end if
2632  end if
2633 
2634  !-------------------------------------------------------------------
2635  ! 配列サイズ
2636  ! Array size
2637  !-------------------------------------------------------------------
2638 
2639  if ( present(lbounds) .and. present(ubounds) ) then
2640  lbound_nums = lbounds
2641  ubound_nums = ubounds
2642  else
2643  lbound_nums(1) = lbound( array, 1 )
2644  ubound_nums(1) = ubound( array, 1 )
2645 
2646  lbound_nums(2) = lbound( array, 2 )
2647  ubound_nums(2) = ubound( array, 2 )
2648 
2649  lbound_nums(3) = lbound( array, 3 )
2650  ubound_nums(3) = ubound( array, 3 )
2651 
2652  lbound_nums(4) = lbound( array, 4 )
2653  ubound_nums(4) = ubound( array, 4 )
2654 
2655  lbound_nums(5) = lbound( array, 5 )
2656  ubound_nums(5) = ubound( array, 5 )
2657 
2658  end if
2659 
2660  size_str = '('
2661  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
2662  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
2663  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(2)))
2664  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(2)))
2665 
2666  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(3)))
2667  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(3)))
2668 
2669  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(4)))
2670  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(4)))
2671 
2672  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(5)))
2673  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(5)))
2674 
2675  size_str = trim(size_str) // ')'
2676 
2677  !-------------------------------------------------------------------
2678  ! 最大値
2679  ! Maximum value
2680  !-------------------------------------------------------------------
2681  max_value = maxval(array)
2682 
2683  !-------------------------------------------------------------------
2684  ! 最小値
2685  ! Minimum value
2686  !-------------------------------------------------------------------
2687  min_value = minval(array)
2688 
2689  !-------------------------------------------------------------------
2690  ! 平均値
2691  ! Average value
2692  !-------------------------------------------------------------------
2693  alldim_size = size(array)
2694  avg_value = sum(array) / real(alldim_size)
2695 
2696  !-------------------------------------------------------------------
2697  ! 標準偏差
2698  ! Standard deviation
2699  !-------------------------------------------------------------------
2700  sd_value = 0.0
2701  variance_value = 0.0
2702  sd_str = ''
2703  if ( present_and_true( sd ) ) then
2704  if ( alldim_size > 1 ) then
2705  if (allocated(array_packed)) then
2706  deallocate(array_packed)
2707  end if
2708  allocate( array_packed(alldim_size) )
2709 
2710  array_packed = pack(array, .true.)
2711 
2712 
2713  do i = 1, alldim_size
2714  variance_value = variance_value + &
2715  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
2716  end do
2717  variance_value = variance_value / real(alldim_size)
2718  sd_value = sqrt( variance_value )
2719  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
2720  end if
2721  end if
2722 
2723  !-------------------------------------------------------------------
2724  ! 印字
2725  ! Print
2726  !-------------------------------------------------------------------
2727  call printf(out_unit, &
2728  & indent_str(1:indent_len) // &
2729  & '#<DP-ARRAY:: @size=%c, @max=%f, @min=%f, @avg=%r%c>', &
2730  & d = (/max_value, min_value/), r = (/avg_value/), &
2731 
2732 
2733  & c1 = trim(size_str), c2 = trim(sd_str) )
2734 
2735 end subroutine putlinedouble5
2736 
2737 
2738 subroutine putlinedouble6( array, lbounds, ubounds, unit, indent, sd )
2739 
2740 
2741  use dc_types, only: dp, string, stdout
2742  use dc_string, only: tochar
2743  use dc_string, only: printf, cprintf
2744  use dc_present, only: present_and_true
2745  implicit none
2746  real(DP), intent(in):: array(:,:,:,:,:,:)
2747  integer, intent(in), optional:: lbounds(6)
2748  integer, intent(in), optional:: ubounds(6)
2749  integer, intent(in), optional:: unit
2750  character(*), intent(in), optional:: indent
2751  logical, intent(in), optional:: sd
2752  integer:: out_unit
2753  integer:: indent_len
2754  character(STRING):: indent_str
2755  integer:: i
2756  integer:: alldim_size, lbound_nums(6), ubound_nums(6)
2757  character(STRING):: size_str, sd_str
2758  real(DP):: max_value, min_value
2759  real(DP), allocatable:: array_packed(:)
2760  real:: avg_value, variance_value, sd_value
2761 continue
2762 
2763  !-----------------------------------------------------------------
2764  ! オプショナル引数のチェック
2765  ! Check optional arguments
2766  !-----------------------------------------------------------------
2767  if ( present(unit) ) then
2768  out_unit = unit
2769  else
2770  out_unit = stdout
2771  end if
2772 
2773  indent_len = 0
2774  indent_str = ''
2775  if ( present(indent) ) then
2776  if (len(indent) /= 0) then
2777  indent_len = len(indent)
2778  indent_str(1:indent_len) = indent
2779  end if
2780  end if
2781 
2782  !-------------------------------------------------------------------
2783  ! 配列サイズ
2784  ! Array size
2785  !-------------------------------------------------------------------
2786 
2787  if ( present(lbounds) .and. present(ubounds) ) then
2788  lbound_nums = lbounds
2789  ubound_nums = ubounds
2790  else
2791  lbound_nums(1) = lbound( array, 1 )
2792  ubound_nums(1) = ubound( array, 1 )
2793 
2794  lbound_nums(2) = lbound( array, 2 )
2795  ubound_nums(2) = ubound( array, 2 )
2796 
2797  lbound_nums(3) = lbound( array, 3 )
2798  ubound_nums(3) = ubound( array, 3 )
2799 
2800  lbound_nums(4) = lbound( array, 4 )
2801  ubound_nums(4) = ubound( array, 4 )
2802 
2803  lbound_nums(5) = lbound( array, 5 )
2804  ubound_nums(5) = ubound( array, 5 )
2805 
2806  lbound_nums(6) = lbound( array, 6 )
2807  ubound_nums(6) = ubound( array, 6 )
2808 
2809  end if
2810 
2811  size_str = '('
2812  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
2813  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
2814  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(2)))
2815  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(2)))
2816 
2817  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(3)))
2818  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(3)))
2819 
2820  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(4)))
2821  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(4)))
2822 
2823  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(5)))
2824  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(5)))
2825 
2826  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(6)))
2827  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(6)))
2828 
2829  size_str = trim(size_str) // ')'
2830 
2831  !-------------------------------------------------------------------
2832  ! 最大値
2833  ! Maximum value
2834  !-------------------------------------------------------------------
2835  max_value = maxval(array)
2836 
2837  !-------------------------------------------------------------------
2838  ! 最小値
2839  ! Minimum value
2840  !-------------------------------------------------------------------
2841  min_value = minval(array)
2842 
2843  !-------------------------------------------------------------------
2844  ! 平均値
2845  ! Average value
2846  !-------------------------------------------------------------------
2847  alldim_size = size(array)
2848  avg_value = sum(array) / real(alldim_size)
2849 
2850  !-------------------------------------------------------------------
2851  ! 標準偏差
2852  ! Standard deviation
2853  !-------------------------------------------------------------------
2854  sd_value = 0.0
2855  variance_value = 0.0
2856  sd_str = ''
2857  if ( present_and_true( sd ) ) then
2858  if ( alldim_size > 1 ) then
2859  if (allocated(array_packed)) then
2860  deallocate(array_packed)
2861  end if
2862  allocate( array_packed(alldim_size) )
2863 
2864  array_packed = pack(array, .true.)
2865 
2866 
2867  do i = 1, alldim_size
2868  variance_value = variance_value + &
2869  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
2870  end do
2871  variance_value = variance_value / real(alldim_size)
2872  sd_value = sqrt( variance_value )
2873  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
2874  end if
2875  end if
2876 
2877  !-------------------------------------------------------------------
2878  ! 印字
2879  ! Print
2880  !-------------------------------------------------------------------
2881  call printf(out_unit, &
2882  & indent_str(1:indent_len) // &
2883  & '#<DP-ARRAY:: @size=%c, @max=%f, @min=%f, @avg=%r%c>', &
2884  & d = (/max_value, min_value/), r = (/avg_value/), &
2885 
2886 
2887  & c1 = trim(size_str), c2 = trim(sd_str) )
2888 
2889 end subroutine putlinedouble6
2890 
2891 
2892 subroutine putlinedouble7( array, lbounds, ubounds, unit, indent, sd )
2893 
2894 
2895  use dc_types, only: dp, string, stdout
2896  use dc_string, only: tochar
2897  use dc_string, only: printf, cprintf
2898  use dc_present, only: present_and_true
2899  implicit none
2900  real(DP), intent(in):: array(:,:,:,:,:,:,:)
2901  integer, intent(in), optional:: lbounds(7)
2902  integer, intent(in), optional:: ubounds(7)
2903  integer, intent(in), optional:: unit
2904  character(*), intent(in), optional:: indent
2905  logical, intent(in), optional:: sd
2906  integer:: out_unit
2907  integer:: indent_len
2908  character(STRING):: indent_str
2909  integer:: i
2910  integer:: alldim_size, lbound_nums(7), ubound_nums(7)
2911  character(STRING):: size_str, sd_str
2912  real(DP):: max_value, min_value
2913  real(DP), allocatable:: array_packed(:)
2914  real:: avg_value, variance_value, sd_value
2915 continue
2916 
2917  !-----------------------------------------------------------------
2918  ! オプショナル引数のチェック
2919  ! Check optional arguments
2920  !-----------------------------------------------------------------
2921  if ( present(unit) ) then
2922  out_unit = unit
2923  else
2924  out_unit = stdout
2925  end if
2926 
2927  indent_len = 0
2928  indent_str = ''
2929  if ( present(indent) ) then
2930  if (len(indent) /= 0) then
2931  indent_len = len(indent)
2932  indent_str(1:indent_len) = indent
2933  end if
2934  end if
2935 
2936  !-------------------------------------------------------------------
2937  ! 配列サイズ
2938  ! Array size
2939  !-------------------------------------------------------------------
2940 
2941  if ( present(lbounds) .and. present(ubounds) ) then
2942  lbound_nums = lbounds
2943  ubound_nums = ubounds
2944  else
2945  lbound_nums(1) = lbound( array, 1 )
2946  ubound_nums(1) = ubound( array, 1 )
2947 
2948  lbound_nums(2) = lbound( array, 2 )
2949  ubound_nums(2) = ubound( array, 2 )
2950 
2951  lbound_nums(3) = lbound( array, 3 )
2952  ubound_nums(3) = ubound( array, 3 )
2953 
2954  lbound_nums(4) = lbound( array, 4 )
2955  ubound_nums(4) = ubound( array, 4 )
2956 
2957  lbound_nums(5) = lbound( array, 5 )
2958  ubound_nums(5) = ubound( array, 5 )
2959 
2960  lbound_nums(6) = lbound( array, 6 )
2961  ubound_nums(6) = ubound( array, 6 )
2962 
2963  lbound_nums(7) = lbound( array, 7 )
2964  ubound_nums(7) = ubound( array, 7 )
2965 
2966  end if
2967 
2968  size_str = '('
2969  size_str = trim(size_str) // trim(tochar(lbound_nums(1))) // ':'
2970  size_str = trim(size_str) // trim(tochar(ubound_nums(1)))
2971  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(2)))
2972  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(2)))
2973 
2974  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(3)))
2975  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(3)))
2976 
2977  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(4)))
2978  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(4)))
2979 
2980  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(5)))
2981  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(5)))
2982 
2983  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(6)))
2984  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(6)))
2985 
2986  size_str = trim(size_str) // ',' // trim(tochar(lbound_nums(7)))
2987  size_str = trim(size_str) // ':' // trim(tochar(ubound_nums(7)))
2988 
2989  size_str = trim(size_str) // ')'
2990 
2991  !-------------------------------------------------------------------
2992  ! 最大値
2993  ! Maximum value
2994  !-------------------------------------------------------------------
2995  max_value = maxval(array)
2996 
2997  !-------------------------------------------------------------------
2998  ! 最小値
2999  ! Minimum value
3000  !-------------------------------------------------------------------
3001  min_value = minval(array)
3002 
3003  !-------------------------------------------------------------------
3004  ! 平均値
3005  ! Average value
3006  !-------------------------------------------------------------------
3007  alldim_size = size(array)
3008  avg_value = sum(array) / real(alldim_size)
3009 
3010  !-------------------------------------------------------------------
3011  ! 標準偏差
3012  ! Standard deviation
3013  !-------------------------------------------------------------------
3014  sd_value = 0.0
3015  variance_value = 0.0
3016  sd_str = ''
3017  if ( present_and_true( sd ) ) then
3018  if ( alldim_size > 1 ) then
3019  if (allocated(array_packed)) then
3020  deallocate(array_packed)
3021  end if
3022  allocate( array_packed(alldim_size) )
3023 
3024  array_packed = pack(array, .true.)
3025 
3026 
3027  do i = 1, alldim_size
3028  variance_value = variance_value + &
3029  & (array_packed(i) - avg_value) * (array_packed(i) - avg_value)
3030  end do
3031  variance_value = variance_value / real(alldim_size)
3032  sd_value = sqrt( variance_value )
3033  sd_str = cprintf( ' @sd=%r', r = (/ sd_value /) )
3034  end if
3035  end if
3036 
3037  !-------------------------------------------------------------------
3038  ! 印字
3039  ! Print
3040  !-------------------------------------------------------------------
3041  call printf(out_unit, &
3042  & indent_str(1:indent_len) // &
3043  & '#<DP-ARRAY:: @size=%c, @max=%f, @min=%f, @avg=%r%c>', &
3044  & d = (/max_value, min_value/), r = (/avg_value/), &
3045 
3046 
3047  & c1 = trim(size_str), c2 = trim(sd_str) )
3048 
3049 end subroutine putlinedouble7
3050 
3051 !--
3052 ! vi:set readonly sw=4 ts=8:
3053 !
3054 !Local Variables:
3055 !mode: f90
3056 !buffer-read-only: t
3057 !End:
3058 !
3059 !++
putlinereal3
subroutine putlinereal3(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:1317
dc_string::tochar
Definition: dc_string.f90:73
putlinedouble2
subroutine putlinedouble2(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:2183
dc_present::present_and_true
logical function, public present_and_true(arg)
Definition: dc_present.f90:80
putlinereal1
subroutine putlinereal1(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:1061
putlinereal5
subroutine putlinereal5(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:1595
putlinereal2
subroutine putlinereal2(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:1187
putlineint4
subroutine putlineint4(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:457
putlineint3
subroutine putlineint3(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:321
dc_present
Definition: dc_present.f90:26
dc_string::cprintf
Definition: dc_string.f90:172
dc_string::printf
Definition: dc_string.f90:186
putlineint7
subroutine putlineint7(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:901
dc_types::dp
integer, parameter, public dp
倍精度実数型変数
Definition: dc_types.f90:83
putlinereal4
subroutine putlinereal4(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:1453
dc_types::stdout
integer, parameter, public stdout
標準出力の装置番号
Definition: dc_types.f90:98
dc_string
文字型変数の操作.
Definition: dc_string.f90:24
dc_types
種別型パラメタを提供します。
Definition: dc_types.f90:49
putlinedouble1
subroutine putlinedouble1(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:2057
putlinedouble3
subroutine putlinedouble3(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:2313
putlinedouble5
subroutine putlinedouble5(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:2591
putlinedouble4
subroutine putlinedouble4(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:2449
putlineint6
subroutine putlineint6(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:747
putlinereal6
subroutine putlinereal6(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:1743
putlineint1
subroutine putlineint1(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:19
putlineint5
subroutine putlineint5(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:599
putlineint2
subroutine putlineint2(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:191
putlinereal7
subroutine putlinereal7(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:1897
putlinedouble7
subroutine putlinedouble7(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:2893
putlinedouble6
subroutine putlinedouble6(array, lbounds, ubounds, unit, indent, sd)
Definition: dcstringputline.f90:2739
dc_types::string
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118