Private Member Functions
gtool_historyauto_internal::averagereduce Interface Reference

Private Member Functions

subroutine averagereducereal1 (array, space_average, weight1, array_avr)
 
subroutine averagereducereal2 (array, space_average, weight1, weight2, array_avr)
 
subroutine averagereducereal3 (array, space_average, weight1, weight2, weight3, array_avr)
 
subroutine averagereducereal4 (array, space_average, weight1, weight2, weight3, weight4, array_avr)
 
subroutine averagereducereal5 (array, space_average, weight1, weight2, weight3, weight4, weight5, array_avr)
 
subroutine averagereducereal6 (array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, array_avr)
 
subroutine averagereducereal7 (array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, weight7, array_avr)
 
subroutine averagereducedouble1 (array, space_average, weight1, array_avr)
 
subroutine averagereducedouble2 (array, space_average, weight1, weight2, array_avr)
 
subroutine averagereducedouble3 (array, space_average, weight1, weight2, weight3, array_avr)
 
subroutine averagereducedouble4 (array, space_average, weight1, weight2, weight3, weight4, array_avr)
 
subroutine averagereducedouble5 (array, space_average, weight1, weight2, weight3, weight4, weight5, array_avr)
 
subroutine averagereducedouble6 (array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, array_avr)
 
subroutine averagereducedouble7 (array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, weight7, array_avr)
 
subroutine averagereduceint1 (array, space_average, weight1, array_avr)
 
subroutine averagereduceint2 (array, space_average, weight1, weight2, array_avr)
 
subroutine averagereduceint3 (array, space_average, weight1, weight2, weight3, array_avr)
 
subroutine averagereduceint4 (array, space_average, weight1, weight2, weight3, weight4, array_avr)
 
subroutine averagereduceint5 (array, space_average, weight1, weight2, weight3, weight4, weight5, array_avr)
 
subroutine averagereduceint6 (array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, array_avr)
 
subroutine averagereduceint7 (array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, weight7, array_avr)
 

Detailed Description

Definition at line 349 of file gtool_historyauto_internal.f90.

Member Function/Subroutine Documentation

◆ averagereducedouble1()

subroutine gtool_historyauto_internal::averagereduce::averagereducedouble1 ( real(dp), dimension(:), intent(in), target  array,
logical, dimension(1), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), pointer  array_avr 
)
private

Definition at line 2384 of file gtool_historyauto_internal.f90.

2384  !
2385  ! space_average で .true. に指定された次元に対して,
2386  ! array を平均化して array_avr に返します.
2387  ! 平均化には重み weight1 〜 weight7 が用いられます.
2388  ! array_avr の配列の次元そのものは減りません. その代わり,
2389  ! 平均化された次元の配列のサイズは 1 になります.
2390  !
2391  implicit none
2392  real(DP), intent(in), target:: array(:)
2393  logical, intent(in):: space_average(1)
2394  real(DP), intent(in):: weight1(:)
2395 
2396  real(DP), pointer:: array_avr(:) ! (out)
2397 
2398  real(DP), pointer:: array_avr_work(:)
2399 
2400  real(DP), pointer:: array_avr_work1(:)
2401 
2402 
2403  integer:: array_shape(1)
2404  integer:: i, dim_size
2405  real(DP):: weight_sum
2406  continue
2407 
2408  array_shape = shape( array )
2409  array_avr_work => array
2410 
2411 
2412 
2413 
2414  if ( space_average(1) ) then
2415  dim_size = array_shape(1)
2416  array_shape(1) = 1
2417  allocate( array_avr_work1( array_shape(1) &
2418 
2419  & ) )
2420  array_avr_work1 = 0.0_dp
2421  weight_sum = 0.0_dp
2422  do i = 1, dim_size
2423  array_avr_work1(1) = array_avr_work1(1) + array_avr_work(i) * weight1(i)
2424  weight_sum = weight_sum + weight1(i)
2425  end do
2426  array_avr_work1 = array_avr_work1 / weight_sum
2427  array_avr_work => array_avr_work1
2428  end if
2429 
2430 
2431 
2432 
2433 
2434 
2435 
2436  allocate( array_avr( array_shape(1) &
2437 
2438  & ) )
2439 
2440  array_avr = array_avr_work
2441 
2442  nullify( array_avr_work )
2443 
2444  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
2445 
2446 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereducedouble2()

subroutine gtool_historyauto_internal::averagereduce::averagereducedouble2 ( real(dp), dimension(:,:), intent(in), target  array,
logical, dimension(2), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), intent(in)  weight2,
real(dp), dimension(:,:), pointer  array_avr 
)
private

Definition at line 2458 of file gtool_historyauto_internal.f90.

2458  !
2459  ! space_average で .true. に指定された次元に対して,
2460  ! array を平均化して array_avr に返します.
2461  ! 平均化には重み weight1 〜 weight7 が用いられます.
2462  ! array_avr の配列の次元そのものは減りません. その代わり,
2463  ! 平均化された次元の配列のサイズは 1 になります.
2464  !
2465  implicit none
2466  real(DP), intent(in), target:: array(:,:)
2467  logical, intent(in):: space_average(2)
2468  real(DP), intent(in):: weight1(:)
2469 
2470  real(DP), intent(in):: weight2(:)
2471 
2472  real(DP), pointer:: array_avr(:,:) ! (out)
2473 
2474  real(DP), pointer:: array_avr_work(:,:)
2475 
2476  real(DP), pointer:: array_avr_work1(:,:)
2477 
2478  real(DP), pointer:: array_avr_work2(:,:)
2479 
2480 
2481  integer:: array_shape(2)
2482  integer:: i, dim_size
2483  real(DP):: weight_sum
2484  continue
2485 
2486  array_shape = shape( array )
2487  array_avr_work => array
2488 
2489 
2490 
2491 
2492  if ( space_average(1) ) then
2493  dim_size = array_shape(1)
2494  array_shape(1) = 1
2495  allocate( array_avr_work1( array_shape(1) &
2496  & , array_shape(2) &
2497 
2498  & ) )
2499  array_avr_work1 = 0.0_dp
2500  weight_sum = 0.0_dp
2501  do i = 1, dim_size
2502  array_avr_work1(1,:) = array_avr_work1(1,:) + array_avr_work(i,:) * weight1(i)
2503  weight_sum = weight_sum + weight1(i)
2504  end do
2505  array_avr_work1 = array_avr_work1 / weight_sum
2506  array_avr_work => array_avr_work1
2507  end if
2508 
2509 
2510 
2511  if ( space_average(2) ) then
2512  dim_size = array_shape(2)
2513  array_shape(2) = 1
2514  allocate( array_avr_work2( array_shape(1) &
2515  & , array_shape(2) &
2516 
2517  & ) )
2518  array_avr_work2 = 0.0_dp
2519  weight_sum = 0.0_dp
2520  do i = 1, dim_size
2521  array_avr_work2(:,1) = array_avr_work2(:,1) + array_avr_work(:,i) * weight2(i)
2522  weight_sum = weight_sum + weight2(i)
2523  end do
2524  array_avr_work2 = array_avr_work2 / weight_sum
2525  array_avr_work => array_avr_work2
2526  end if
2527 
2528 
2529 
2530 
2531 
2532 
2533 
2534  allocate( array_avr( array_shape(1) &
2535  & , array_shape(2) &
2536 
2537  & ) )
2538 
2539  array_avr = array_avr_work
2540 
2541  nullify( array_avr_work )
2542 
2543  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
2544 
2545  if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
2546 
2547 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereducedouble3()

subroutine gtool_historyauto_internal::averagereduce::averagereducedouble3 ( real(dp), dimension(:,:,:), intent(in), target  array,
logical, dimension(3), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), intent(in)  weight2,
real(dp), dimension(:), intent(in)  weight3,
real(dp), dimension(:,:,:), pointer  array_avr 
)
private

Definition at line 2561 of file gtool_historyauto_internal.f90.

2561  !
2562  ! space_average で .true. に指定された次元に対して,
2563  ! array を平均化して array_avr に返します.
2564  ! 平均化には重み weight1 〜 weight7 が用いられます.
2565  ! array_avr の配列の次元そのものは減りません. その代わり,
2566  ! 平均化された次元の配列のサイズは 1 になります.
2567  !
2568  implicit none
2569  real(DP), intent(in), target:: array(:,:,:)
2570  logical, intent(in):: space_average(3)
2571  real(DP), intent(in):: weight1(:)
2572 
2573  real(DP), intent(in):: weight2(:)
2574 
2575  real(DP), intent(in):: weight3(:)
2576 
2577  real(DP), pointer:: array_avr(:,:,:) ! (out)
2578 
2579  real(DP), pointer:: array_avr_work(:,:,:)
2580 
2581  real(DP), pointer:: array_avr_work1(:,:,:)
2582 
2583  real(DP), pointer:: array_avr_work2(:,:,:)
2584 
2585  real(DP), pointer:: array_avr_work3(:,:,:)
2586 
2587 
2588  integer:: array_shape(3)
2589  integer:: i, dim_size
2590  real(DP):: weight_sum
2591  continue
2592 
2593  array_shape = shape( array )
2594  array_avr_work => array
2595 
2596 
2597 
2598 
2599  if ( space_average(1) ) then
2600  dim_size = array_shape(1)
2601  array_shape(1) = 1
2602  allocate( array_avr_work1( array_shape(1) &
2603  & , array_shape(2) &
2604 
2605  & , array_shape(3) &
2606 
2607  & ) )
2608  array_avr_work1 = 0.0_dp
2609  weight_sum = 0.0_dp
2610  do i = 1, dim_size
2611  array_avr_work1(1,:,:) = array_avr_work1(1,:,:) + array_avr_work(i,:,:) * weight1(i)
2612  weight_sum = weight_sum + weight1(i)
2613  end do
2614  array_avr_work1 = array_avr_work1 / weight_sum
2615  array_avr_work => array_avr_work1
2616  end if
2617 
2618 
2619 
2620  if ( space_average(2) ) then
2621  dim_size = array_shape(2)
2622  array_shape(2) = 1
2623  allocate( array_avr_work2( array_shape(1) &
2624  & , array_shape(2) &
2625 
2626  & , array_shape(3) &
2627 
2628  & ) )
2629  array_avr_work2 = 0.0_dp
2630  weight_sum = 0.0_dp
2631  do i = 1, dim_size
2632  array_avr_work2(:,1,:) = array_avr_work2(:,1,:) + array_avr_work(:,i,:) * weight2(i)
2633  weight_sum = weight_sum + weight2(i)
2634  end do
2635  array_avr_work2 = array_avr_work2 / weight_sum
2636  array_avr_work => array_avr_work2
2637  end if
2638 
2639 
2640 
2641  if ( space_average(3) ) then
2642  dim_size = array_shape(3)
2643  array_shape(3) = 1
2644  allocate( array_avr_work3( array_shape(1) &
2645  & , array_shape(2) &
2646 
2647  & , array_shape(3) &
2648 
2649  & ) )
2650  array_avr_work3 = 0.0_dp
2651  weight_sum = 0.0_dp
2652  do i = 1, dim_size
2653  array_avr_work3(:,:,1) = array_avr_work3(:,:,1) + array_avr_work(:,:,i) * weight3(i)
2654  weight_sum = weight_sum + weight3(i)
2655  end do
2656  array_avr_work3 = array_avr_work3 / weight_sum
2657  array_avr_work => array_avr_work3
2658  end if
2659 
2660 
2661 
2662 
2663 
2664 
2665 
2666  allocate( array_avr( array_shape(1) &
2667  & , array_shape(2) &
2668 
2669  & , array_shape(3) &
2670 
2671  & ) )
2672 
2673  array_avr = array_avr_work
2674 
2675  nullify( array_avr_work )
2676 
2677  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
2678 
2679  if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
2680 
2681  if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
2682 
2683 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereducedouble4()

subroutine gtool_historyauto_internal::averagereduce::averagereducedouble4 ( real(dp), dimension(:,:,:,:), intent(in), target  array,
logical, dimension(4), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), intent(in)  weight2,
real(dp), dimension(:), intent(in)  weight3,
real(dp), dimension(:), intent(in)  weight4,
real(dp), dimension(:,:,:,:), pointer  array_avr 
)
private

Definition at line 2699 of file gtool_historyauto_internal.f90.

2699  !
2700  ! space_average で .true. に指定された次元に対して,
2701  ! array を平均化して array_avr に返します.
2702  ! 平均化には重み weight1 〜 weight7 が用いられます.
2703  ! array_avr の配列の次元そのものは減りません. その代わり,
2704  ! 平均化された次元の配列のサイズは 1 になります.
2705  !
2706  implicit none
2707  real(DP), intent(in), target:: array(:,:,:,:)
2708  logical, intent(in):: space_average(4)
2709  real(DP), intent(in):: weight1(:)
2710 
2711  real(DP), intent(in):: weight2(:)
2712 
2713  real(DP), intent(in):: weight3(:)
2714 
2715  real(DP), intent(in):: weight4(:)
2716 
2717  real(DP), pointer:: array_avr(:,:,:,:) ! (out)
2718 
2719  real(DP), pointer:: array_avr_work(:,:,:,:)
2720 
2721  real(DP), pointer:: array_avr_work1(:,:,:,:)
2722 
2723  real(DP), pointer:: array_avr_work2(:,:,:,:)
2724 
2725  real(DP), pointer:: array_avr_work3(:,:,:,:)
2726 
2727  real(DP), pointer:: array_avr_work4(:,:,:,:)
2728 
2729 
2730  integer:: array_shape(4)
2731  integer:: i, dim_size
2732  real(DP):: weight_sum
2733  continue
2734 
2735  array_shape = shape( array )
2736  array_avr_work => array
2737 
2738 
2739 
2740 
2741  if ( space_average(1) ) then
2742  dim_size = array_shape(1)
2743  array_shape(1) = 1
2744  allocate( array_avr_work1( array_shape(1) &
2745  & , array_shape(2) &
2746 
2747  & , array_shape(3) &
2748 
2749  & , array_shape(4) &
2750 
2751  & ) )
2752  array_avr_work1 = 0.0_dp
2753  weight_sum = 0.0_dp
2754  do i = 1, dim_size
2755  array_avr_work1(1,:,:,:) = array_avr_work1(1,:,:,:) + array_avr_work(i,:,:,:) * weight1(i)
2756  weight_sum = weight_sum + weight1(i)
2757  end do
2758  array_avr_work1 = array_avr_work1 / weight_sum
2759  array_avr_work => array_avr_work1
2760  end if
2761 
2762 
2763 
2764  if ( space_average(2) ) then
2765  dim_size = array_shape(2)
2766  array_shape(2) = 1
2767  allocate( array_avr_work2( array_shape(1) &
2768  & , array_shape(2) &
2769 
2770  & , array_shape(3) &
2771 
2772  & , array_shape(4) &
2773 
2774  & ) )
2775  array_avr_work2 = 0.0_dp
2776  weight_sum = 0.0_dp
2777  do i = 1, dim_size
2778  array_avr_work2(:,1,:,:) = array_avr_work2(:,1,:,:) + array_avr_work(:,i,:,:) * weight2(i)
2779  weight_sum = weight_sum + weight2(i)
2780  end do
2781  array_avr_work2 = array_avr_work2 / weight_sum
2782  array_avr_work => array_avr_work2
2783  end if
2784 
2785 
2786 
2787  if ( space_average(3) ) then
2788  dim_size = array_shape(3)
2789  array_shape(3) = 1
2790  allocate( array_avr_work3( array_shape(1) &
2791  & , array_shape(2) &
2792 
2793  & , array_shape(3) &
2794 
2795  & , array_shape(4) &
2796 
2797  & ) )
2798  array_avr_work3 = 0.0_dp
2799  weight_sum = 0.0_dp
2800  do i = 1, dim_size
2801  array_avr_work3(:,:,1,:) = array_avr_work3(:,:,1,:) + array_avr_work(:,:,i,:) * weight3(i)
2802  weight_sum = weight_sum + weight3(i)
2803  end do
2804  array_avr_work3 = array_avr_work3 / weight_sum
2805  array_avr_work => array_avr_work3
2806  end if
2807 
2808 
2809 
2810  if ( space_average(4) ) then
2811  dim_size = array_shape(4)
2812  array_shape(4) = 1
2813  allocate( array_avr_work4( array_shape(1) &
2814  & , array_shape(2) &
2815 
2816  & , array_shape(3) &
2817 
2818  & , array_shape(4) &
2819 
2820  & ) )
2821  array_avr_work4 = 0.0_dp
2822  weight_sum = 0.0_dp
2823  do i = 1, dim_size
2824  array_avr_work4(:,:,:,1) = array_avr_work4(:,:,:,1) + array_avr_work(:,:,:,i) * weight4(i)
2825  weight_sum = weight_sum + weight4(i)
2826  end do
2827  array_avr_work4 = array_avr_work4 / weight_sum
2828  array_avr_work => array_avr_work4
2829  end if
2830 
2831 
2832 
2833 
2834 
2835 
2836 
2837  allocate( array_avr( array_shape(1) &
2838  & , array_shape(2) &
2839 
2840  & , array_shape(3) &
2841 
2842  & , array_shape(4) &
2843 
2844  & ) )
2845 
2846  array_avr = array_avr_work
2847 
2848  nullify( array_avr_work )
2849 
2850  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
2851 
2852  if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
2853 
2854  if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
2855 
2856  if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
2857 
2858 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereducedouble5()

subroutine gtool_historyauto_internal::averagereduce::averagereducedouble5 ( real(dp), dimension(:,:,:,:,:), intent(in), target  array,
logical, dimension(5), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), intent(in)  weight2,
real(dp), dimension(:), intent(in)  weight3,
real(dp), dimension(:), intent(in)  weight4,
real(dp), dimension(:), intent(in)  weight5,
real(dp), dimension(:,:,:,:,:), pointer  array_avr 
)
private

Definition at line 2876 of file gtool_historyauto_internal.f90.

2876  !
2877  ! space_average で .true. に指定された次元に対して,
2878  ! array を平均化して array_avr に返します.
2879  ! 平均化には重み weight1 〜 weight7 が用いられます.
2880  ! array_avr の配列の次元そのものは減りません. その代わり,
2881  ! 平均化された次元の配列のサイズは 1 になります.
2882  !
2883  implicit none
2884  real(DP), intent(in), target:: array(:,:,:,:,:)
2885  logical, intent(in):: space_average(5)
2886  real(DP), intent(in):: weight1(:)
2887 
2888  real(DP), intent(in):: weight2(:)
2889 
2890  real(DP), intent(in):: weight3(:)
2891 
2892  real(DP), intent(in):: weight4(:)
2893 
2894  real(DP), intent(in):: weight5(:)
2895 
2896  real(DP), pointer:: array_avr(:,:,:,:,:) ! (out)
2897 
2898  real(DP), pointer:: array_avr_work(:,:,:,:,:)
2899 
2900  real(DP), pointer:: array_avr_work1(:,:,:,:,:)
2901 
2902  real(DP), pointer:: array_avr_work2(:,:,:,:,:)
2903 
2904  real(DP), pointer:: array_avr_work3(:,:,:,:,:)
2905 
2906  real(DP), pointer:: array_avr_work4(:,:,:,:,:)
2907 
2908  real(DP), pointer:: array_avr_work5(:,:,:,:,:)
2909 
2910 
2911  integer:: array_shape(5)
2912  integer:: i, dim_size
2913  real(DP):: weight_sum
2914  continue
2915 
2916  array_shape = shape( array )
2917  array_avr_work => array
2918 
2919 
2920 
2921 
2922  if ( space_average(1) ) then
2923  dim_size = array_shape(1)
2924  array_shape(1) = 1
2925  allocate( array_avr_work1( array_shape(1) &
2926  & , array_shape(2) &
2927 
2928  & , array_shape(3) &
2929 
2930  & , array_shape(4) &
2931 
2932  & , array_shape(5) &
2933 
2934  & ) )
2935  array_avr_work1 = 0.0_dp
2936  weight_sum = 0.0_dp
2937  do i = 1, dim_size
2938  array_avr_work1(1,:,:,:,:) = array_avr_work1(1,:,:,:,:) + array_avr_work(i,:,:,:,:) * weight1(i)
2939  weight_sum = weight_sum + weight1(i)
2940  end do
2941  array_avr_work1 = array_avr_work1 / weight_sum
2942  array_avr_work => array_avr_work1
2943  end if
2944 
2945 
2946 
2947  if ( space_average(2) ) then
2948  dim_size = array_shape(2)
2949  array_shape(2) = 1
2950  allocate( array_avr_work2( array_shape(1) &
2951  & , array_shape(2) &
2952 
2953  & , array_shape(3) &
2954 
2955  & , array_shape(4) &
2956 
2957  & , array_shape(5) &
2958 
2959  & ) )
2960  array_avr_work2 = 0.0_dp
2961  weight_sum = 0.0_dp
2962  do i = 1, dim_size
2963  array_avr_work2(:,1,:,:,:) = array_avr_work2(:,1,:,:,:) + array_avr_work(:,i,:,:,:) * weight2(i)
2964  weight_sum = weight_sum + weight2(i)
2965  end do
2966  array_avr_work2 = array_avr_work2 / weight_sum
2967  array_avr_work => array_avr_work2
2968  end if
2969 
2970 
2971 
2972  if ( space_average(3) ) then
2973  dim_size = array_shape(3)
2974  array_shape(3) = 1
2975  allocate( array_avr_work3( array_shape(1) &
2976  & , array_shape(2) &
2977 
2978  & , array_shape(3) &
2979 
2980  & , array_shape(4) &
2981 
2982  & , array_shape(5) &
2983 
2984  & ) )
2985  array_avr_work3 = 0.0_dp
2986  weight_sum = 0.0_dp
2987  do i = 1, dim_size
2988  array_avr_work3(:,:,1,:,:) = array_avr_work3(:,:,1,:,:) + array_avr_work(:,:,i,:,:) * weight3(i)
2989  weight_sum = weight_sum + weight3(i)
2990  end do
2991  array_avr_work3 = array_avr_work3 / weight_sum
2992  array_avr_work => array_avr_work3
2993  end if
2994 
2995 
2996 
2997  if ( space_average(4) ) then
2998  dim_size = array_shape(4)
2999  array_shape(4) = 1
3000  allocate( array_avr_work4( array_shape(1) &
3001  & , array_shape(2) &
3002 
3003  & , array_shape(3) &
3004 
3005  & , array_shape(4) &
3006 
3007  & , array_shape(5) &
3008 
3009  & ) )
3010  array_avr_work4 = 0.0_dp
3011  weight_sum = 0.0_dp
3012  do i = 1, dim_size
3013  array_avr_work4(:,:,:,1,:) = array_avr_work4(:,:,:,1,:) + array_avr_work(:,:,:,i,:) * weight4(i)
3014  weight_sum = weight_sum + weight4(i)
3015  end do
3016  array_avr_work4 = array_avr_work4 / weight_sum
3017  array_avr_work => array_avr_work4
3018  end if
3019 
3020 
3021 
3022  if ( space_average(5) ) then
3023  dim_size = array_shape(5)
3024  array_shape(5) = 1
3025  allocate( array_avr_work5( array_shape(1) &
3026  & , array_shape(2) &
3027 
3028  & , array_shape(3) &
3029 
3030  & , array_shape(4) &
3031 
3032  & , array_shape(5) &
3033 
3034  & ) )
3035  array_avr_work5 = 0.0_dp
3036  weight_sum = 0.0_dp
3037  do i = 1, dim_size
3038  array_avr_work5(:,:,:,:,1) = array_avr_work5(:,:,:,:,1) + array_avr_work(:,:,:,:,i) * weight5(i)
3039  weight_sum = weight_sum + weight5(i)
3040  end do
3041  array_avr_work5 = array_avr_work5 / weight_sum
3042  array_avr_work => array_avr_work5
3043  end if
3044 
3045 
3046 
3047 
3048 
3049 
3050 
3051  allocate( array_avr( array_shape(1) &
3052  & , array_shape(2) &
3053 
3054  & , array_shape(3) &
3055 
3056  & , array_shape(4) &
3057 
3058  & , array_shape(5) &
3059 
3060  & ) )
3061 
3062  array_avr = array_avr_work
3063 
3064  nullify( array_avr_work )
3065 
3066  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
3067 
3068  if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
3069 
3070  if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
3071 
3072  if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
3073 
3074  if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 )
3075 
3076 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereducedouble6()

subroutine gtool_historyauto_internal::averagereduce::averagereducedouble6 ( real(dp), dimension(:,:,:,:,:,:), intent(in), target  array,
logical, dimension(6), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), intent(in)  weight2,
real(dp), dimension(:), intent(in)  weight3,
real(dp), dimension(:), intent(in)  weight4,
real(dp), dimension(:), intent(in)  weight5,
real(dp), dimension(:), intent(in)  weight6,
real(dp), dimension(:,:,:,:,:,:), pointer  array_avr 
)
private

Definition at line 3096 of file gtool_historyauto_internal.f90.

3096  !
3097  ! space_average で .true. に指定された次元に対して,
3098  ! array を平均化して array_avr に返します.
3099  ! 平均化には重み weight1 〜 weight7 が用いられます.
3100  ! array_avr の配列の次元そのものは減りません. その代わり,
3101  ! 平均化された次元の配列のサイズは 1 になります.
3102  !
3103  implicit none
3104  real(DP), intent(in), target:: array(:,:,:,:,:,:)
3105  logical, intent(in):: space_average(6)
3106  real(DP), intent(in):: weight1(:)
3107 
3108  real(DP), intent(in):: weight2(:)
3109 
3110  real(DP), intent(in):: weight3(:)
3111 
3112  real(DP), intent(in):: weight4(:)
3113 
3114  real(DP), intent(in):: weight5(:)
3115 
3116  real(DP), intent(in):: weight6(:)
3117 
3118  real(DP), pointer:: array_avr(:,:,:,:,:,:) ! (out)
3119 
3120  real(DP), pointer:: array_avr_work(:,:,:,:,:,:)
3121 
3122  real(DP), pointer:: array_avr_work1(:,:,:,:,:,:)
3123 
3124  real(DP), pointer:: array_avr_work2(:,:,:,:,:,:)
3125 
3126  real(DP), pointer:: array_avr_work3(:,:,:,:,:,:)
3127 
3128  real(DP), pointer:: array_avr_work4(:,:,:,:,:,:)
3129 
3130  real(DP), pointer:: array_avr_work5(:,:,:,:,:,:)
3131 
3132  real(DP), pointer:: array_avr_work6(:,:,:,:,:,:)
3133 
3134 
3135  integer:: array_shape(6)
3136  integer:: i, dim_size
3137  real(DP):: weight_sum
3138  continue
3139 
3140  array_shape = shape( array )
3141  array_avr_work => array
3142 
3143 
3144 
3145 
3146  if ( space_average(1) ) then
3147  dim_size = array_shape(1)
3148  array_shape(1) = 1
3149  allocate( array_avr_work1( array_shape(1) &
3150  & , array_shape(2) &
3151 
3152  & , array_shape(3) &
3153 
3154  & , array_shape(4) &
3155 
3156  & , array_shape(5) &
3157 
3158  & , array_shape(6) &
3159 
3160  & ) )
3161  array_avr_work1 = 0.0_dp
3162  weight_sum = 0.0_dp
3163  do i = 1, dim_size
3164  array_avr_work1(1,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:) * weight1(i)
3165  weight_sum = weight_sum + weight1(i)
3166  end do
3167  array_avr_work1 = array_avr_work1 / weight_sum
3168  array_avr_work => array_avr_work1
3169  end if
3170 
3171 
3172 
3173  if ( space_average(2) ) then
3174  dim_size = array_shape(2)
3175  array_shape(2) = 1
3176  allocate( array_avr_work2( array_shape(1) &
3177  & , array_shape(2) &
3178 
3179  & , array_shape(3) &
3180 
3181  & , array_shape(4) &
3182 
3183  & , array_shape(5) &
3184 
3185  & , array_shape(6) &
3186 
3187  & ) )
3188  array_avr_work2 = 0.0_dp
3189  weight_sum = 0.0_dp
3190  do i = 1, dim_size
3191  array_avr_work2(:,1,:,:,:,:) = array_avr_work2(:,1,:,:,:,:) + array_avr_work(:,i,:,:,:,:) * weight2(i)
3192  weight_sum = weight_sum + weight2(i)
3193  end do
3194  array_avr_work2 = array_avr_work2 / weight_sum
3195  array_avr_work => array_avr_work2
3196  end if
3197 
3198 
3199 
3200  if ( space_average(3) ) then
3201  dim_size = array_shape(3)
3202  array_shape(3) = 1
3203  allocate( array_avr_work3( array_shape(1) &
3204  & , array_shape(2) &
3205 
3206  & , array_shape(3) &
3207 
3208  & , array_shape(4) &
3209 
3210  & , array_shape(5) &
3211 
3212  & , array_shape(6) &
3213 
3214  & ) )
3215  array_avr_work3 = 0.0_dp
3216  weight_sum = 0.0_dp
3217  do i = 1, dim_size
3218  array_avr_work3(:,:,1,:,:,:) = array_avr_work3(:,:,1,:,:,:) + array_avr_work(:,:,i,:,:,:) * weight3(i)
3219  weight_sum = weight_sum + weight3(i)
3220  end do
3221  array_avr_work3 = array_avr_work3 / weight_sum
3222  array_avr_work => array_avr_work3
3223  end if
3224 
3225 
3226 
3227  if ( space_average(4) ) then
3228  dim_size = array_shape(4)
3229  array_shape(4) = 1
3230  allocate( array_avr_work4( array_shape(1) &
3231  & , array_shape(2) &
3232 
3233  & , array_shape(3) &
3234 
3235  & , array_shape(4) &
3236 
3237  & , array_shape(5) &
3238 
3239  & , array_shape(6) &
3240 
3241  & ) )
3242  array_avr_work4 = 0.0_dp
3243  weight_sum = 0.0_dp
3244  do i = 1, dim_size
3245  array_avr_work4(:,:,:,1,:,:) = array_avr_work4(:,:,:,1,:,:) + array_avr_work(:,:,:,i,:,:) * weight4(i)
3246  weight_sum = weight_sum + weight4(i)
3247  end do
3248  array_avr_work4 = array_avr_work4 / weight_sum
3249  array_avr_work => array_avr_work4
3250  end if
3251 
3252 
3253 
3254  if ( space_average(5) ) then
3255  dim_size = array_shape(5)
3256  array_shape(5) = 1
3257  allocate( array_avr_work5( array_shape(1) &
3258  & , array_shape(2) &
3259 
3260  & , array_shape(3) &
3261 
3262  & , array_shape(4) &
3263 
3264  & , array_shape(5) &
3265 
3266  & , array_shape(6) &
3267 
3268  & ) )
3269  array_avr_work5 = 0.0_dp
3270  weight_sum = 0.0_dp
3271  do i = 1, dim_size
3272  array_avr_work5(:,:,:,:,1,:) = array_avr_work5(:,:,:,:,1,:) + array_avr_work(:,:,:,:,i,:) * weight5(i)
3273  weight_sum = weight_sum + weight5(i)
3274  end do
3275  array_avr_work5 = array_avr_work5 / weight_sum
3276  array_avr_work => array_avr_work5
3277  end if
3278 
3279 
3280 
3281  if ( space_average(6) ) then
3282  dim_size = array_shape(6)
3283  array_shape(6) = 1
3284  allocate( array_avr_work6( array_shape(1) &
3285  & , array_shape(2) &
3286 
3287  & , array_shape(3) &
3288 
3289  & , array_shape(4) &
3290 
3291  & , array_shape(5) &
3292 
3293  & , array_shape(6) &
3294 
3295  & ) )
3296  array_avr_work6 = 0.0_dp
3297  weight_sum = 0.0_dp
3298  do i = 1, dim_size
3299  array_avr_work6(:,:,:,:,:,1) = array_avr_work6(:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,i) * weight6(i)
3300  weight_sum = weight_sum + weight6(i)
3301  end do
3302  array_avr_work6 = array_avr_work6 / weight_sum
3303  array_avr_work => array_avr_work6
3304  end if
3305 
3306 
3307 
3308 
3309 
3310 
3311 
3312  allocate( array_avr( array_shape(1) &
3313  & , array_shape(2) &
3314 
3315  & , array_shape(3) &
3316 
3317  & , array_shape(4) &
3318 
3319  & , array_shape(5) &
3320 
3321  & , array_shape(6) &
3322 
3323  & ) )
3324 
3325  array_avr = array_avr_work
3326 
3327  nullify( array_avr_work )
3328 
3329  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
3330 
3331  if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
3332 
3333  if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
3334 
3335  if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
3336 
3337  if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 )
3338 
3339  if ( associated( array_avr_work6 ) ) deallocate( array_avr_work6 )
3340 
3341 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereducedouble7()

subroutine gtool_historyauto_internal::averagereduce::averagereducedouble7 ( real(dp), dimension(:,:,:,:,:,:,:), intent(in), target  array,
logical, dimension(7), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), intent(in)  weight2,
real(dp), dimension(:), intent(in)  weight3,
real(dp), dimension(:), intent(in)  weight4,
real(dp), dimension(:), intent(in)  weight5,
real(dp), dimension(:), intent(in)  weight6,
real(dp), dimension(:), intent(in)  weight7,
real(dp), dimension(:,:,:,:,:,:,:), pointer  array_avr 
)
private

Definition at line 3363 of file gtool_historyauto_internal.f90.

3363  !
3364  ! space_average で .true. に指定された次元に対して,
3365  ! array を平均化して array_avr に返します.
3366  ! 平均化には重み weight1 〜 weight7 が用いられます.
3367  ! array_avr の配列の次元そのものは減りません. その代わり,
3368  ! 平均化された次元の配列のサイズは 1 になります.
3369  !
3370  implicit none
3371  real(DP), intent(in), target:: array(:,:,:,:,:,:,:)
3372  logical, intent(in):: space_average(7)
3373  real(DP), intent(in):: weight1(:)
3374 
3375  real(DP), intent(in):: weight2(:)
3376 
3377  real(DP), intent(in):: weight3(:)
3378 
3379  real(DP), intent(in):: weight4(:)
3380 
3381  real(DP), intent(in):: weight5(:)
3382 
3383  real(DP), intent(in):: weight6(:)
3384 
3385  real(DP), intent(in):: weight7(:)
3386 
3387  real(DP), pointer:: array_avr(:,:,:,:,:,:,:) ! (out)
3388 
3389  real(DP), pointer:: array_avr_work(:,:,:,:,:,:,:)
3390 
3391  real(DP), pointer:: array_avr_work1(:,:,:,:,:,:,:)
3392 
3393  real(DP), pointer:: array_avr_work2(:,:,:,:,:,:,:)
3394 
3395  real(DP), pointer:: array_avr_work3(:,:,:,:,:,:,:)
3396 
3397  real(DP), pointer:: array_avr_work4(:,:,:,:,:,:,:)
3398 
3399  real(DP), pointer:: array_avr_work5(:,:,:,:,:,:,:)
3400 
3401  real(DP), pointer:: array_avr_work6(:,:,:,:,:,:,:)
3402 
3403  real(DP), pointer:: array_avr_work7(:,:,:,:,:,:,:)
3404 
3405 
3406  integer:: array_shape(7)
3407  integer:: i, dim_size
3408  real(DP):: weight_sum
3409  continue
3410 
3411  array_shape = shape( array )
3412  array_avr_work => array
3413 
3414 
3415 
3416 
3417  if ( space_average(1) ) then
3418  dim_size = array_shape(1)
3419  array_shape(1) = 1
3420  allocate( array_avr_work1( array_shape(1) &
3421  & , array_shape(2) &
3422 
3423  & , array_shape(3) &
3424 
3425  & , array_shape(4) &
3426 
3427  & , array_shape(5) &
3428 
3429  & , array_shape(6) &
3430 
3431  & , array_shape(7) &
3432 
3433  & ) )
3434  array_avr_work1 = 0.0_dp
3435  weight_sum = 0.0_dp
3436  do i = 1, dim_size
3437  array_avr_work1(1,:,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:,:) * weight1(i)
3438  weight_sum = weight_sum + weight1(i)
3439  end do
3440  array_avr_work1 = array_avr_work1 / weight_sum
3441  array_avr_work => array_avr_work1
3442  end if
3443 
3444 
3445 
3446  if ( space_average(2) ) then
3447  dim_size = array_shape(2)
3448  array_shape(2) = 1
3449  allocate( array_avr_work2( array_shape(1) &
3450  & , array_shape(2) &
3451 
3452  & , array_shape(3) &
3453 
3454  & , array_shape(4) &
3455 
3456  & , array_shape(5) &
3457 
3458  & , array_shape(6) &
3459 
3460  & , array_shape(7) &
3461 
3462  & ) )
3463  array_avr_work2 = 0.0_dp
3464  weight_sum = 0.0_dp
3465  do i = 1, dim_size
3466  array_avr_work2(:,1,:,:,:,:,:) = array_avr_work2(:,1,:,:,:,:,:) + array_avr_work(:,i,:,:,:,:,:) * weight2(i)
3467  weight_sum = weight_sum + weight2(i)
3468  end do
3469  array_avr_work2 = array_avr_work2 / weight_sum
3470  array_avr_work => array_avr_work2
3471  end if
3472 
3473 
3474 
3475  if ( space_average(3) ) then
3476  dim_size = array_shape(3)
3477  array_shape(3) = 1
3478  allocate( array_avr_work3( array_shape(1) &
3479  & , array_shape(2) &
3480 
3481  & , array_shape(3) &
3482 
3483  & , array_shape(4) &
3484 
3485  & , array_shape(5) &
3486 
3487  & , array_shape(6) &
3488 
3489  & , array_shape(7) &
3490 
3491  & ) )
3492  array_avr_work3 = 0.0_dp
3493  weight_sum = 0.0_dp
3494  do i = 1, dim_size
3495  array_avr_work3(:,:,1,:,:,:,:) = array_avr_work3(:,:,1,:,:,:,:) + array_avr_work(:,:,i,:,:,:,:) * weight3(i)
3496  weight_sum = weight_sum + weight3(i)
3497  end do
3498  array_avr_work3 = array_avr_work3 / weight_sum
3499  array_avr_work => array_avr_work3
3500  end if
3501 
3502 
3503 
3504  if ( space_average(4) ) then
3505  dim_size = array_shape(4)
3506  array_shape(4) = 1
3507  allocate( array_avr_work4( array_shape(1) &
3508  & , array_shape(2) &
3509 
3510  & , array_shape(3) &
3511 
3512  & , array_shape(4) &
3513 
3514  & , array_shape(5) &
3515 
3516  & , array_shape(6) &
3517 
3518  & , array_shape(7) &
3519 
3520  & ) )
3521  array_avr_work4 = 0.0_dp
3522  weight_sum = 0.0_dp
3523  do i = 1, dim_size
3524  array_avr_work4(:,:,:,1,:,:,:) = array_avr_work4(:,:,:,1,:,:,:) + array_avr_work(:,:,:,i,:,:,:) * weight4(i)
3525  weight_sum = weight_sum + weight4(i)
3526  end do
3527  array_avr_work4 = array_avr_work4 / weight_sum
3528  array_avr_work => array_avr_work4
3529  end if
3530 
3531 
3532 
3533  if ( space_average(5) ) then
3534  dim_size = array_shape(5)
3535  array_shape(5) = 1
3536  allocate( array_avr_work5( array_shape(1) &
3537  & , array_shape(2) &
3538 
3539  & , array_shape(3) &
3540 
3541  & , array_shape(4) &
3542 
3543  & , array_shape(5) &
3544 
3545  & , array_shape(6) &
3546 
3547  & , array_shape(7) &
3548 
3549  & ) )
3550  array_avr_work5 = 0.0_dp
3551  weight_sum = 0.0_dp
3552  do i = 1, dim_size
3553  array_avr_work5(:,:,:,:,1,:,:) = array_avr_work5(:,:,:,:,1,:,:) + array_avr_work(:,:,:,:,i,:,:) * weight5(i)
3554  weight_sum = weight_sum + weight5(i)
3555  end do
3556  array_avr_work5 = array_avr_work5 / weight_sum
3557  array_avr_work => array_avr_work5
3558  end if
3559 
3560 
3561 
3562  if ( space_average(6) ) then
3563  dim_size = array_shape(6)
3564  array_shape(6) = 1
3565  allocate( array_avr_work6( array_shape(1) &
3566  & , array_shape(2) &
3567 
3568  & , array_shape(3) &
3569 
3570  & , array_shape(4) &
3571 
3572  & , array_shape(5) &
3573 
3574  & , array_shape(6) &
3575 
3576  & , array_shape(7) &
3577 
3578  & ) )
3579  array_avr_work6 = 0.0_dp
3580  weight_sum = 0.0_dp
3581  do i = 1, dim_size
3582  array_avr_work6(:,:,:,:,:,1,:) = array_avr_work6(:,:,:,:,:,1,:) + array_avr_work(:,:,:,:,:,i,:) * weight6(i)
3583  weight_sum = weight_sum + weight6(i)
3584  end do
3585  array_avr_work6 = array_avr_work6 / weight_sum
3586  array_avr_work => array_avr_work6
3587  end if
3588 
3589 
3590 
3591  if ( space_average(7) ) then
3592  dim_size = array_shape(7)
3593  array_shape(7) = 1
3594  allocate( array_avr_work7( array_shape(1) &
3595  & , array_shape(2) &
3596 
3597  & , array_shape(3) &
3598 
3599  & , array_shape(4) &
3600 
3601  & , array_shape(5) &
3602 
3603  & , array_shape(6) &
3604 
3605  & , array_shape(7) &
3606 
3607  & ) )
3608  array_avr_work7 = 0.0_dp
3609  weight_sum = 0.0_dp
3610  do i = 1, dim_size
3611  array_avr_work7(:,:,:,:,:,:,1) = array_avr_work7(:,:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,:,i) * weight7(i)
3612  weight_sum = weight_sum + weight7(i)
3613  end do
3614  array_avr_work7 = array_avr_work7 / weight_sum
3615  array_avr_work => array_avr_work7
3616  end if
3617 
3618 
3619 
3620 
3621 
3622 
3623 
3624  allocate( array_avr( array_shape(1) &
3625  & , array_shape(2) &
3626 
3627  & , array_shape(3) &
3628 
3629  & , array_shape(4) &
3630 
3631  & , array_shape(5) &
3632 
3633  & , array_shape(6) &
3634 
3635  & , array_shape(7) &
3636 
3637  & ) )
3638 
3639  array_avr = array_avr_work
3640 
3641  nullify( array_avr_work )
3642 
3643  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
3644 
3645  if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
3646 
3647  if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
3648 
3649  if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
3650 
3651  if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 )
3652 
3653  if ( associated( array_avr_work6 ) ) deallocate( array_avr_work6 )
3654 
3655  if ( associated( array_avr_work7 ) ) deallocate( array_avr_work7 )
3656 
3657 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereduceint1()

subroutine gtool_historyauto_internal::averagereduce::averagereduceint1 ( integer, dimension(:), intent(in), target  array,
logical, dimension(1), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
integer, dimension(:), pointer  array_avr 
)
private

Definition at line 3667 of file gtool_historyauto_internal.f90.

3667  !
3668  ! space_average で .true. に指定された次元に対して,
3669  ! array を平均化して array_avr に返します.
3670  ! 平均化には重み weight1 〜 weight7 が用いられます.
3671  ! array_avr の配列の次元そのものは減りません. その代わり,
3672  ! 平均化された次元の配列のサイズは 1 になります.
3673  !
3674  implicit none
3675  integer, intent(in), target:: array(:)
3676  logical, intent(in):: space_average(1)
3677  real(DP), intent(in):: weight1(:)
3678 
3679  integer, pointer:: array_avr(:) ! (out)
3680 
3681  integer, pointer:: array_avr_work(:)
3682 
3683  integer, pointer:: array_avr_work1(:)
3684 
3685 
3686  integer:: array_shape(1)
3687  integer:: i, dim_size
3688  real(DP):: weight_sum
3689  continue
3690 
3691  array_shape = shape( array )
3692  array_avr_work => array
3693 
3694 
3695 
3696 
3697  if ( space_average(1) ) then
3698  dim_size = array_shape(1)
3699  array_shape(1) = 1
3700  allocate( array_avr_work1( array_shape(1) &
3701 
3702  & ) )
3703  array_avr_work1 = 0
3704  weight_sum = 0.0_dp
3705  do i = 1, dim_size
3706  array_avr_work1(1) = array_avr_work1(1) + array_avr_work(i) * weight1(i)
3707  weight_sum = weight_sum + weight1(i)
3708  end do
3709  array_avr_work1 = array_avr_work1 / weight_sum
3710  array_avr_work => array_avr_work1
3711  end if
3712 
3713 
3714 
3715 
3716 
3717 
3718 
3719  allocate( array_avr( array_shape(1) &
3720 
3721  & ) )
3722 
3723  array_avr = array_avr_work
3724 
3725  nullify( array_avr_work )
3726 
3727  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
3728 
3729 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereduceint2()

subroutine gtool_historyauto_internal::averagereduce::averagereduceint2 ( integer, dimension(:,:), intent(in), target  array,
logical, dimension(2), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), intent(in)  weight2,
integer, dimension(:,:), pointer  array_avr 
)
private

Definition at line 3741 of file gtool_historyauto_internal.f90.

3741  !
3742  ! space_average で .true. に指定された次元に対して,
3743  ! array を平均化して array_avr に返します.
3744  ! 平均化には重み weight1 〜 weight7 が用いられます.
3745  ! array_avr の配列の次元そのものは減りません. その代わり,
3746  ! 平均化された次元の配列のサイズは 1 になります.
3747  !
3748  implicit none
3749  integer, intent(in), target:: array(:,:)
3750  logical, intent(in):: space_average(2)
3751  real(DP), intent(in):: weight1(:)
3752 
3753  real(DP), intent(in):: weight2(:)
3754 
3755  integer, pointer:: array_avr(:,:) ! (out)
3756 
3757  integer, pointer:: array_avr_work(:,:)
3758 
3759  integer, pointer:: array_avr_work1(:,:)
3760 
3761  integer, pointer:: array_avr_work2(:,:)
3762 
3763 
3764  integer:: array_shape(2)
3765  integer:: i, dim_size
3766  real(DP):: weight_sum
3767  continue
3768 
3769  array_shape = shape( array )
3770  array_avr_work => array
3771 
3772 
3773 
3774 
3775  if ( space_average(1) ) then
3776  dim_size = array_shape(1)
3777  array_shape(1) = 1
3778  allocate( array_avr_work1( array_shape(1) &
3779  & , array_shape(2) &
3780 
3781  & ) )
3782  array_avr_work1 = 0
3783  weight_sum = 0.0_dp
3784  do i = 1, dim_size
3785  array_avr_work1(1,:) = array_avr_work1(1,:) + array_avr_work(i,:) * weight1(i)
3786  weight_sum = weight_sum + weight1(i)
3787  end do
3788  array_avr_work1 = array_avr_work1 / weight_sum
3789  array_avr_work => array_avr_work1
3790  end if
3791 
3792 
3793 
3794  if ( space_average(2) ) then
3795  dim_size = array_shape(2)
3796  array_shape(2) = 1
3797  allocate( array_avr_work2( array_shape(1) &
3798  & , array_shape(2) &
3799 
3800  & ) )
3801  array_avr_work2 = 0
3802  weight_sum = 0.0_dp
3803  do i = 1, dim_size
3804  array_avr_work2(:,1) = array_avr_work2(:,1) + array_avr_work(:,i) * weight2(i)
3805  weight_sum = weight_sum + weight2(i)
3806  end do
3807  array_avr_work2 = array_avr_work2 / weight_sum
3808  array_avr_work => array_avr_work2
3809  end if
3810 
3811 
3812 
3813 
3814 
3815 
3816 
3817  allocate( array_avr( array_shape(1) &
3818  & , array_shape(2) &
3819 
3820  & ) )
3821 
3822  array_avr = array_avr_work
3823 
3824  nullify( array_avr_work )
3825 
3826  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
3827 
3828  if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
3829 
3830 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereduceint3()

subroutine gtool_historyauto_internal::averagereduce::averagereduceint3 ( integer, dimension(:,:,:), intent(in), target  array,
logical, dimension(3), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), intent(in)  weight2,
real(dp), dimension(:), intent(in)  weight3,
integer, dimension(:,:,:), pointer  array_avr 
)
private

Definition at line 3844 of file gtool_historyauto_internal.f90.

3844  !
3845  ! space_average で .true. に指定された次元に対して,
3846  ! array を平均化して array_avr に返します.
3847  ! 平均化には重み weight1 〜 weight7 が用いられます.
3848  ! array_avr の配列の次元そのものは減りません. その代わり,
3849  ! 平均化された次元の配列のサイズは 1 になります.
3850  !
3851  implicit none
3852  integer, intent(in), target:: array(:,:,:)
3853  logical, intent(in):: space_average(3)
3854  real(DP), intent(in):: weight1(:)
3855 
3856  real(DP), intent(in):: weight2(:)
3857 
3858  real(DP), intent(in):: weight3(:)
3859 
3860  integer, pointer:: array_avr(:,:,:) ! (out)
3861 
3862  integer, pointer:: array_avr_work(:,:,:)
3863 
3864  integer, pointer:: array_avr_work1(:,:,:)
3865 
3866  integer, pointer:: array_avr_work2(:,:,:)
3867 
3868  integer, pointer:: array_avr_work3(:,:,:)
3869 
3870 
3871  integer:: array_shape(3)
3872  integer:: i, dim_size
3873  real(DP):: weight_sum
3874  continue
3875 
3876  array_shape = shape( array )
3877  array_avr_work => array
3878 
3879 
3880 
3881 
3882  if ( space_average(1) ) then
3883  dim_size = array_shape(1)
3884  array_shape(1) = 1
3885  allocate( array_avr_work1( array_shape(1) &
3886  & , array_shape(2) &
3887 
3888  & , array_shape(3) &
3889 
3890  & ) )
3891  array_avr_work1 = 0
3892  weight_sum = 0.0_dp
3893  do i = 1, dim_size
3894  array_avr_work1(1,:,:) = array_avr_work1(1,:,:) + array_avr_work(i,:,:) * weight1(i)
3895  weight_sum = weight_sum + weight1(i)
3896  end do
3897  array_avr_work1 = array_avr_work1 / weight_sum
3898  array_avr_work => array_avr_work1
3899  end if
3900 
3901 
3902 
3903  if ( space_average(2) ) then
3904  dim_size = array_shape(2)
3905  array_shape(2) = 1
3906  allocate( array_avr_work2( array_shape(1) &
3907  & , array_shape(2) &
3908 
3909  & , array_shape(3) &
3910 
3911  & ) )
3912  array_avr_work2 = 0
3913  weight_sum = 0.0_dp
3914  do i = 1, dim_size
3915  array_avr_work2(:,1,:) = array_avr_work2(:,1,:) + array_avr_work(:,i,:) * weight2(i)
3916  weight_sum = weight_sum + weight2(i)
3917  end do
3918  array_avr_work2 = array_avr_work2 / weight_sum
3919  array_avr_work => array_avr_work2
3920  end if
3921 
3922 
3923 
3924  if ( space_average(3) ) then
3925  dim_size = array_shape(3)
3926  array_shape(3) = 1
3927  allocate( array_avr_work3( array_shape(1) &
3928  & , array_shape(2) &
3929 
3930  & , array_shape(3) &
3931 
3932  & ) )
3933  array_avr_work3 = 0
3934  weight_sum = 0.0_dp
3935  do i = 1, dim_size
3936  array_avr_work3(:,:,1) = array_avr_work3(:,:,1) + array_avr_work(:,:,i) * weight3(i)
3937  weight_sum = weight_sum + weight3(i)
3938  end do
3939  array_avr_work3 = array_avr_work3 / weight_sum
3940  array_avr_work => array_avr_work3
3941  end if
3942 
3943 
3944 
3945 
3946 
3947 
3948 
3949  allocate( array_avr( array_shape(1) &
3950  & , array_shape(2) &
3951 
3952  & , array_shape(3) &
3953 
3954  & ) )
3955 
3956  array_avr = array_avr_work
3957 
3958  nullify( array_avr_work )
3959 
3960  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
3961 
3962  if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
3963 
3964  if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
3965 
3966 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereduceint4()

subroutine gtool_historyauto_internal::averagereduce::averagereduceint4 ( integer, dimension(:,:,:,:), intent(in), target  array,
logical, dimension(4), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), intent(in)  weight2,
real(dp), dimension(:), intent(in)  weight3,
real(dp), dimension(:), intent(in)  weight4,
integer, dimension(:,:,:,:), pointer  array_avr 
)
private

Definition at line 3982 of file gtool_historyauto_internal.f90.

3982  !
3983  ! space_average で .true. に指定された次元に対して,
3984  ! array を平均化して array_avr に返します.
3985  ! 平均化には重み weight1 〜 weight7 が用いられます.
3986  ! array_avr の配列の次元そのものは減りません. その代わり,
3987  ! 平均化された次元の配列のサイズは 1 になります.
3988  !
3989  implicit none
3990  integer, intent(in), target:: array(:,:,:,:)
3991  logical, intent(in):: space_average(4)
3992  real(DP), intent(in):: weight1(:)
3993 
3994  real(DP), intent(in):: weight2(:)
3995 
3996  real(DP), intent(in):: weight3(:)
3997 
3998  real(DP), intent(in):: weight4(:)
3999 
4000  integer, pointer:: array_avr(:,:,:,:) ! (out)
4001 
4002  integer, pointer:: array_avr_work(:,:,:,:)
4003 
4004  integer, pointer:: array_avr_work1(:,:,:,:)
4005 
4006  integer, pointer:: array_avr_work2(:,:,:,:)
4007 
4008  integer, pointer:: array_avr_work3(:,:,:,:)
4009 
4010  integer, pointer:: array_avr_work4(:,:,:,:)
4011 
4012 
4013  integer:: array_shape(4)
4014  integer:: i, dim_size
4015  real(DP):: weight_sum
4016  continue
4017 
4018  array_shape = shape( array )
4019  array_avr_work => array
4020 
4021 
4022 
4023 
4024  if ( space_average(1) ) then
4025  dim_size = array_shape(1)
4026  array_shape(1) = 1
4027  allocate( array_avr_work1( array_shape(1) &
4028  & , array_shape(2) &
4029 
4030  & , array_shape(3) &
4031 
4032  & , array_shape(4) &
4033 
4034  & ) )
4035  array_avr_work1 = 0
4036  weight_sum = 0.0_dp
4037  do i = 1, dim_size
4038  array_avr_work1(1,:,:,:) = array_avr_work1(1,:,:,:) + array_avr_work(i,:,:,:) * weight1(i)
4039  weight_sum = weight_sum + weight1(i)
4040  end do
4041  array_avr_work1 = array_avr_work1 / weight_sum
4042  array_avr_work => array_avr_work1
4043  end if
4044 
4045 
4046 
4047  if ( space_average(2) ) then
4048  dim_size = array_shape(2)
4049  array_shape(2) = 1
4050  allocate( array_avr_work2( array_shape(1) &
4051  & , array_shape(2) &
4052 
4053  & , array_shape(3) &
4054 
4055  & , array_shape(4) &
4056 
4057  & ) )
4058  array_avr_work2 = 0
4059  weight_sum = 0.0_dp
4060  do i = 1, dim_size
4061  array_avr_work2(:,1,:,:) = array_avr_work2(:,1,:,:) + array_avr_work(:,i,:,:) * weight2(i)
4062  weight_sum = weight_sum + weight2(i)
4063  end do
4064  array_avr_work2 = array_avr_work2 / weight_sum
4065  array_avr_work => array_avr_work2
4066  end if
4067 
4068 
4069 
4070  if ( space_average(3) ) then
4071  dim_size = array_shape(3)
4072  array_shape(3) = 1
4073  allocate( array_avr_work3( array_shape(1) &
4074  & , array_shape(2) &
4075 
4076  & , array_shape(3) &
4077 
4078  & , array_shape(4) &
4079 
4080  & ) )
4081  array_avr_work3 = 0
4082  weight_sum = 0.0_dp
4083  do i = 1, dim_size
4084  array_avr_work3(:,:,1,:) = array_avr_work3(:,:,1,:) + array_avr_work(:,:,i,:) * weight3(i)
4085  weight_sum = weight_sum + weight3(i)
4086  end do
4087  array_avr_work3 = array_avr_work3 / weight_sum
4088  array_avr_work => array_avr_work3
4089  end if
4090 
4091 
4092 
4093  if ( space_average(4) ) then
4094  dim_size = array_shape(4)
4095  array_shape(4) = 1
4096  allocate( array_avr_work4( array_shape(1) &
4097  & , array_shape(2) &
4098 
4099  & , array_shape(3) &
4100 
4101  & , array_shape(4) &
4102 
4103  & ) )
4104  array_avr_work4 = 0
4105  weight_sum = 0.0_dp
4106  do i = 1, dim_size
4107  array_avr_work4(:,:,:,1) = array_avr_work4(:,:,:,1) + array_avr_work(:,:,:,i) * weight4(i)
4108  weight_sum = weight_sum + weight4(i)
4109  end do
4110  array_avr_work4 = array_avr_work4 / weight_sum
4111  array_avr_work => array_avr_work4
4112  end if
4113 
4114 
4115 
4116 
4117 
4118 
4119 
4120  allocate( array_avr( array_shape(1) &
4121  & , array_shape(2) &
4122 
4123  & , array_shape(3) &
4124 
4125  & , array_shape(4) &
4126 
4127  & ) )
4128 
4129  array_avr = array_avr_work
4130 
4131  nullify( array_avr_work )
4132 
4133  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
4134 
4135  if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
4136 
4137  if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
4138 
4139  if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
4140 
4141 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereduceint5()

subroutine gtool_historyauto_internal::averagereduce::averagereduceint5 ( integer, dimension(:,:,:,:,:), intent(in), target  array,
logical, dimension(5), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), intent(in)  weight2,
real(dp), dimension(:), intent(in)  weight3,
real(dp), dimension(:), intent(in)  weight4,
real(dp), dimension(:), intent(in)  weight5,
integer, dimension(:,:,:,:,:), pointer  array_avr 
)
private

Definition at line 4159 of file gtool_historyauto_internal.f90.

4159  !
4160  ! space_average で .true. に指定された次元に対して,
4161  ! array を平均化して array_avr に返します.
4162  ! 平均化には重み weight1 〜 weight7 が用いられます.
4163  ! array_avr の配列の次元そのものは減りません. その代わり,
4164  ! 平均化された次元の配列のサイズは 1 になります.
4165  !
4166  implicit none
4167  integer, intent(in), target:: array(:,:,:,:,:)
4168  logical, intent(in):: space_average(5)
4169  real(DP), intent(in):: weight1(:)
4170 
4171  real(DP), intent(in):: weight2(:)
4172 
4173  real(DP), intent(in):: weight3(:)
4174 
4175  real(DP), intent(in):: weight4(:)
4176 
4177  real(DP), intent(in):: weight5(:)
4178 
4179  integer, pointer:: array_avr(:,:,:,:,:) ! (out)
4180 
4181  integer, pointer:: array_avr_work(:,:,:,:,:)
4182 
4183  integer, pointer:: array_avr_work1(:,:,:,:,:)
4184 
4185  integer, pointer:: array_avr_work2(:,:,:,:,:)
4186 
4187  integer, pointer:: array_avr_work3(:,:,:,:,:)
4188 
4189  integer, pointer:: array_avr_work4(:,:,:,:,:)
4190 
4191  integer, pointer:: array_avr_work5(:,:,:,:,:)
4192 
4193 
4194  integer:: array_shape(5)
4195  integer:: i, dim_size
4196  real(DP):: weight_sum
4197  continue
4198 
4199  array_shape = shape( array )
4200  array_avr_work => array
4201 
4202 
4203 
4204 
4205  if ( space_average(1) ) then
4206  dim_size = array_shape(1)
4207  array_shape(1) = 1
4208  allocate( array_avr_work1( array_shape(1) &
4209  & , array_shape(2) &
4210 
4211  & , array_shape(3) &
4212 
4213  & , array_shape(4) &
4214 
4215  & , array_shape(5) &
4216 
4217  & ) )
4218  array_avr_work1 = 0
4219  weight_sum = 0.0_dp
4220  do i = 1, dim_size
4221  array_avr_work1(1,:,:,:,:) = array_avr_work1(1,:,:,:,:) + array_avr_work(i,:,:,:,:) * weight1(i)
4222  weight_sum = weight_sum + weight1(i)
4223  end do
4224  array_avr_work1 = array_avr_work1 / weight_sum
4225  array_avr_work => array_avr_work1
4226  end if
4227 
4228 
4229 
4230  if ( space_average(2) ) then
4231  dim_size = array_shape(2)
4232  array_shape(2) = 1
4233  allocate( array_avr_work2( array_shape(1) &
4234  & , array_shape(2) &
4235 
4236  & , array_shape(3) &
4237 
4238  & , array_shape(4) &
4239 
4240  & , array_shape(5) &
4241 
4242  & ) )
4243  array_avr_work2 = 0
4244  weight_sum = 0.0_dp
4245  do i = 1, dim_size
4246  array_avr_work2(:,1,:,:,:) = array_avr_work2(:,1,:,:,:) + array_avr_work(:,i,:,:,:) * weight2(i)
4247  weight_sum = weight_sum + weight2(i)
4248  end do
4249  array_avr_work2 = array_avr_work2 / weight_sum
4250  array_avr_work => array_avr_work2
4251  end if
4252 
4253 
4254 
4255  if ( space_average(3) ) then
4256  dim_size = array_shape(3)
4257  array_shape(3) = 1
4258  allocate( array_avr_work3( array_shape(1) &
4259  & , array_shape(2) &
4260 
4261  & , array_shape(3) &
4262 
4263  & , array_shape(4) &
4264 
4265  & , array_shape(5) &
4266 
4267  & ) )
4268  array_avr_work3 = 0
4269  weight_sum = 0.0_dp
4270  do i = 1, dim_size
4271  array_avr_work3(:,:,1,:,:) = array_avr_work3(:,:,1,:,:) + array_avr_work(:,:,i,:,:) * weight3(i)
4272  weight_sum = weight_sum + weight3(i)
4273  end do
4274  array_avr_work3 = array_avr_work3 / weight_sum
4275  array_avr_work => array_avr_work3
4276  end if
4277 
4278 
4279 
4280  if ( space_average(4) ) then
4281  dim_size = array_shape(4)
4282  array_shape(4) = 1
4283  allocate( array_avr_work4( array_shape(1) &
4284  & , array_shape(2) &
4285 
4286  & , array_shape(3) &
4287 
4288  & , array_shape(4) &
4289 
4290  & , array_shape(5) &
4291 
4292  & ) )
4293  array_avr_work4 = 0
4294  weight_sum = 0.0_dp
4295  do i = 1, dim_size
4296  array_avr_work4(:,:,:,1,:) = array_avr_work4(:,:,:,1,:) + array_avr_work(:,:,:,i,:) * weight4(i)
4297  weight_sum = weight_sum + weight4(i)
4298  end do
4299  array_avr_work4 = array_avr_work4 / weight_sum
4300  array_avr_work => array_avr_work4
4301  end if
4302 
4303 
4304 
4305  if ( space_average(5) ) then
4306  dim_size = array_shape(5)
4307  array_shape(5) = 1
4308  allocate( array_avr_work5( array_shape(1) &
4309  & , array_shape(2) &
4310 
4311  & , array_shape(3) &
4312 
4313  & , array_shape(4) &
4314 
4315  & , array_shape(5) &
4316 
4317  & ) )
4318  array_avr_work5 = 0
4319  weight_sum = 0.0_dp
4320  do i = 1, dim_size
4321  array_avr_work5(:,:,:,:,1) = array_avr_work5(:,:,:,:,1) + array_avr_work(:,:,:,:,i) * weight5(i)
4322  weight_sum = weight_sum + weight5(i)
4323  end do
4324  array_avr_work5 = array_avr_work5 / weight_sum
4325  array_avr_work => array_avr_work5
4326  end if
4327 
4328 
4329 
4330 
4331 
4332 
4333 
4334  allocate( array_avr( array_shape(1) &
4335  & , array_shape(2) &
4336 
4337  & , array_shape(3) &
4338 
4339  & , array_shape(4) &
4340 
4341  & , array_shape(5) &
4342 
4343  & ) )
4344 
4345  array_avr = array_avr_work
4346 
4347  nullify( array_avr_work )
4348 
4349  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
4350 
4351  if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
4352 
4353  if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
4354 
4355  if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
4356 
4357  if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 )
4358 
4359 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereduceint6()

subroutine gtool_historyauto_internal::averagereduce::averagereduceint6 ( integer, dimension(:,:,:,:,:,:), intent(in), target  array,
logical, dimension(6), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), intent(in)  weight2,
real(dp), dimension(:), intent(in)  weight3,
real(dp), dimension(:), intent(in)  weight4,
real(dp), dimension(:), intent(in)  weight5,
real(dp), dimension(:), intent(in)  weight6,
integer, dimension(:,:,:,:,:,:), pointer  array_avr 
)
private

Definition at line 4379 of file gtool_historyauto_internal.f90.

4379  !
4380  ! space_average で .true. に指定された次元に対して,
4381  ! array を平均化して array_avr に返します.
4382  ! 平均化には重み weight1 〜 weight7 が用いられます.
4383  ! array_avr の配列の次元そのものは減りません. その代わり,
4384  ! 平均化された次元の配列のサイズは 1 になります.
4385  !
4386  implicit none
4387  integer, intent(in), target:: array(:,:,:,:,:,:)
4388  logical, intent(in):: space_average(6)
4389  real(DP), intent(in):: weight1(:)
4390 
4391  real(DP), intent(in):: weight2(:)
4392 
4393  real(DP), intent(in):: weight3(:)
4394 
4395  real(DP), intent(in):: weight4(:)
4396 
4397  real(DP), intent(in):: weight5(:)
4398 
4399  real(DP), intent(in):: weight6(:)
4400 
4401  integer, pointer:: array_avr(:,:,:,:,:,:) ! (out)
4402 
4403  integer, pointer:: array_avr_work(:,:,:,:,:,:)
4404 
4405  integer, pointer:: array_avr_work1(:,:,:,:,:,:)
4406 
4407  integer, pointer:: array_avr_work2(:,:,:,:,:,:)
4408 
4409  integer, pointer:: array_avr_work3(:,:,:,:,:,:)
4410 
4411  integer, pointer:: array_avr_work4(:,:,:,:,:,:)
4412 
4413  integer, pointer:: array_avr_work5(:,:,:,:,:,:)
4414 
4415  integer, pointer:: array_avr_work6(:,:,:,:,:,:)
4416 
4417 
4418  integer:: array_shape(6)
4419  integer:: i, dim_size
4420  real(DP):: weight_sum
4421  continue
4422 
4423  array_shape = shape( array )
4424  array_avr_work => array
4425 
4426 
4427 
4428 
4429  if ( space_average(1) ) then
4430  dim_size = array_shape(1)
4431  array_shape(1) = 1
4432  allocate( array_avr_work1( array_shape(1) &
4433  & , array_shape(2) &
4434 
4435  & , array_shape(3) &
4436 
4437  & , array_shape(4) &
4438 
4439  & , array_shape(5) &
4440 
4441  & , array_shape(6) &
4442 
4443  & ) )
4444  array_avr_work1 = 0
4445  weight_sum = 0.0_dp
4446  do i = 1, dim_size
4447  array_avr_work1(1,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:) * weight1(i)
4448  weight_sum = weight_sum + weight1(i)
4449  end do
4450  array_avr_work1 = array_avr_work1 / weight_sum
4451  array_avr_work => array_avr_work1
4452  end if
4453 
4454 
4455 
4456  if ( space_average(2) ) then
4457  dim_size = array_shape(2)
4458  array_shape(2) = 1
4459  allocate( array_avr_work2( array_shape(1) &
4460  & , array_shape(2) &
4461 
4462  & , array_shape(3) &
4463 
4464  & , array_shape(4) &
4465 
4466  & , array_shape(5) &
4467 
4468  & , array_shape(6) &
4469 
4470  & ) )
4471  array_avr_work2 = 0
4472  weight_sum = 0.0_dp
4473  do i = 1, dim_size
4474  array_avr_work2(:,1,:,:,:,:) = array_avr_work2(:,1,:,:,:,:) + array_avr_work(:,i,:,:,:,:) * weight2(i)
4475  weight_sum = weight_sum + weight2(i)
4476  end do
4477  array_avr_work2 = array_avr_work2 / weight_sum
4478  array_avr_work => array_avr_work2
4479  end if
4480 
4481 
4482 
4483  if ( space_average(3) ) then
4484  dim_size = array_shape(3)
4485  array_shape(3) = 1
4486  allocate( array_avr_work3( array_shape(1) &
4487  & , array_shape(2) &
4488 
4489  & , array_shape(3) &
4490 
4491  & , array_shape(4) &
4492 
4493  & , array_shape(5) &
4494 
4495  & , array_shape(6) &
4496 
4497  & ) )
4498  array_avr_work3 = 0
4499  weight_sum = 0.0_dp
4500  do i = 1, dim_size
4501  array_avr_work3(:,:,1,:,:,:) = array_avr_work3(:,:,1,:,:,:) + array_avr_work(:,:,i,:,:,:) * weight3(i)
4502  weight_sum = weight_sum + weight3(i)
4503  end do
4504  array_avr_work3 = array_avr_work3 / weight_sum
4505  array_avr_work => array_avr_work3
4506  end if
4507 
4508 
4509 
4510  if ( space_average(4) ) then
4511  dim_size = array_shape(4)
4512  array_shape(4) = 1
4513  allocate( array_avr_work4( array_shape(1) &
4514  & , array_shape(2) &
4515 
4516  & , array_shape(3) &
4517 
4518  & , array_shape(4) &
4519 
4520  & , array_shape(5) &
4521 
4522  & , array_shape(6) &
4523 
4524  & ) )
4525  array_avr_work4 = 0
4526  weight_sum = 0.0_dp
4527  do i = 1, dim_size
4528  array_avr_work4(:,:,:,1,:,:) = array_avr_work4(:,:,:,1,:,:) + array_avr_work(:,:,:,i,:,:) * weight4(i)
4529  weight_sum = weight_sum + weight4(i)
4530  end do
4531  array_avr_work4 = array_avr_work4 / weight_sum
4532  array_avr_work => array_avr_work4
4533  end if
4534 
4535 
4536 
4537  if ( space_average(5) ) then
4538  dim_size = array_shape(5)
4539  array_shape(5) = 1
4540  allocate( array_avr_work5( array_shape(1) &
4541  & , array_shape(2) &
4542 
4543  & , array_shape(3) &
4544 
4545  & , array_shape(4) &
4546 
4547  & , array_shape(5) &
4548 
4549  & , array_shape(6) &
4550 
4551  & ) )
4552  array_avr_work5 = 0
4553  weight_sum = 0.0_dp
4554  do i = 1, dim_size
4555  array_avr_work5(:,:,:,:,1,:) = array_avr_work5(:,:,:,:,1,:) + array_avr_work(:,:,:,:,i,:) * weight5(i)
4556  weight_sum = weight_sum + weight5(i)
4557  end do
4558  array_avr_work5 = array_avr_work5 / weight_sum
4559  array_avr_work => array_avr_work5
4560  end if
4561 
4562 
4563 
4564  if ( space_average(6) ) then
4565  dim_size = array_shape(6)
4566  array_shape(6) = 1
4567  allocate( array_avr_work6( array_shape(1) &
4568  & , array_shape(2) &
4569 
4570  & , array_shape(3) &
4571 
4572  & , array_shape(4) &
4573 
4574  & , array_shape(5) &
4575 
4576  & , array_shape(6) &
4577 
4578  & ) )
4579  array_avr_work6 = 0
4580  weight_sum = 0.0_dp
4581  do i = 1, dim_size
4582  array_avr_work6(:,:,:,:,:,1) = array_avr_work6(:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,i) * weight6(i)
4583  weight_sum = weight_sum + weight6(i)
4584  end do
4585  array_avr_work6 = array_avr_work6 / weight_sum
4586  array_avr_work => array_avr_work6
4587  end if
4588 
4589 
4590 
4591 
4592 
4593 
4594 
4595  allocate( array_avr( array_shape(1) &
4596  & , array_shape(2) &
4597 
4598  & , array_shape(3) &
4599 
4600  & , array_shape(4) &
4601 
4602  & , array_shape(5) &
4603 
4604  & , array_shape(6) &
4605 
4606  & ) )
4607 
4608  array_avr = array_avr_work
4609 
4610  nullify( array_avr_work )
4611 
4612  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
4613 
4614  if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
4615 
4616  if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
4617 
4618  if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
4619 
4620  if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 )
4621 
4622  if ( associated( array_avr_work6 ) ) deallocate( array_avr_work6 )
4623 
4624 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereduceint7()

subroutine gtool_historyauto_internal::averagereduce::averagereduceint7 ( integer, dimension(:,:,:,:,:,:,:), intent(in), target  array,
logical, dimension(7), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), intent(in)  weight2,
real(dp), dimension(:), intent(in)  weight3,
real(dp), dimension(:), intent(in)  weight4,
real(dp), dimension(:), intent(in)  weight5,
real(dp), dimension(:), intent(in)  weight6,
real(dp), dimension(:), intent(in)  weight7,
integer, dimension(:,:,:,:,:,:,:), pointer  array_avr 
)
private

Definition at line 4646 of file gtool_historyauto_internal.f90.

4646  !
4647  ! space_average で .true. に指定された次元に対して,
4648  ! array を平均化して array_avr に返します.
4649  ! 平均化には重み weight1 〜 weight7 が用いられます.
4650  ! array_avr の配列の次元そのものは減りません. その代わり,
4651  ! 平均化された次元の配列のサイズは 1 になります.
4652  !
4653  implicit none
4654  integer, intent(in), target:: array(:,:,:,:,:,:,:)
4655  logical, intent(in):: space_average(7)
4656  real(DP), intent(in):: weight1(:)
4657 
4658  real(DP), intent(in):: weight2(:)
4659 
4660  real(DP), intent(in):: weight3(:)
4661 
4662  real(DP), intent(in):: weight4(:)
4663 
4664  real(DP), intent(in):: weight5(:)
4665 
4666  real(DP), intent(in):: weight6(:)
4667 
4668  real(DP), intent(in):: weight7(:)
4669 
4670  integer, pointer:: array_avr(:,:,:,:,:,:,:) ! (out)
4671 
4672  integer, pointer:: array_avr_work(:,:,:,:,:,:,:)
4673 
4674  integer, pointer:: array_avr_work1(:,:,:,:,:,:,:)
4675 
4676  integer, pointer:: array_avr_work2(:,:,:,:,:,:,:)
4677 
4678  integer, pointer:: array_avr_work3(:,:,:,:,:,:,:)
4679 
4680  integer, pointer:: array_avr_work4(:,:,:,:,:,:,:)
4681 
4682  integer, pointer:: array_avr_work5(:,:,:,:,:,:,:)
4683 
4684  integer, pointer:: array_avr_work6(:,:,:,:,:,:,:)
4685 
4686  integer, pointer:: array_avr_work7(:,:,:,:,:,:,:)
4687 
4688 
4689  integer:: array_shape(7)
4690  integer:: i, dim_size
4691  real(DP):: weight_sum
4692  continue
4693 
4694  array_shape = shape( array )
4695  array_avr_work => array
4696 
4697 
4698 
4699 
4700  if ( space_average(1) ) then
4701  dim_size = array_shape(1)
4702  array_shape(1) = 1
4703  allocate( array_avr_work1( array_shape(1) &
4704  & , array_shape(2) &
4705 
4706  & , array_shape(3) &
4707 
4708  & , array_shape(4) &
4709 
4710  & , array_shape(5) &
4711 
4712  & , array_shape(6) &
4713 
4714  & , array_shape(7) &
4715 
4716  & ) )
4717  array_avr_work1 = 0
4718  weight_sum = 0.0_dp
4719  do i = 1, dim_size
4720  array_avr_work1(1,:,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:,:) * weight1(i)
4721  weight_sum = weight_sum + weight1(i)
4722  end do
4723  array_avr_work1 = array_avr_work1 / weight_sum
4724  array_avr_work => array_avr_work1
4725  end if
4726 
4727 
4728 
4729  if ( space_average(2) ) then
4730  dim_size = array_shape(2)
4731  array_shape(2) = 1
4732  allocate( array_avr_work2( array_shape(1) &
4733  & , array_shape(2) &
4734 
4735  & , array_shape(3) &
4736 
4737  & , array_shape(4) &
4738 
4739  & , array_shape(5) &
4740 
4741  & , array_shape(6) &
4742 
4743  & , array_shape(7) &
4744 
4745  & ) )
4746  array_avr_work2 = 0
4747  weight_sum = 0.0_dp
4748  do i = 1, dim_size
4749  array_avr_work2(:,1,:,:,:,:,:) = array_avr_work2(:,1,:,:,:,:,:) + array_avr_work(:,i,:,:,:,:,:) * weight2(i)
4750  weight_sum = weight_sum + weight2(i)
4751  end do
4752  array_avr_work2 = array_avr_work2 / weight_sum
4753  array_avr_work => array_avr_work2
4754  end if
4755 
4756 
4757 
4758  if ( space_average(3) ) then
4759  dim_size = array_shape(3)
4760  array_shape(3) = 1
4761  allocate( array_avr_work3( array_shape(1) &
4762  & , array_shape(2) &
4763 
4764  & , array_shape(3) &
4765 
4766  & , array_shape(4) &
4767 
4768  & , array_shape(5) &
4769 
4770  & , array_shape(6) &
4771 
4772  & , array_shape(7) &
4773 
4774  & ) )
4775  array_avr_work3 = 0
4776  weight_sum = 0.0_dp
4777  do i = 1, dim_size
4778  array_avr_work3(:,:,1,:,:,:,:) = array_avr_work3(:,:,1,:,:,:,:) + array_avr_work(:,:,i,:,:,:,:) * weight3(i)
4779  weight_sum = weight_sum + weight3(i)
4780  end do
4781  array_avr_work3 = array_avr_work3 / weight_sum
4782  array_avr_work => array_avr_work3
4783  end if
4784 
4785 
4786 
4787  if ( space_average(4) ) then
4788  dim_size = array_shape(4)
4789  array_shape(4) = 1
4790  allocate( array_avr_work4( array_shape(1) &
4791  & , array_shape(2) &
4792 
4793  & , array_shape(3) &
4794 
4795  & , array_shape(4) &
4796 
4797  & , array_shape(5) &
4798 
4799  & , array_shape(6) &
4800 
4801  & , array_shape(7) &
4802 
4803  & ) )
4804  array_avr_work4 = 0
4805  weight_sum = 0.0_dp
4806  do i = 1, dim_size
4807  array_avr_work4(:,:,:,1,:,:,:) = array_avr_work4(:,:,:,1,:,:,:) + array_avr_work(:,:,:,i,:,:,:) * weight4(i)
4808  weight_sum = weight_sum + weight4(i)
4809  end do
4810  array_avr_work4 = array_avr_work4 / weight_sum
4811  array_avr_work => array_avr_work4
4812  end if
4813 
4814 
4815 
4816  if ( space_average(5) ) then
4817  dim_size = array_shape(5)
4818  array_shape(5) = 1
4819  allocate( array_avr_work5( array_shape(1) &
4820  & , array_shape(2) &
4821 
4822  & , array_shape(3) &
4823 
4824  & , array_shape(4) &
4825 
4826  & , array_shape(5) &
4827 
4828  & , array_shape(6) &
4829 
4830  & , array_shape(7) &
4831 
4832  & ) )
4833  array_avr_work5 = 0
4834  weight_sum = 0.0_dp
4835  do i = 1, dim_size
4836  array_avr_work5(:,:,:,:,1,:,:) = array_avr_work5(:,:,:,:,1,:,:) + array_avr_work(:,:,:,:,i,:,:) * weight5(i)
4837  weight_sum = weight_sum + weight5(i)
4838  end do
4839  array_avr_work5 = array_avr_work5 / weight_sum
4840  array_avr_work => array_avr_work5
4841  end if
4842 
4843 
4844 
4845  if ( space_average(6) ) then
4846  dim_size = array_shape(6)
4847  array_shape(6) = 1
4848  allocate( array_avr_work6( array_shape(1) &
4849  & , array_shape(2) &
4850 
4851  & , array_shape(3) &
4852 
4853  & , array_shape(4) &
4854 
4855  & , array_shape(5) &
4856 
4857  & , array_shape(6) &
4858 
4859  & , array_shape(7) &
4860 
4861  & ) )
4862  array_avr_work6 = 0
4863  weight_sum = 0.0_dp
4864  do i = 1, dim_size
4865  array_avr_work6(:,:,:,:,:,1,:) = array_avr_work6(:,:,:,:,:,1,:) + array_avr_work(:,:,:,:,:,i,:) * weight6(i)
4866  weight_sum = weight_sum + weight6(i)
4867  end do
4868  array_avr_work6 = array_avr_work6 / weight_sum
4869  array_avr_work => array_avr_work6
4870  end if
4871 
4872 
4873 
4874  if ( space_average(7) ) then
4875  dim_size = array_shape(7)
4876  array_shape(7) = 1
4877  allocate( array_avr_work7( array_shape(1) &
4878  & , array_shape(2) &
4879 
4880  & , array_shape(3) &
4881 
4882  & , array_shape(4) &
4883 
4884  & , array_shape(5) &
4885 
4886  & , array_shape(6) &
4887 
4888  & , array_shape(7) &
4889 
4890  & ) )
4891  array_avr_work7 = 0
4892  weight_sum = 0.0_dp
4893  do i = 1, dim_size
4894  array_avr_work7(:,:,:,:,:,:,1) = array_avr_work7(:,:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,:,i) * weight7(i)
4895  weight_sum = weight_sum + weight7(i)
4896  end do
4897  array_avr_work7 = array_avr_work7 / weight_sum
4898  array_avr_work => array_avr_work7
4899  end if
4900 
4901 
4902 
4903 
4904 
4905 
4906 
4907  allocate( array_avr( array_shape(1) &
4908  & , array_shape(2) &
4909 
4910  & , array_shape(3) &
4911 
4912  & , array_shape(4) &
4913 
4914  & , array_shape(5) &
4915 
4916  & , array_shape(6) &
4917 
4918  & , array_shape(7) &
4919 
4920  & ) )
4921 
4922  array_avr = array_avr_work
4923 
4924  nullify( array_avr_work )
4925 
4926  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
4927 
4928  if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
4929 
4930  if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
4931 
4932  if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
4933 
4934  if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 )
4935 
4936  if ( associated( array_avr_work6 ) ) deallocate( array_avr_work6 )
4937 
4938  if ( associated( array_avr_work7 ) ) deallocate( array_avr_work7 )
4939 
4940 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereducereal1()

subroutine gtool_historyauto_internal::averagereduce::averagereducereal1 ( real, dimension(:), intent(in), target  array,
logical, dimension(1), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real, dimension(:), pointer  array_avr 
)
private

Definition at line 1101 of file gtool_historyauto_internal.f90.

1101  !
1102  ! space_average で .true. に指定された次元に対して,
1103  ! array を平均化して array_avr に返します.
1104  ! 平均化には重み weight1 〜 weight7 が用いられます.
1105  ! array_avr の配列の次元そのものは減りません. その代わり,
1106  ! 平均化された次元の配列のサイズは 1 になります.
1107  !
1108  implicit none
1109  real, intent(in), target:: array(:)
1110  logical, intent(in):: space_average(1)
1111  real(DP), intent(in):: weight1(:)
1112 
1113  real, pointer:: array_avr(:) ! (out)
1114 
1115  real, pointer:: array_avr_work(:)
1116 
1117  real, pointer:: array_avr_work1(:)
1118 
1119 
1120  integer:: array_shape(1)
1121  integer:: i, dim_size
1122  real(DP):: weight_sum
1123  continue
1124 
1125  array_shape = shape( array )
1126  array_avr_work => array
1127 
1128 
1129 
1130 
1131  if ( space_average(1) ) then
1132  dim_size = array_shape(1)
1133  array_shape(1) = 1
1134  allocate( array_avr_work1( array_shape(1) &
1135 
1136  & ) )
1137  array_avr_work1 = 0.0
1138  weight_sum = 0.0_dp
1139  do i = 1, dim_size
1140  array_avr_work1(1) = array_avr_work1(1) + array_avr_work(i) * weight1(i)
1141  weight_sum = weight_sum + weight1(i)
1142  end do
1143  array_avr_work1 = array_avr_work1 / weight_sum
1144  array_avr_work => array_avr_work1
1145  end if
1146 
1147 
1148 
1149 
1150 
1151 
1152 
1153  allocate( array_avr( array_shape(1) &
1154 
1155  & ) )
1156 
1157  array_avr = array_avr_work
1158 
1159  nullify( array_avr_work )
1160 
1161  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
1162 
1163 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereducereal2()

subroutine gtool_historyauto_internal::averagereduce::averagereducereal2 ( real, dimension(:,:), intent(in), target  array,
logical, dimension(2), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), intent(in)  weight2,
real, dimension(:,:), pointer  array_avr 
)
private

Definition at line 1175 of file gtool_historyauto_internal.f90.

1175  !
1176  ! space_average で .true. に指定された次元に対して,
1177  ! array を平均化して array_avr に返します.
1178  ! 平均化には重み weight1 〜 weight7 が用いられます.
1179  ! array_avr の配列の次元そのものは減りません. その代わり,
1180  ! 平均化された次元の配列のサイズは 1 になります.
1181  !
1182  implicit none
1183  real, intent(in), target:: array(:,:)
1184  logical, intent(in):: space_average(2)
1185  real(DP), intent(in):: weight1(:)
1186 
1187  real(DP), intent(in):: weight2(:)
1188 
1189  real, pointer:: array_avr(:,:) ! (out)
1190 
1191  real, pointer:: array_avr_work(:,:)
1192 
1193  real, pointer:: array_avr_work1(:,:)
1194 
1195  real, pointer:: array_avr_work2(:,:)
1196 
1197 
1198  integer:: array_shape(2)
1199  integer:: i, dim_size
1200  real(DP):: weight_sum
1201  continue
1202 
1203  array_shape = shape( array )
1204  array_avr_work => array
1205 
1206 
1207 
1208 
1209  if ( space_average(1) ) then
1210  dim_size = array_shape(1)
1211  array_shape(1) = 1
1212  allocate( array_avr_work1( array_shape(1) &
1213  & , array_shape(2) &
1214 
1215  & ) )
1216  array_avr_work1 = 0.0
1217  weight_sum = 0.0_dp
1218  do i = 1, dim_size
1219  array_avr_work1(1,:) = array_avr_work1(1,:) + array_avr_work(i,:) * weight1(i)
1220  weight_sum = weight_sum + weight1(i)
1221  end do
1222  array_avr_work1 = array_avr_work1 / weight_sum
1223  array_avr_work => array_avr_work1
1224  end if
1225 
1226 
1227 
1228  if ( space_average(2) ) then
1229  dim_size = array_shape(2)
1230  array_shape(2) = 1
1231  allocate( array_avr_work2( array_shape(1) &
1232  & , array_shape(2) &
1233 
1234  & ) )
1235  array_avr_work2 = 0.0
1236  weight_sum = 0.0_dp
1237  do i = 1, dim_size
1238  array_avr_work2(:,1) = array_avr_work2(:,1) + array_avr_work(:,i) * weight2(i)
1239  weight_sum = weight_sum + weight2(i)
1240  end do
1241  array_avr_work2 = array_avr_work2 / weight_sum
1242  array_avr_work => array_avr_work2
1243  end if
1244 
1245 
1246 
1247 
1248 
1249 
1250 
1251  allocate( array_avr( array_shape(1) &
1252  & , array_shape(2) &
1253 
1254  & ) )
1255 
1256  array_avr = array_avr_work
1257 
1258  nullify( array_avr_work )
1259 
1260  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
1261 
1262  if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
1263 
1264 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereducereal3()

subroutine gtool_historyauto_internal::averagereduce::averagereducereal3 ( real, dimension(:,:,:), intent(in), target  array,
logical, dimension(3), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), intent(in)  weight2,
real(dp), dimension(:), intent(in)  weight3,
real, dimension(:,:,:), pointer  array_avr 
)
private

Definition at line 1278 of file gtool_historyauto_internal.f90.

1278  !
1279  ! space_average で .true. に指定された次元に対して,
1280  ! array を平均化して array_avr に返します.
1281  ! 平均化には重み weight1 〜 weight7 が用いられます.
1282  ! array_avr の配列の次元そのものは減りません. その代わり,
1283  ! 平均化された次元の配列のサイズは 1 になります.
1284  !
1285  implicit none
1286  real, intent(in), target:: array(:,:,:)
1287  logical, intent(in):: space_average(3)
1288  real(DP), intent(in):: weight1(:)
1289 
1290  real(DP), intent(in):: weight2(:)
1291 
1292  real(DP), intent(in):: weight3(:)
1293 
1294  real, pointer:: array_avr(:,:,:) ! (out)
1295 
1296  real, pointer:: array_avr_work(:,:,:)
1297 
1298  real, pointer:: array_avr_work1(:,:,:)
1299 
1300  real, pointer:: array_avr_work2(:,:,:)
1301 
1302  real, pointer:: array_avr_work3(:,:,:)
1303 
1304 
1305  integer:: array_shape(3)
1306  integer:: i, dim_size
1307  real(DP):: weight_sum
1308  continue
1309 
1310  array_shape = shape( array )
1311  array_avr_work => array
1312 
1313 
1314 
1315 
1316  if ( space_average(1) ) then
1317  dim_size = array_shape(1)
1318  array_shape(1) = 1
1319  allocate( array_avr_work1( array_shape(1) &
1320  & , array_shape(2) &
1321 
1322  & , array_shape(3) &
1323 
1324  & ) )
1325  array_avr_work1 = 0.0
1326  weight_sum = 0.0_dp
1327  do i = 1, dim_size
1328  array_avr_work1(1,:,:) = array_avr_work1(1,:,:) + array_avr_work(i,:,:) * weight1(i)
1329  weight_sum = weight_sum + weight1(i)
1330  end do
1331  array_avr_work1 = array_avr_work1 / weight_sum
1332  array_avr_work => array_avr_work1
1333  end if
1334 
1335 
1336 
1337  if ( space_average(2) ) then
1338  dim_size = array_shape(2)
1339  array_shape(2) = 1
1340  allocate( array_avr_work2( array_shape(1) &
1341  & , array_shape(2) &
1342 
1343  & , array_shape(3) &
1344 
1345  & ) )
1346  array_avr_work2 = 0.0
1347  weight_sum = 0.0_dp
1348  do i = 1, dim_size
1349  array_avr_work2(:,1,:) = array_avr_work2(:,1,:) + array_avr_work(:,i,:) * weight2(i)
1350  weight_sum = weight_sum + weight2(i)
1351  end do
1352  array_avr_work2 = array_avr_work2 / weight_sum
1353  array_avr_work => array_avr_work2
1354  end if
1355 
1356 
1357 
1358  if ( space_average(3) ) then
1359  dim_size = array_shape(3)
1360  array_shape(3) = 1
1361  allocate( array_avr_work3( array_shape(1) &
1362  & , array_shape(2) &
1363 
1364  & , array_shape(3) &
1365 
1366  & ) )
1367  array_avr_work3 = 0.0
1368  weight_sum = 0.0_dp
1369  do i = 1, dim_size
1370  array_avr_work3(:,:,1) = array_avr_work3(:,:,1) + array_avr_work(:,:,i) * weight3(i)
1371  weight_sum = weight_sum + weight3(i)
1372  end do
1373  array_avr_work3 = array_avr_work3 / weight_sum
1374  array_avr_work => array_avr_work3
1375  end if
1376 
1377 
1378 
1379 
1380 
1381 
1382 
1383  allocate( array_avr( array_shape(1) &
1384  & , array_shape(2) &
1385 
1386  & , array_shape(3) &
1387 
1388  & ) )
1389 
1390  array_avr = array_avr_work
1391 
1392  nullify( array_avr_work )
1393 
1394  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
1395 
1396  if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
1397 
1398  if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
1399 
1400 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereducereal4()

subroutine gtool_historyauto_internal::averagereduce::averagereducereal4 ( real, dimension(:,:,:,:), intent(in), target  array,
logical, dimension(4), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), intent(in)  weight2,
real(dp), dimension(:), intent(in)  weight3,
real(dp), dimension(:), intent(in)  weight4,
real, dimension(:,:,:,:), pointer  array_avr 
)
private

Definition at line 1416 of file gtool_historyauto_internal.f90.

1416  !
1417  ! space_average で .true. に指定された次元に対して,
1418  ! array を平均化して array_avr に返します.
1419  ! 平均化には重み weight1 〜 weight7 が用いられます.
1420  ! array_avr の配列の次元そのものは減りません. その代わり,
1421  ! 平均化された次元の配列のサイズは 1 になります.
1422  !
1423  implicit none
1424  real, intent(in), target:: array(:,:,:,:)
1425  logical, intent(in):: space_average(4)
1426  real(DP), intent(in):: weight1(:)
1427 
1428  real(DP), intent(in):: weight2(:)
1429 
1430  real(DP), intent(in):: weight3(:)
1431 
1432  real(DP), intent(in):: weight4(:)
1433 
1434  real, pointer:: array_avr(:,:,:,:) ! (out)
1435 
1436  real, pointer:: array_avr_work(:,:,:,:)
1437 
1438  real, pointer:: array_avr_work1(:,:,:,:)
1439 
1440  real, pointer:: array_avr_work2(:,:,:,:)
1441 
1442  real, pointer:: array_avr_work3(:,:,:,:)
1443 
1444  real, pointer:: array_avr_work4(:,:,:,:)
1445 
1446 
1447  integer:: array_shape(4)
1448  integer:: i, dim_size
1449  real(DP):: weight_sum
1450  continue
1451 
1452  array_shape = shape( array )
1453  array_avr_work => array
1454 
1455 
1456 
1457 
1458  if ( space_average(1) ) then
1459  dim_size = array_shape(1)
1460  array_shape(1) = 1
1461  allocate( array_avr_work1( array_shape(1) &
1462  & , array_shape(2) &
1463 
1464  & , array_shape(3) &
1465 
1466  & , array_shape(4) &
1467 
1468  & ) )
1469  array_avr_work1 = 0.0
1470  weight_sum = 0.0_dp
1471  do i = 1, dim_size
1472  array_avr_work1(1,:,:,:) = array_avr_work1(1,:,:,:) + array_avr_work(i,:,:,:) * weight1(i)
1473  weight_sum = weight_sum + weight1(i)
1474  end do
1475  array_avr_work1 = array_avr_work1 / weight_sum
1476  array_avr_work => array_avr_work1
1477  end if
1478 
1479 
1480 
1481  if ( space_average(2) ) then
1482  dim_size = array_shape(2)
1483  array_shape(2) = 1
1484  allocate( array_avr_work2( array_shape(1) &
1485  & , array_shape(2) &
1486 
1487  & , array_shape(3) &
1488 
1489  & , array_shape(4) &
1490 
1491  & ) )
1492  array_avr_work2 = 0.0
1493  weight_sum = 0.0_dp
1494  do i = 1, dim_size
1495  array_avr_work2(:,1,:,:) = array_avr_work2(:,1,:,:) + array_avr_work(:,i,:,:) * weight2(i)
1496  weight_sum = weight_sum + weight2(i)
1497  end do
1498  array_avr_work2 = array_avr_work2 / weight_sum
1499  array_avr_work => array_avr_work2
1500  end if
1501 
1502 
1503 
1504  if ( space_average(3) ) then
1505  dim_size = array_shape(3)
1506  array_shape(3) = 1
1507  allocate( array_avr_work3( array_shape(1) &
1508  & , array_shape(2) &
1509 
1510  & , array_shape(3) &
1511 
1512  & , array_shape(4) &
1513 
1514  & ) )
1515  array_avr_work3 = 0.0
1516  weight_sum = 0.0_dp
1517  do i = 1, dim_size
1518  array_avr_work3(:,:,1,:) = array_avr_work3(:,:,1,:) + array_avr_work(:,:,i,:) * weight3(i)
1519  weight_sum = weight_sum + weight3(i)
1520  end do
1521  array_avr_work3 = array_avr_work3 / weight_sum
1522  array_avr_work => array_avr_work3
1523  end if
1524 
1525 
1526 
1527  if ( space_average(4) ) then
1528  dim_size = array_shape(4)
1529  array_shape(4) = 1
1530  allocate( array_avr_work4( array_shape(1) &
1531  & , array_shape(2) &
1532 
1533  & , array_shape(3) &
1534 
1535  & , array_shape(4) &
1536 
1537  & ) )
1538  array_avr_work4 = 0.0
1539  weight_sum = 0.0_dp
1540  do i = 1, dim_size
1541  array_avr_work4(:,:,:,1) = array_avr_work4(:,:,:,1) + array_avr_work(:,:,:,i) * weight4(i)
1542  weight_sum = weight_sum + weight4(i)
1543  end do
1544  array_avr_work4 = array_avr_work4 / weight_sum
1545  array_avr_work => array_avr_work4
1546  end if
1547 
1548 
1549 
1550 
1551 
1552 
1553 
1554  allocate( array_avr( array_shape(1) &
1555  & , array_shape(2) &
1556 
1557  & , array_shape(3) &
1558 
1559  & , array_shape(4) &
1560 
1561  & ) )
1562 
1563  array_avr = array_avr_work
1564 
1565  nullify( array_avr_work )
1566 
1567  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
1568 
1569  if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
1570 
1571  if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
1572 
1573  if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
1574 
1575 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereducereal5()

subroutine gtool_historyauto_internal::averagereduce::averagereducereal5 ( real, dimension(:,:,:,:,:), intent(in), target  array,
logical, dimension(5), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), intent(in)  weight2,
real(dp), dimension(:), intent(in)  weight3,
real(dp), dimension(:), intent(in)  weight4,
real(dp), dimension(:), intent(in)  weight5,
real, dimension(:,:,:,:,:), pointer  array_avr 
)
private

Definition at line 1593 of file gtool_historyauto_internal.f90.

1593  !
1594  ! space_average で .true. に指定された次元に対して,
1595  ! array を平均化して array_avr に返します.
1596  ! 平均化には重み weight1 〜 weight7 が用いられます.
1597  ! array_avr の配列の次元そのものは減りません. その代わり,
1598  ! 平均化された次元の配列のサイズは 1 になります.
1599  !
1600  implicit none
1601  real, intent(in), target:: array(:,:,:,:,:)
1602  logical, intent(in):: space_average(5)
1603  real(DP), intent(in):: weight1(:)
1604 
1605  real(DP), intent(in):: weight2(:)
1606 
1607  real(DP), intent(in):: weight3(:)
1608 
1609  real(DP), intent(in):: weight4(:)
1610 
1611  real(DP), intent(in):: weight5(:)
1612 
1613  real, pointer:: array_avr(:,:,:,:,:) ! (out)
1614 
1615  real, pointer:: array_avr_work(:,:,:,:,:)
1616 
1617  real, pointer:: array_avr_work1(:,:,:,:,:)
1618 
1619  real, pointer:: array_avr_work2(:,:,:,:,:)
1620 
1621  real, pointer:: array_avr_work3(:,:,:,:,:)
1622 
1623  real, pointer:: array_avr_work4(:,:,:,:,:)
1624 
1625  real, pointer:: array_avr_work5(:,:,:,:,:)
1626 
1627 
1628  integer:: array_shape(5)
1629  integer:: i, dim_size
1630  real(DP):: weight_sum
1631  continue
1632 
1633  array_shape = shape( array )
1634  array_avr_work => array
1635 
1636 
1637 
1638 
1639  if ( space_average(1) ) then
1640  dim_size = array_shape(1)
1641  array_shape(1) = 1
1642  allocate( array_avr_work1( array_shape(1) &
1643  & , array_shape(2) &
1644 
1645  & , array_shape(3) &
1646 
1647  & , array_shape(4) &
1648 
1649  & , array_shape(5) &
1650 
1651  & ) )
1652  array_avr_work1 = 0.0
1653  weight_sum = 0.0_dp
1654  do i = 1, dim_size
1655  array_avr_work1(1,:,:,:,:) = array_avr_work1(1,:,:,:,:) + array_avr_work(i,:,:,:,:) * weight1(i)
1656  weight_sum = weight_sum + weight1(i)
1657  end do
1658  array_avr_work1 = array_avr_work1 / weight_sum
1659  array_avr_work => array_avr_work1
1660  end if
1661 
1662 
1663 
1664  if ( space_average(2) ) then
1665  dim_size = array_shape(2)
1666  array_shape(2) = 1
1667  allocate( array_avr_work2( array_shape(1) &
1668  & , array_shape(2) &
1669 
1670  & , array_shape(3) &
1671 
1672  & , array_shape(4) &
1673 
1674  & , array_shape(5) &
1675 
1676  & ) )
1677  array_avr_work2 = 0.0
1678  weight_sum = 0.0_dp
1679  do i = 1, dim_size
1680  array_avr_work2(:,1,:,:,:) = array_avr_work2(:,1,:,:,:) + array_avr_work(:,i,:,:,:) * weight2(i)
1681  weight_sum = weight_sum + weight2(i)
1682  end do
1683  array_avr_work2 = array_avr_work2 / weight_sum
1684  array_avr_work => array_avr_work2
1685  end if
1686 
1687 
1688 
1689  if ( space_average(3) ) then
1690  dim_size = array_shape(3)
1691  array_shape(3) = 1
1692  allocate( array_avr_work3( array_shape(1) &
1693  & , array_shape(2) &
1694 
1695  & , array_shape(3) &
1696 
1697  & , array_shape(4) &
1698 
1699  & , array_shape(5) &
1700 
1701  & ) )
1702  array_avr_work3 = 0.0
1703  weight_sum = 0.0_dp
1704  do i = 1, dim_size
1705  array_avr_work3(:,:,1,:,:) = array_avr_work3(:,:,1,:,:) + array_avr_work(:,:,i,:,:) * weight3(i)
1706  weight_sum = weight_sum + weight3(i)
1707  end do
1708  array_avr_work3 = array_avr_work3 / weight_sum
1709  array_avr_work => array_avr_work3
1710  end if
1711 
1712 
1713 
1714  if ( space_average(4) ) then
1715  dim_size = array_shape(4)
1716  array_shape(4) = 1
1717  allocate( array_avr_work4( array_shape(1) &
1718  & , array_shape(2) &
1719 
1720  & , array_shape(3) &
1721 
1722  & , array_shape(4) &
1723 
1724  & , array_shape(5) &
1725 
1726  & ) )
1727  array_avr_work4 = 0.0
1728  weight_sum = 0.0_dp
1729  do i = 1, dim_size
1730  array_avr_work4(:,:,:,1,:) = array_avr_work4(:,:,:,1,:) + array_avr_work(:,:,:,i,:) * weight4(i)
1731  weight_sum = weight_sum + weight4(i)
1732  end do
1733  array_avr_work4 = array_avr_work4 / weight_sum
1734  array_avr_work => array_avr_work4
1735  end if
1736 
1737 
1738 
1739  if ( space_average(5) ) then
1740  dim_size = array_shape(5)
1741  array_shape(5) = 1
1742  allocate( array_avr_work5( array_shape(1) &
1743  & , array_shape(2) &
1744 
1745  & , array_shape(3) &
1746 
1747  & , array_shape(4) &
1748 
1749  & , array_shape(5) &
1750 
1751  & ) )
1752  array_avr_work5 = 0.0
1753  weight_sum = 0.0_dp
1754  do i = 1, dim_size
1755  array_avr_work5(:,:,:,:,1) = array_avr_work5(:,:,:,:,1) + array_avr_work(:,:,:,:,i) * weight5(i)
1756  weight_sum = weight_sum + weight5(i)
1757  end do
1758  array_avr_work5 = array_avr_work5 / weight_sum
1759  array_avr_work => array_avr_work5
1760  end if
1761 
1762 
1763 
1764 
1765 
1766 
1767 
1768  allocate( array_avr( array_shape(1) &
1769  & , array_shape(2) &
1770 
1771  & , array_shape(3) &
1772 
1773  & , array_shape(4) &
1774 
1775  & , array_shape(5) &
1776 
1777  & ) )
1778 
1779  array_avr = array_avr_work
1780 
1781  nullify( array_avr_work )
1782 
1783  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
1784 
1785  if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
1786 
1787  if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
1788 
1789  if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
1790 
1791  if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 )
1792 
1793 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereducereal6()

subroutine gtool_historyauto_internal::averagereduce::averagereducereal6 ( real, dimension(:,:,:,:,:,:), intent(in), target  array,
logical, dimension(6), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), intent(in)  weight2,
real(dp), dimension(:), intent(in)  weight3,
real(dp), dimension(:), intent(in)  weight4,
real(dp), dimension(:), intent(in)  weight5,
real(dp), dimension(:), intent(in)  weight6,
real, dimension(:,:,:,:,:,:), pointer  array_avr 
)
private

Definition at line 1813 of file gtool_historyauto_internal.f90.

1813  !
1814  ! space_average で .true. に指定された次元に対して,
1815  ! array を平均化して array_avr に返します.
1816  ! 平均化には重み weight1 〜 weight7 が用いられます.
1817  ! array_avr の配列の次元そのものは減りません. その代わり,
1818  ! 平均化された次元の配列のサイズは 1 になります.
1819  !
1820  implicit none
1821  real, intent(in), target:: array(:,:,:,:,:,:)
1822  logical, intent(in):: space_average(6)
1823  real(DP), intent(in):: weight1(:)
1824 
1825  real(DP), intent(in):: weight2(:)
1826 
1827  real(DP), intent(in):: weight3(:)
1828 
1829  real(DP), intent(in):: weight4(:)
1830 
1831  real(DP), intent(in):: weight5(:)
1832 
1833  real(DP), intent(in):: weight6(:)
1834 
1835  real, pointer:: array_avr(:,:,:,:,:,:) ! (out)
1836 
1837  real, pointer:: array_avr_work(:,:,:,:,:,:)
1838 
1839  real, pointer:: array_avr_work1(:,:,:,:,:,:)
1840 
1841  real, pointer:: array_avr_work2(:,:,:,:,:,:)
1842 
1843  real, pointer:: array_avr_work3(:,:,:,:,:,:)
1844 
1845  real, pointer:: array_avr_work4(:,:,:,:,:,:)
1846 
1847  real, pointer:: array_avr_work5(:,:,:,:,:,:)
1848 
1849  real, pointer:: array_avr_work6(:,:,:,:,:,:)
1850 
1851 
1852  integer:: array_shape(6)
1853  integer:: i, dim_size
1854  real(DP):: weight_sum
1855  continue
1856 
1857  array_shape = shape( array )
1858  array_avr_work => array
1859 
1860 
1861 
1862 
1863  if ( space_average(1) ) then
1864  dim_size = array_shape(1)
1865  array_shape(1) = 1
1866  allocate( array_avr_work1( array_shape(1) &
1867  & , array_shape(2) &
1868 
1869  & , array_shape(3) &
1870 
1871  & , array_shape(4) &
1872 
1873  & , array_shape(5) &
1874 
1875  & , array_shape(6) &
1876 
1877  & ) )
1878  array_avr_work1 = 0.0
1879  weight_sum = 0.0_dp
1880  do i = 1, dim_size
1881  array_avr_work1(1,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:) * weight1(i)
1882  weight_sum = weight_sum + weight1(i)
1883  end do
1884  array_avr_work1 = array_avr_work1 / weight_sum
1885  array_avr_work => array_avr_work1
1886  end if
1887 
1888 
1889 
1890  if ( space_average(2) ) then
1891  dim_size = array_shape(2)
1892  array_shape(2) = 1
1893  allocate( array_avr_work2( array_shape(1) &
1894  & , array_shape(2) &
1895 
1896  & , array_shape(3) &
1897 
1898  & , array_shape(4) &
1899 
1900  & , array_shape(5) &
1901 
1902  & , array_shape(6) &
1903 
1904  & ) )
1905  array_avr_work2 = 0.0
1906  weight_sum = 0.0_dp
1907  do i = 1, dim_size
1908  array_avr_work2(:,1,:,:,:,:) = array_avr_work2(:,1,:,:,:,:) + array_avr_work(:,i,:,:,:,:) * weight2(i)
1909  weight_sum = weight_sum + weight2(i)
1910  end do
1911  array_avr_work2 = array_avr_work2 / weight_sum
1912  array_avr_work => array_avr_work2
1913  end if
1914 
1915 
1916 
1917  if ( space_average(3) ) then
1918  dim_size = array_shape(3)
1919  array_shape(3) = 1
1920  allocate( array_avr_work3( array_shape(1) &
1921  & , array_shape(2) &
1922 
1923  & , array_shape(3) &
1924 
1925  & , array_shape(4) &
1926 
1927  & , array_shape(5) &
1928 
1929  & , array_shape(6) &
1930 
1931  & ) )
1932  array_avr_work3 = 0.0
1933  weight_sum = 0.0_dp
1934  do i = 1, dim_size
1935  array_avr_work3(:,:,1,:,:,:) = array_avr_work3(:,:,1,:,:,:) + array_avr_work(:,:,i,:,:,:) * weight3(i)
1936  weight_sum = weight_sum + weight3(i)
1937  end do
1938  array_avr_work3 = array_avr_work3 / weight_sum
1939  array_avr_work => array_avr_work3
1940  end if
1941 
1942 
1943 
1944  if ( space_average(4) ) then
1945  dim_size = array_shape(4)
1946  array_shape(4) = 1
1947  allocate( array_avr_work4( array_shape(1) &
1948  & , array_shape(2) &
1949 
1950  & , array_shape(3) &
1951 
1952  & , array_shape(4) &
1953 
1954  & , array_shape(5) &
1955 
1956  & , array_shape(6) &
1957 
1958  & ) )
1959  array_avr_work4 = 0.0
1960  weight_sum = 0.0_dp
1961  do i = 1, dim_size
1962  array_avr_work4(:,:,:,1,:,:) = array_avr_work4(:,:,:,1,:,:) + array_avr_work(:,:,:,i,:,:) * weight4(i)
1963  weight_sum = weight_sum + weight4(i)
1964  end do
1965  array_avr_work4 = array_avr_work4 / weight_sum
1966  array_avr_work => array_avr_work4
1967  end if
1968 
1969 
1970 
1971  if ( space_average(5) ) then
1972  dim_size = array_shape(5)
1973  array_shape(5) = 1
1974  allocate( array_avr_work5( array_shape(1) &
1975  & , array_shape(2) &
1976 
1977  & , array_shape(3) &
1978 
1979  & , array_shape(4) &
1980 
1981  & , array_shape(5) &
1982 
1983  & , array_shape(6) &
1984 
1985  & ) )
1986  array_avr_work5 = 0.0
1987  weight_sum = 0.0_dp
1988  do i = 1, dim_size
1989  array_avr_work5(:,:,:,:,1,:) = array_avr_work5(:,:,:,:,1,:) + array_avr_work(:,:,:,:,i,:) * weight5(i)
1990  weight_sum = weight_sum + weight5(i)
1991  end do
1992  array_avr_work5 = array_avr_work5 / weight_sum
1993  array_avr_work => array_avr_work5
1994  end if
1995 
1996 
1997 
1998  if ( space_average(6) ) then
1999  dim_size = array_shape(6)
2000  array_shape(6) = 1
2001  allocate( array_avr_work6( array_shape(1) &
2002  & , array_shape(2) &
2003 
2004  & , array_shape(3) &
2005 
2006  & , array_shape(4) &
2007 
2008  & , array_shape(5) &
2009 
2010  & , array_shape(6) &
2011 
2012  & ) )
2013  array_avr_work6 = 0.0
2014  weight_sum = 0.0_dp
2015  do i = 1, dim_size
2016  array_avr_work6(:,:,:,:,:,1) = array_avr_work6(:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,i) * weight6(i)
2017  weight_sum = weight_sum + weight6(i)
2018  end do
2019  array_avr_work6 = array_avr_work6 / weight_sum
2020  array_avr_work => array_avr_work6
2021  end if
2022 
2023 
2024 
2025 
2026 
2027 
2028 
2029  allocate( array_avr( array_shape(1) &
2030  & , array_shape(2) &
2031 
2032  & , array_shape(3) &
2033 
2034  & , array_shape(4) &
2035 
2036  & , array_shape(5) &
2037 
2038  & , array_shape(6) &
2039 
2040  & ) )
2041 
2042  array_avr = array_avr_work
2043 
2044  nullify( array_avr_work )
2045 
2046  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
2047 
2048  if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
2049 
2050  if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
2051 
2052  if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
2053 
2054  if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 )
2055 
2056  if ( associated( array_avr_work6 ) ) deallocate( array_avr_work6 )
2057 
2058 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42

◆ averagereducereal7()

subroutine gtool_historyauto_internal::averagereduce::averagereducereal7 ( real, dimension(:,:,:,:,:,:,:), intent(in), target  array,
logical, dimension(7), intent(in)  space_average,
real(dp), dimension(:), intent(in)  weight1,
real(dp), dimension(:), intent(in)  weight2,
real(dp), dimension(:), intent(in)  weight3,
real(dp), dimension(:), intent(in)  weight4,
real(dp), dimension(:), intent(in)  weight5,
real(dp), dimension(:), intent(in)  weight6,
real(dp), dimension(:), intent(in)  weight7,
real, dimension(:,:,:,:,:,:,:), pointer  array_avr 
)
private

Definition at line 2080 of file gtool_historyauto_internal.f90.

2080  !
2081  ! space_average で .true. に指定された次元に対して,
2082  ! array を平均化して array_avr に返します.
2083  ! 平均化には重み weight1 〜 weight7 が用いられます.
2084  ! array_avr の配列の次元そのものは減りません. その代わり,
2085  ! 平均化された次元の配列のサイズは 1 になります.
2086  !
2087  implicit none
2088  real, intent(in), target:: array(:,:,:,:,:,:,:)
2089  logical, intent(in):: space_average(7)
2090  real(DP), intent(in):: weight1(:)
2091 
2092  real(DP), intent(in):: weight2(:)
2093 
2094  real(DP), intent(in):: weight3(:)
2095 
2096  real(DP), intent(in):: weight4(:)
2097 
2098  real(DP), intent(in):: weight5(:)
2099 
2100  real(DP), intent(in):: weight6(:)
2101 
2102  real(DP), intent(in):: weight7(:)
2103 
2104  real, pointer:: array_avr(:,:,:,:,:,:,:) ! (out)
2105 
2106  real, pointer:: array_avr_work(:,:,:,:,:,:,:)
2107 
2108  real, pointer:: array_avr_work1(:,:,:,:,:,:,:)
2109 
2110  real, pointer:: array_avr_work2(:,:,:,:,:,:,:)
2111 
2112  real, pointer:: array_avr_work3(:,:,:,:,:,:,:)
2113 
2114  real, pointer:: array_avr_work4(:,:,:,:,:,:,:)
2115 
2116  real, pointer:: array_avr_work5(:,:,:,:,:,:,:)
2117 
2118  real, pointer:: array_avr_work6(:,:,:,:,:,:,:)
2119 
2120  real, pointer:: array_avr_work7(:,:,:,:,:,:,:)
2121 
2122 
2123  integer:: array_shape(7)
2124  integer:: i, dim_size
2125  real(DP):: weight_sum
2126  continue
2127 
2128  array_shape = shape( array )
2129  array_avr_work => array
2130 
2131 
2132 
2133 
2134  if ( space_average(1) ) then
2135  dim_size = array_shape(1)
2136  array_shape(1) = 1
2137  allocate( array_avr_work1( array_shape(1) &
2138  & , array_shape(2) &
2139 
2140  & , array_shape(3) &
2141 
2142  & , array_shape(4) &
2143 
2144  & , array_shape(5) &
2145 
2146  & , array_shape(6) &
2147 
2148  & , array_shape(7) &
2149 
2150  & ) )
2151  array_avr_work1 = 0.0
2152  weight_sum = 0.0_dp
2153  do i = 1, dim_size
2154  array_avr_work1(1,:,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:,:) * weight1(i)
2155  weight_sum = weight_sum + weight1(i)
2156  end do
2157  array_avr_work1 = array_avr_work1 / weight_sum
2158  array_avr_work => array_avr_work1
2159  end if
2160 
2161 
2162 
2163  if ( space_average(2) ) then
2164  dim_size = array_shape(2)
2165  array_shape(2) = 1
2166  allocate( array_avr_work2( array_shape(1) &
2167  & , array_shape(2) &
2168 
2169  & , array_shape(3) &
2170 
2171  & , array_shape(4) &
2172 
2173  & , array_shape(5) &
2174 
2175  & , array_shape(6) &
2176 
2177  & , array_shape(7) &
2178 
2179  & ) )
2180  array_avr_work2 = 0.0
2181  weight_sum = 0.0_dp
2182  do i = 1, dim_size
2183  array_avr_work2(:,1,:,:,:,:,:) = array_avr_work2(:,1,:,:,:,:,:) + array_avr_work(:,i,:,:,:,:,:) * weight2(i)
2184  weight_sum = weight_sum + weight2(i)
2185  end do
2186  array_avr_work2 = array_avr_work2 / weight_sum
2187  array_avr_work => array_avr_work2
2188  end if
2189 
2190 
2191 
2192  if ( space_average(3) ) then
2193  dim_size = array_shape(3)
2194  array_shape(3) = 1
2195  allocate( array_avr_work3( array_shape(1) &
2196  & , array_shape(2) &
2197 
2198  & , array_shape(3) &
2199 
2200  & , array_shape(4) &
2201 
2202  & , array_shape(5) &
2203 
2204  & , array_shape(6) &
2205 
2206  & , array_shape(7) &
2207 
2208  & ) )
2209  array_avr_work3 = 0.0
2210  weight_sum = 0.0_dp
2211  do i = 1, dim_size
2212  array_avr_work3(:,:,1,:,:,:,:) = array_avr_work3(:,:,1,:,:,:,:) + array_avr_work(:,:,i,:,:,:,:) * weight3(i)
2213  weight_sum = weight_sum + weight3(i)
2214  end do
2215  array_avr_work3 = array_avr_work3 / weight_sum
2216  array_avr_work => array_avr_work3
2217  end if
2218 
2219 
2220 
2221  if ( space_average(4) ) then
2222  dim_size = array_shape(4)
2223  array_shape(4) = 1
2224  allocate( array_avr_work4( array_shape(1) &
2225  & , array_shape(2) &
2226 
2227  & , array_shape(3) &
2228 
2229  & , array_shape(4) &
2230 
2231  & , array_shape(5) &
2232 
2233  & , array_shape(6) &
2234 
2235  & , array_shape(7) &
2236 
2237  & ) )
2238  array_avr_work4 = 0.0
2239  weight_sum = 0.0_dp
2240  do i = 1, dim_size
2241  array_avr_work4(:,:,:,1,:,:,:) = array_avr_work4(:,:,:,1,:,:,:) + array_avr_work(:,:,:,i,:,:,:) * weight4(i)
2242  weight_sum = weight_sum + weight4(i)
2243  end do
2244  array_avr_work4 = array_avr_work4 / weight_sum
2245  array_avr_work => array_avr_work4
2246  end if
2247 
2248 
2249 
2250  if ( space_average(5) ) then
2251  dim_size = array_shape(5)
2252  array_shape(5) = 1
2253  allocate( array_avr_work5( array_shape(1) &
2254  & , array_shape(2) &
2255 
2256  & , array_shape(3) &
2257 
2258  & , array_shape(4) &
2259 
2260  & , array_shape(5) &
2261 
2262  & , array_shape(6) &
2263 
2264  & , array_shape(7) &
2265 
2266  & ) )
2267  array_avr_work5 = 0.0
2268  weight_sum = 0.0_dp
2269  do i = 1, dim_size
2270  array_avr_work5(:,:,:,:,1,:,:) = array_avr_work5(:,:,:,:,1,:,:) + array_avr_work(:,:,:,:,i,:,:) * weight5(i)
2271  weight_sum = weight_sum + weight5(i)
2272  end do
2273  array_avr_work5 = array_avr_work5 / weight_sum
2274  array_avr_work => array_avr_work5
2275  end if
2276 
2277 
2278 
2279  if ( space_average(6) ) then
2280  dim_size = array_shape(6)
2281  array_shape(6) = 1
2282  allocate( array_avr_work6( array_shape(1) &
2283  & , array_shape(2) &
2284 
2285  & , array_shape(3) &
2286 
2287  & , array_shape(4) &
2288 
2289  & , array_shape(5) &
2290 
2291  & , array_shape(6) &
2292 
2293  & , array_shape(7) &
2294 
2295  & ) )
2296  array_avr_work6 = 0.0
2297  weight_sum = 0.0_dp
2298  do i = 1, dim_size
2299  array_avr_work6(:,:,:,:,:,1,:) = array_avr_work6(:,:,:,:,:,1,:) + array_avr_work(:,:,:,:,:,i,:) * weight6(i)
2300  weight_sum = weight_sum + weight6(i)
2301  end do
2302  array_avr_work6 = array_avr_work6 / weight_sum
2303  array_avr_work => array_avr_work6
2304  end if
2305 
2306 
2307 
2308  if ( space_average(7) ) then
2309  dim_size = array_shape(7)
2310  array_shape(7) = 1
2311  allocate( array_avr_work7( array_shape(1) &
2312  & , array_shape(2) &
2313 
2314  & , array_shape(3) &
2315 
2316  & , array_shape(4) &
2317 
2318  & , array_shape(5) &
2319 
2320  & , array_shape(6) &
2321 
2322  & , array_shape(7) &
2323 
2324  & ) )
2325  array_avr_work7 = 0.0
2326  weight_sum = 0.0_dp
2327  do i = 1, dim_size
2328  array_avr_work7(:,:,:,:,:,:,1) = array_avr_work7(:,:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,:,i) * weight7(i)
2329  weight_sum = weight_sum + weight7(i)
2330  end do
2331  array_avr_work7 = array_avr_work7 / weight_sum
2332  array_avr_work => array_avr_work7
2333  end if
2334 
2335 
2336 
2337 
2338 
2339 
2340 
2341  allocate( array_avr( array_shape(1) &
2342  & , array_shape(2) &
2343 
2344  & , array_shape(3) &
2345 
2346  & , array_shape(4) &
2347 
2348  & , array_shape(5) &
2349 
2350  & , array_shape(6) &
2351 
2352  & , array_shape(7) &
2353 
2354  & ) )
2355 
2356  array_avr = array_avr_work
2357 
2358  nullify( array_avr_work )
2359 
2360  if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
2361 
2362  if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
2363 
2364  if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
2365 
2366  if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
2367 
2368  if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 )
2369 
2370  if ( associated( array_avr_work6 ) ) deallocate( array_avr_work6 )
2371 
2372  if ( associated( array_avr_work7 ) ) deallocate( array_avr_work7 )
2373 
2374 
dcunits_com::i
integer, save, private i
Definition: dcunits_com.f90:42
The documentation for this interface was generated from the following file: