646 & gthist, & ! (inout)
655 use dc_date,
only: dcdifftimecreate, evalbyunit
661 & historycreate, historyaddvariable, historyaddattr, &
662 & historyinitialized, historyput, historyputaxismpi, &
663 & historyaxiscreate, historyaxisinquire, historyaxiscopy, &
664 & historyvarinfoinquire, historyvarinfocreate, &
665 & historyvarinfocopy, historyvarinfoinitialized, &
666 & historyvarinfoclear
669 type(gt_history),
intent(inout):: gthist
672 character(*),
intent(in):: varname
675 real(DP),
intent(in):: time
678 character(TOKEN):: interval_unit
681 real(DP):: origin_value
684 character(TOKEN):: origin_unit
688 real(DP):: origin_sec
689 integer:: newfile_intvalue
690 real(DP):: newfile_intvalued
693 character(TOKEN):: newfile_intunit
697 character(STRING):: file, file_base, file_suffix, file_newfile_time, file_rank
700 integer:: stat, i, j, k, vnum, numdims_slice, dim_size, cnt
701 character(STRING):: name, units, longname, cause_c, wgt_name
702 character(TOKEN):: xtype
703 type(gt_history_axis):: gthst_axes_time
704 type(gt_history_axis),
pointer:: gthst_axes_slices(:) =>null()
707 real(DP):: wgt_sum, wgt_sum_s
708 logical:: slice_valid
709 integer:: slice_start(1:numdims-1)
712 integer:: slice_end(1:numdims-1)
715 integer:: slice_stride(1:numdims-1)
719 character(*),
parameter:: subname =
"HstFileCreate"
721 call beginsub(subname,
'varname=%c', c1 = trim(varname) )
730 call historyvarinfoinquire( &
733 if ( trim(varname) == trim(name) ) vnum = i
736 if ( vnum == 0 )
then
756 & interval_unit = interval_unit )
758 call historyaxiscopy( &
761 & units = trim(interval_unit) //
' ' // &
770 & slice_start = slice_start, &
771 & slice_end = slice_end, &
772 & slice_stride = slice_stride )
777 if ( .not. historyinitialized( gthist ) )
then
779 if ( all( slice_start == (/ ( 1, i = 1, numdims -1 ) /) ) &
780 & .and. all( slice_end < (/ ( 1, i = 1, numdims -1 ) /) ) &
781 & .and. all( slice_stride == (/ ( 1, i = 1, numdims -1 ) /) ) )
then
783 allocate( gthst_axes_slices(1:numdims) )
784 gthst_axes_slices(1:numdims-1) =
gthst_axes(1:numdims-1)
785 gthst_axes_slices(numdims:numdims) = gthst_axes_time
789 slice_valid = .false.
792 allocate( gthst_axes_slices(1:numdims) )
793 allocate( data_axes_slices(1:numdims) )
794 allocate( data_weights_slices(1:numdims) )
801 if ( slice_start(i) < 1 )
then
803 cause_c =
cprintf(
'slice_start=%d', &
804 & i = (/ slice_start(i) /) )
808 if ( slice_stride(i) < 1 )
then
810 cause_c =
cprintf(
'slice_stride=%d', &
811 & i = (/ slice_stride(i) /) )
818 if ( ( slice_start(i) == 1 ) &
819 & .and. ( slice_end(i) < 1 ) &
820 & .and. ( slice_stride(i) == 1 ) )
then
822 call historyaxiscopy( &
823 & axis_dest = gthst_axes_slices(i) , &
834 call historyaxisinquire( &
838 & longname = longname, &
843 if ( slice_end(i) < 1 ) slice_end(i) = dim_size
844 if ( slice_end(i) > dim_size )
then
846 &
'slice options to (%c) are undesirable ' // &
847 &
'(@slice_end=%d). @slice_end is corrected forcibly to (%d) ', &
849 & i = (/ slice_end(i), dim_size /) )
851 slice_end(i) = dim_size
855 if ( slice_start(i) > slice_end(i) )
then
857 cause_c =
cprintf(
'slice_start=%d, slice_end=%d', &
858 & i = (/ slice_start(i), slice_end(i) /) )
862 numdims_slice = int( ( slice_end(i) - slice_start(i) + 1 ) / slice_stride(i) )
865 if ( numdims_slice < 1 )
then
867 &
'slice options to (%c) are invalid. ' // &
868 &
'(@slice_start=%d @slice_end=%d @slice_stride=%d)', &
870 & i = (/ slice_start(i), slice_end(i), slice_stride(i) /) )
872 cause_c =
cprintf(
'slice_start=%d, slice_end=%d, slice_stride=%d', &
873 & i = (/ slice_start(i), slice_end(i), slice_stride(i) /) )
877 call historyaxiscreate( &
878 & axis = gthst_axes_slices(i), &
880 &
size = numdims_slice, &
881 & longname = longname, &
889 allocate( data_axes_slices(i) % a_axis( numdims_slice ) )
891 do j = slice_start(i), slice_end(i), slice_stride(i)
892 data_axes_slices(i) % a_axis( cnt ) =
data_axes(i) % a_axis( j )
900 call historyvarinfoinquire( &
904 if ( trim(name) //
wgtsuf == trim(wgt_name) )
then
911 allocate( data_weights_slices(j) % a_axis( numdims_slice ) )
913 do k = slice_start(i), slice_end(i), slice_stride(i)
914 data_weights_slices(j) % a_axis( cnt ) =
data_weights(j) % a_axis( k )
918 wgt_sum_s = sum( data_weights_slices(j) % a_axis )
919 data_weights_slices(j) % a_axis = data_weights_slices(j) % a_axis * ( wgt_sum / wgt_sum_s )
931 if ( .not.
associated( data_weights_slices(i) % a_axis ) )
then
932 allocate( data_weights_slices(i) % a_axis(
size(
data_weights(i) % a_axis ) ) )
933 data_weights_slices(i) % a_axis =
data_weights(i) % a_axis
940 gthst_axes_slices(numdims) = gthst_axes_time
952 & origin_value = origin_value, &
953 & origin_unit = origin_unit, &
954 & interval_unit = interval_unit, &
955 & newfile_intvalue = newfile_intvalue, &
956 & newfile_intunit = newfile_intunit )
962 & dccalconvertbyunit( &
963 & real( origin_value, dp ), origin_unit,
'sec',
cal_save )
971 if ( newfile_intvalue < 1 )
then
973 origin_value = dccalconvertbyunit( &
974 & origin_sec,
'sec', interval_unit,
cal_save )
980 & dccalconvertbyunit( time,
'sec', interval_unit,
cal_save )
988 if ( len_trim( file ) - index(file,
'.nc', .true.) == 2 )
then
989 file_base = file(1:len_trim( file ) - 3)
998 file_rank =
'_rank' // trim( adjustl(
rank_save) )
1000 if ( newfile_intvalue > 0 )
then
1001 newfile_intvalued = &
1002 & dccalconvertbyunit( time,
'sec', newfile_intunit,
cal_save )
1004 file_newfile_time = &
1005 &
cprintf(
'_time%08d', i = (/ int( newfile_intvalued ) /) )
1008 file_newfile_time =
''
1011 file = trim(file_base) // trim(file_rank) // trim(file_newfile_time) // trim(file_suffix)
1016 call historycreate( &
1017 & history = gthist, &
1020 & axes = gthst_axes_slices(1:numdims), &
1021 & origind = origin_value, &
1030 do i = 1, numdims - 1
1031 call historyaxisinquire( &
1032 & axis = gthst_axes_slices(i), &
1035 & history = gthist, &
1037 & array = data_axes_slices(i) % a_axis )
1044 do i = 1, numdims - 1
1045 call historyaxisinquire( &
1046 & axis = gthst_axes_slices(i), &
1051 &
'data of axis (%c) in whole area is lack. ' // &
1052 &
'Specify the data by "HistoryAutoPutAxisMPI" explicitly.', &
1058 call historyputaxismpi( &
1059 & history = gthist, &
1068 if ( slice_valid )
then
1069 deallocate( gthst_axes_slices )
1070 deallocate( data_axes_slices )
1072 deallocate( gthst_axes_slices )
1073 nullify( data_axes_slices )
1080 call historyaddvariable( &
1081 & history = gthist, &
1083 call historyvarinfoinquire( &
1087 & history = gthist, &
1089 & array = data_weights_slices(i) % a_axis )
1092 if ( slice_valid )
then
1093 deallocate( data_weights_slices )
1095 nullify( data_weights_slices )
1105 call historyaddvariable( &
1107 & history = gthist )
1110 call storeerror(stat, subname, cause_c = cause_c)
1364 subroutine averagereducereal3( &
1365 & array, space_average, & ! (in)
1375 real,
intent(in),
target:: array(:,:,:)
1376 logical,
intent(in):: space_average(3)
1377 real(DP),
intent(in):: weight1(:)
1379 real(DP),
intent(in):: weight2(:)
1381 real(DP),
intent(in):: weight3(:)
1383 real,
pointer:: array_avr(:,:,:)
1385 real,
pointer:: array_avr_work(:,:,:)
1387 real,
pointer:: array_avr_work1(:,:,:)
1389 real,
pointer:: array_avr_work2(:,:,:)
1391 real,
pointer:: array_avr_work3(:,:,:)
1394 integer:: array_shape(3)
1395 integer:: i, dim_size
1396 real(DP):: weight_sum
1399 array_shape = shape( array )
1400 array_avr_work => array
1405 if ( space_average(1) )
then
1406 dim_size = array_shape(1)
1408 allocate( array_avr_work1( array_shape(1) &
1409 & , array_shape(2) &
1411 & , array_shape(3) &
1414 array_avr_work1 = 0.0
1417 array_avr_work1(1,:,:) = array_avr_work1(1,:,:) + &
1418 & array_avr_work(i,:,:) * real(weight1(i), kind=kind(array_avr_work1))
1419 weight_sum = weight_sum + weight1(i)
1421 array_avr_work1 = array_avr_work1 / &
1422 & real(weight_sum, kind=kind(array_avr_work1))
1423 array_avr_work => array_avr_work1
1428 if ( space_average(2) )
then
1429 dim_size = array_shape(2)
1431 allocate( array_avr_work2( array_shape(1) &
1432 & , array_shape(2) &
1434 & , array_shape(3) &
1437 array_avr_work2 = 0.0
1440 array_avr_work2(:,1,:) = array_avr_work2(:,1,:) + &
1441 & array_avr_work(:,i,:) * real(weight2(i), kind=kind(array_avr_work2))
1442 weight_sum = weight_sum + weight2(i)
1444 array_avr_work2 = array_avr_work2 / &
1445 & real(weight_sum, kind=kind(array_avr_work2))
1446 array_avr_work => array_avr_work2
1451 if ( space_average(3) )
then
1452 dim_size = array_shape(3)
1454 allocate( array_avr_work3( array_shape(1) &
1455 & , array_shape(2) &
1457 & , array_shape(3) &
1460 array_avr_work3 = 0.0
1463 array_avr_work3(:,:,1) = array_avr_work3(:,:,1) + &
1464 & array_avr_work(:,:,i) * real(weight3(i), kind=kind(array_avr_work3))
1465 weight_sum = weight_sum + weight3(i)
1467 array_avr_work3 = array_avr_work3 / &
1468 & real(weight_sum, kind=kind(array_avr_work3))
1469 array_avr_work => array_avr_work3
1478 allocate( array_avr( array_shape(1) &
1479 & , array_shape(2) &
1481 & , array_shape(3) &
1485 array_avr = array_avr_work
1487 nullify( array_avr_work )
1489 if (
associated( array_avr_work1 ) )
deallocate( array_avr_work1 )
1491 if (
associated( array_avr_work2 ) )
deallocate( array_avr_work2 )
1493 if (
associated( array_avr_work3 ) )
deallocate( array_avr_work3 )
1527 subroutine averagereducereal4( &
1528 & array, space_average, & ! (in)
1540 real,
intent(in),
target:: array(:,:,:,:)
1541 logical,
intent(in):: space_average(4)
1542 real(DP),
intent(in):: weight1(:)
1544 real(DP),
intent(in):: weight2(:)
1546 real(DP),
intent(in):: weight3(:)
1548 real(DP),
intent(in):: weight4(:)
1550 real,
pointer:: array_avr(:,:,:,:)
1552 real,
pointer:: array_avr_work(:,:,:,:)
1554 real,
pointer:: array_avr_work1(:,:,:,:)
1556 real,
pointer:: array_avr_work2(:,:,:,:)
1558 real,
pointer:: array_avr_work3(:,:,:,:)
1560 real,
pointer:: array_avr_work4(:,:,:,:)
1563 integer:: array_shape(4)
1564 integer:: i, dim_size
1565 real(DP):: weight_sum
1568 array_shape = shape( array )
1569 array_avr_work => array
1574 if ( space_average(1) )
then
1575 dim_size = array_shape(1)
1577 allocate( array_avr_work1( array_shape(1) &
1578 & , array_shape(2) &
1580 & , array_shape(3) &
1582 & , array_shape(4) &
1585 array_avr_work1 = 0.0
1588 array_avr_work1(1,:,:,:) = array_avr_work1(1,:,:,:) + &
1589 & array_avr_work(i,:,:,:) * real(weight1(i), kind=kind(array_avr_work1))
1590 weight_sum = weight_sum + weight1(i)
1592 array_avr_work1 = array_avr_work1 / &
1593 & real(weight_sum, kind=kind(array_avr_work1))
1594 array_avr_work => array_avr_work1
1599 if ( space_average(2) )
then
1600 dim_size = array_shape(2)
1602 allocate( array_avr_work2( array_shape(1) &
1603 & , array_shape(2) &
1605 & , array_shape(3) &
1607 & , array_shape(4) &
1610 array_avr_work2 = 0.0
1613 array_avr_work2(:,1,:,:) = array_avr_work2(:,1,:,:) + &
1614 & array_avr_work(:,i,:,:) * real(weight2(i), kind=kind(array_avr_work2))
1615 weight_sum = weight_sum + weight2(i)
1617 array_avr_work2 = array_avr_work2 / &
1618 & real(weight_sum, kind=kind(array_avr_work2))
1619 array_avr_work => array_avr_work2
1624 if ( space_average(3) )
then
1625 dim_size = array_shape(3)
1627 allocate( array_avr_work3( array_shape(1) &
1628 & , array_shape(2) &
1630 & , array_shape(3) &
1632 & , array_shape(4) &
1635 array_avr_work3 = 0.0
1638 array_avr_work3(:,:,1,:) = array_avr_work3(:,:,1,:) + &
1639 & array_avr_work(:,:,i,:) * real(weight3(i), kind=kind(array_avr_work3))
1640 weight_sum = weight_sum + weight3(i)
1642 array_avr_work3 = array_avr_work3 / &
1643 & real(weight_sum, kind=kind(array_avr_work3))
1644 array_avr_work => array_avr_work3
1649 if ( space_average(4) )
then
1650 dim_size = array_shape(4)
1652 allocate( array_avr_work4( array_shape(1) &
1653 & , array_shape(2) &
1655 & , array_shape(3) &
1657 & , array_shape(4) &
1660 array_avr_work4 = 0.0
1663 array_avr_work4(:,:,:,1) = array_avr_work4(:,:,:,1) + &
1664 & array_avr_work(:,:,:,i) * real(weight4(i), kind=kind(array_avr_work4))
1665 weight_sum = weight_sum + weight4(i)
1667 array_avr_work4 = array_avr_work4 / &
1668 & real(weight_sum, kind=kind(array_avr_work4))
1669 array_avr_work => array_avr_work4
1678 allocate( array_avr( array_shape(1) &
1679 & , array_shape(2) &
1681 & , array_shape(3) &
1683 & , array_shape(4) &
1687 array_avr = array_avr_work
1689 nullify( array_avr_work )
1691 if (
associated( array_avr_work1 ) )
deallocate( array_avr_work1 )
1693 if (
associated( array_avr_work2 ) )
deallocate( array_avr_work2 )
1695 if (
associated( array_avr_work3 ) )
deallocate( array_avr_work3 )
1697 if (
associated( array_avr_work4 ) )
deallocate( array_avr_work4 )
1731 subroutine averagereducereal5( &
1732 & array, space_average, & ! (in)
1746 real,
intent(in),
target:: array(:,:,:,:,:)
1747 logical,
intent(in):: space_average(5)
1748 real(DP),
intent(in):: weight1(:)
1750 real(DP),
intent(in):: weight2(:)
1752 real(DP),
intent(in):: weight3(:)
1754 real(DP),
intent(in):: weight4(:)
1756 real(DP),
intent(in):: weight5(:)
1758 real,
pointer:: array_avr(:,:,:,:,:)
1760 real,
pointer:: array_avr_work(:,:,:,:,:)
1762 real,
pointer:: array_avr_work1(:,:,:,:,:)
1764 real,
pointer:: array_avr_work2(:,:,:,:,:)
1766 real,
pointer:: array_avr_work3(:,:,:,:,:)
1768 real,
pointer:: array_avr_work4(:,:,:,:,:)
1770 real,
pointer:: array_avr_work5(:,:,:,:,:)
1773 integer:: array_shape(5)
1774 integer:: i, dim_size
1775 real(DP):: weight_sum
1778 array_shape = shape( array )
1779 array_avr_work => array
1784 if ( space_average(1) )
then
1785 dim_size = array_shape(1)
1787 allocate( array_avr_work1( array_shape(1) &
1788 & , array_shape(2) &
1790 & , array_shape(3) &
1792 & , array_shape(4) &
1794 & , array_shape(5) &
1797 array_avr_work1 = 0.0
1800 array_avr_work1(1,:,:,:,:) = array_avr_work1(1,:,:,:,:) + &
1801 & array_avr_work(i,:,:,:,:) * real(weight1(i), kind=kind(array_avr_work1))
1802 weight_sum = weight_sum + weight1(i)
1804 array_avr_work1 = array_avr_work1 / &
1805 & real(weight_sum, kind=kind(array_avr_work1))
1806 array_avr_work => array_avr_work1
1811 if ( space_average(2) )
then
1812 dim_size = array_shape(2)
1814 allocate( array_avr_work2( array_shape(1) &
1815 & , array_shape(2) &
1817 & , array_shape(3) &
1819 & , array_shape(4) &
1821 & , array_shape(5) &
1824 array_avr_work2 = 0.0
1827 array_avr_work2(:,1,:,:,:) = array_avr_work2(:,1,:,:,:) + &
1828 & array_avr_work(:,i,:,:,:) * real(weight2(i), kind=kind(array_avr_work2))
1829 weight_sum = weight_sum + weight2(i)
1831 array_avr_work2 = array_avr_work2 / &
1832 & real(weight_sum, kind=kind(array_avr_work2))
1833 array_avr_work => array_avr_work2
1838 if ( space_average(3) )
then
1839 dim_size = array_shape(3)
1841 allocate( array_avr_work3( array_shape(1) &
1842 & , array_shape(2) &
1844 & , array_shape(3) &
1846 & , array_shape(4) &
1848 & , array_shape(5) &
1851 array_avr_work3 = 0.0
1854 array_avr_work3(:,:,1,:,:) = array_avr_work3(:,:,1,:,:) + &
1855 & array_avr_work(:,:,i,:,:) * real(weight3(i), kind=kind(array_avr_work3))
1856 weight_sum = weight_sum + weight3(i)
1858 array_avr_work3 = array_avr_work3 / &
1859 & real(weight_sum, kind=kind(array_avr_work3))
1860 array_avr_work => array_avr_work3
1865 if ( space_average(4) )
then
1866 dim_size = array_shape(4)
1868 allocate( array_avr_work4( array_shape(1) &
1869 & , array_shape(2) &
1871 & , array_shape(3) &
1873 & , array_shape(4) &
1875 & , array_shape(5) &
1878 array_avr_work4 = 0.0
1881 array_avr_work4(:,:,:,1,:) = array_avr_work4(:,:,:,1,:) + &
1882 & array_avr_work(:,:,:,i,:) * real(weight4(i), kind=kind(array_avr_work4))
1883 weight_sum = weight_sum + weight4(i)
1885 array_avr_work4 = array_avr_work4 / &
1886 & real(weight_sum, kind=kind(array_avr_work4))
1887 array_avr_work => array_avr_work4
1892 if ( space_average(5) )
then
1893 dim_size = array_shape(5)
1895 allocate( array_avr_work5( array_shape(1) &
1896 & , array_shape(2) &
1898 & , array_shape(3) &
1900 & , array_shape(4) &
1902 & , array_shape(5) &
1905 array_avr_work5 = 0.0
1908 array_avr_work5(:,:,:,:,1) = array_avr_work5(:,:,:,:,1) + &
1909 & array_avr_work(:,:,:,:,i) * real(weight5(i), kind=kind(array_avr_work5))
1910 weight_sum = weight_sum + weight5(i)
1912 array_avr_work5 = array_avr_work5 / &
1913 & real(weight_sum, kind=kind(array_avr_work5))
1914 array_avr_work => array_avr_work5
1923 allocate( array_avr( array_shape(1) &
1924 & , array_shape(2) &
1926 & , array_shape(3) &
1928 & , array_shape(4) &
1930 & , array_shape(5) &
1934 array_avr = array_avr_work
1936 nullify( array_avr_work )
1938 if (
associated( array_avr_work1 ) )
deallocate( array_avr_work1 )
1940 if (
associated( array_avr_work2 ) )
deallocate( array_avr_work2 )
1942 if (
associated( array_avr_work3 ) )
deallocate( array_avr_work3 )
1944 if (
associated( array_avr_work4 ) )
deallocate( array_avr_work4 )
1946 if (
associated( array_avr_work5 ) )
deallocate( array_avr_work5 )
1980 subroutine averagereducereal6( &
1981 & array, space_average, & ! (in)
1997 real,
intent(in),
target:: array(:,:,:,:,:,:)
1998 logical,
intent(in):: space_average(6)
1999 real(DP),
intent(in):: weight1(:)
2001 real(DP),
intent(in):: weight2(:)
2003 real(DP),
intent(in):: weight3(:)
2005 real(DP),
intent(in):: weight4(:)
2007 real(DP),
intent(in):: weight5(:)
2009 real(DP),
intent(in):: weight6(:)
2011 real,
pointer:: array_avr(:,:,:,:,:,:)
2013 real,
pointer:: array_avr_work(:,:,:,:,:,:)
2015 real,
pointer:: array_avr_work1(:,:,:,:,:,:)
2017 real,
pointer:: array_avr_work2(:,:,:,:,:,:)
2019 real,
pointer:: array_avr_work3(:,:,:,:,:,:)
2021 real,
pointer:: array_avr_work4(:,:,:,:,:,:)
2023 real,
pointer:: array_avr_work5(:,:,:,:,:,:)
2025 real,
pointer:: array_avr_work6(:,:,:,:,:,:)
2028 integer:: array_shape(6)
2029 integer:: i, dim_size
2030 real(DP):: weight_sum
2033 array_shape = shape( array )
2034 array_avr_work => array
2039 if ( space_average(1) )
then
2040 dim_size = array_shape(1)
2042 allocate( array_avr_work1( array_shape(1) &
2043 & , array_shape(2) &
2045 & , array_shape(3) &
2047 & , array_shape(4) &
2049 & , array_shape(5) &
2051 & , array_shape(6) &
2054 array_avr_work1 = 0.0
2057 array_avr_work1(1,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:) + &
2058 & array_avr_work(i,:,:,:,:,:) * real(weight1(i), kind=kind(array_avr_work1))
2059 weight_sum = weight_sum + weight1(i)
2061 array_avr_work1 = array_avr_work1 / &
2062 & real(weight_sum, kind=kind(array_avr_work1))
2063 array_avr_work => array_avr_work1
2068 if ( space_average(2) )
then
2069 dim_size = array_shape(2)
2071 allocate( array_avr_work2( array_shape(1) &
2072 & , array_shape(2) &
2074 & , array_shape(3) &
2076 & , array_shape(4) &
2078 & , array_shape(5) &
2080 & , array_shape(6) &
2083 array_avr_work2 = 0.0
2086 array_avr_work2(:,1,:,:,:,:) = array_avr_work2(:,1,:,:,:,:) + &
2087 & array_avr_work(:,i,:,:,:,:) * real(weight2(i), kind=kind(array_avr_work2))
2088 weight_sum = weight_sum + weight2(i)
2090 array_avr_work2 = array_avr_work2 / &
2091 & real(weight_sum, kind=kind(array_avr_work2))
2092 array_avr_work => array_avr_work2
2097 if ( space_average(3) )
then
2098 dim_size = array_shape(3)
2100 allocate( array_avr_work3( array_shape(1) &
2101 & , array_shape(2) &
2103 & , array_shape(3) &
2105 & , array_shape(4) &
2107 & , array_shape(5) &
2109 & , array_shape(6) &
2112 array_avr_work3 = 0.0
2115 array_avr_work3(:,:,1,:,:,:) = array_avr_work3(:,:,1,:,:,:) + &
2116 & array_avr_work(:,:,i,:,:,:) * real(weight3(i), kind=kind(array_avr_work3))
2117 weight_sum = weight_sum + weight3(i)
2119 array_avr_work3 = array_avr_work3 / &
2120 & real(weight_sum, kind=kind(array_avr_work3))
2121 array_avr_work => array_avr_work3
2126 if ( space_average(4) )
then
2127 dim_size = array_shape(4)
2129 allocate( array_avr_work4( array_shape(1) &
2130 & , array_shape(2) &
2132 & , array_shape(3) &
2134 & , array_shape(4) &
2136 & , array_shape(5) &
2138 & , array_shape(6) &
2141 array_avr_work4 = 0.0
2144 array_avr_work4(:,:,:,1,:,:) = array_avr_work4(:,:,:,1,:,:) + &
2145 & array_avr_work(:,:,:,i,:,:) * real(weight4(i), kind=kind(array_avr_work4))
2146 weight_sum = weight_sum + weight4(i)
2148 array_avr_work4 = array_avr_work4 / &
2149 & real(weight_sum, kind=kind(array_avr_work4))
2150 array_avr_work => array_avr_work4
2155 if ( space_average(5) )
then
2156 dim_size = array_shape(5)
2158 allocate( array_avr_work5( array_shape(1) &
2159 & , array_shape(2) &
2161 & , array_shape(3) &
2163 & , array_shape(4) &
2165 & , array_shape(5) &
2167 & , array_shape(6) &
2170 array_avr_work5 = 0.0
2173 array_avr_work5(:,:,:,:,1,:) = array_avr_work5(:,:,:,:,1,:) + &
2174 & array_avr_work(:,:,:,:,i,:) * real(weight5(i), kind=kind(array_avr_work5))
2175 weight_sum = weight_sum + weight5(i)
2177 array_avr_work5 = array_avr_work5 / &
2178 & real(weight_sum, kind=kind(array_avr_work5))
2179 array_avr_work => array_avr_work5
2184 if ( space_average(6) )
then
2185 dim_size = array_shape(6)
2187 allocate( array_avr_work6( array_shape(1) &
2188 & , array_shape(2) &
2190 & , array_shape(3) &
2192 & , array_shape(4) &
2194 & , array_shape(5) &
2196 & , array_shape(6) &
2199 array_avr_work6 = 0.0
2202 array_avr_work6(:,:,:,:,:,1) = array_avr_work6(:,:,:,:,:,1) + &
2203 & array_avr_work(:,:,:,:,:,i) * real(weight6(i), kind=kind(array_avr_work6))
2204 weight_sum = weight_sum + weight6(i)
2206 array_avr_work6 = array_avr_work6 / &
2207 & real(weight_sum, kind=kind(array_avr_work6))
2208 array_avr_work => array_avr_work6
2217 allocate( array_avr( array_shape(1) &
2218 & , array_shape(2) &
2220 & , array_shape(3) &
2222 & , array_shape(4) &
2224 & , array_shape(5) &
2226 & , array_shape(6) &
2230 array_avr = array_avr_work
2232 nullify( array_avr_work )
2234 if (
associated( array_avr_work1 ) )
deallocate( array_avr_work1 )
2236 if (
associated( array_avr_work2 ) )
deallocate( array_avr_work2 )
2238 if (
associated( array_avr_work3 ) )
deallocate( array_avr_work3 )
2240 if (
associated( array_avr_work4 ) )
deallocate( array_avr_work4 )
2242 if (
associated( array_avr_work5 ) )
deallocate( array_avr_work5 )
2244 if (
associated( array_avr_work6 ) )
deallocate( array_avr_work6 )
2278 subroutine averagereducereal7( &
2279 & array, space_average, & ! (in)
2297 real,
intent(in),
target:: array(:,:,:,:,:,:,:)
2298 logical,
intent(in):: space_average(7)
2299 real(DP),
intent(in):: weight1(:)
2301 real(DP),
intent(in):: weight2(:)
2303 real(DP),
intent(in):: weight3(:)
2305 real(DP),
intent(in):: weight4(:)
2307 real(DP),
intent(in):: weight5(:)
2309 real(DP),
intent(in):: weight6(:)
2311 real(DP),
intent(in):: weight7(:)
2313 real,
pointer:: array_avr(:,:,:,:,:,:,:)
2315 real,
pointer:: array_avr_work(:,:,:,:,:,:,:)
2317 real,
pointer:: array_avr_work1(:,:,:,:,:,:,:)
2319 real,
pointer:: array_avr_work2(:,:,:,:,:,:,:)
2321 real,
pointer:: array_avr_work3(:,:,:,:,:,:,:)
2323 real,
pointer:: array_avr_work4(:,:,:,:,:,:,:)
2325 real,
pointer:: array_avr_work5(:,:,:,:,:,:,:)
2327 real,
pointer:: array_avr_work6(:,:,:,:,:,:,:)
2329 real,
pointer:: array_avr_work7(:,:,:,:,:,:,:)
2332 integer:: array_shape(7)
2333 integer:: i, dim_size
2334 real(DP):: weight_sum
2337 array_shape = shape( array )
2338 array_avr_work => array
2343 if ( space_average(1) )
then
2344 dim_size = array_shape(1)
2346 allocate( array_avr_work1( array_shape(1) &
2347 & , array_shape(2) &
2349 & , array_shape(3) &
2351 & , array_shape(4) &
2353 & , array_shape(5) &
2355 & , array_shape(6) &
2357 & , array_shape(7) &
2360 array_avr_work1 = 0.0
2363 array_avr_work1(1,:,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:,:) + &
2364 & array_avr_work(i,:,:,:,:,:,:) * real(weight1(i), kind=kind(array_avr_work1))
2365 weight_sum = weight_sum + weight1(i)
2367 array_avr_work1 = array_avr_work1 / &
2368 & real(weight_sum, kind=kind(array_avr_work1))
2369 array_avr_work => array_avr_work1
2374 if ( space_average(2) )
then
2375 dim_size = array_shape(2)
2377 allocate( array_avr_work2( array_shape(1) &
2378 & , array_shape(2) &
2380 & , array_shape(3) &
2382 & , array_shape(4) &
2384 & , array_shape(5) &
2386 & , array_shape(6) &
2388 & , array_shape(7) &
2391 array_avr_work2 = 0.0
2394 array_avr_work2(:,1,:,:,:,:,:) = array_avr_work2(:,1,:,:,:,:,:) + &
2395 & array_avr_work(:,i,:,:,:,:,:) * real(weight2(i), kind=kind(array_avr_work2))
2396 weight_sum = weight_sum + weight2(i)
2398 array_avr_work2 = array_avr_work2 / &
2399 & real(weight_sum, kind=kind(array_avr_work2))
2400 array_avr_work => array_avr_work2
2405 if ( space_average(3) )
then
2406 dim_size = array_shape(3)
2408 allocate( array_avr_work3( array_shape(1) &
2409 & , array_shape(2) &
2411 & , array_shape(3) &
2413 & , array_shape(4) &
2415 & , array_shape(5) &
2417 & , array_shape(6) &
2419 & , array_shape(7) &
2422 array_avr_work3 = 0.0
2425 array_avr_work3(:,:,1,:,:,:,:) = array_avr_work3(:,:,1,:,:,:,:) + &
2426 & array_avr_work(:,:,i,:,:,:,:) * real(weight3(i), kind=kind(array_avr_work3))
2427 weight_sum = weight_sum + weight3(i)
2429 array_avr_work3 = array_avr_work3 / &
2430 & real(weight_sum, kind=kind(array_avr_work3))
2431 array_avr_work => array_avr_work3
2436 if ( space_average(4) )
then
2437 dim_size = array_shape(4)
2439 allocate( array_avr_work4( array_shape(1) &
2440 & , array_shape(2) &
2442 & , array_shape(3) &
2444 & , array_shape(4) &
2446 & , array_shape(5) &
2448 & , array_shape(6) &
2450 & , array_shape(7) &
2453 array_avr_work4 = 0.0
2456 array_avr_work4(:,:,:,1,:,:,:) = array_avr_work4(:,:,:,1,:,:,:) + &
2457 & array_avr_work(:,:,:,i,:,:,:) * real(weight4(i), kind=kind(array_avr_work4))
2458 weight_sum = weight_sum + weight4(i)
2460 array_avr_work4 = array_avr_work4 / &
2461 & real(weight_sum, kind=kind(array_avr_work4))
2462 array_avr_work => array_avr_work4
2467 if ( space_average(5) )
then
2468 dim_size = array_shape(5)
2470 allocate( array_avr_work5( array_shape(1) &
2471 & , array_shape(2) &
2473 & , array_shape(3) &
2475 & , array_shape(4) &
2477 & , array_shape(5) &
2479 & , array_shape(6) &
2481 & , array_shape(7) &
2484 array_avr_work5 = 0.0
2487 array_avr_work5(:,:,:,:,1,:,:) = array_avr_work5(:,:,:,:,1,:,:) + &
2488 & array_avr_work(:,:,:,:,i,:,:) * real(weight5(i), kind=kind(array_avr_work5))
2489 weight_sum = weight_sum + weight5(i)
2491 array_avr_work5 = array_avr_work5 / &
2492 & real(weight_sum, kind=kind(array_avr_work5))
2493 array_avr_work => array_avr_work5
2498 if ( space_average(6) )
then
2499 dim_size = array_shape(6)
2501 allocate( array_avr_work6( array_shape(1) &
2502 & , array_shape(2) &
2504 & , array_shape(3) &
2506 & , array_shape(4) &
2508 & , array_shape(5) &
2510 & , array_shape(6) &
2512 & , array_shape(7) &
2515 array_avr_work6 = 0.0
2518 array_avr_work6(:,:,:,:,:,1,:) = array_avr_work6(:,:,:,:,:,1,:) + &
2519 & array_avr_work(:,:,:,:,:,i,:) * real(weight6(i), kind=kind(array_avr_work6))
2520 weight_sum = weight_sum + weight6(i)
2522 array_avr_work6 = array_avr_work6 / &
2523 & real(weight_sum, kind=kind(array_avr_work6))
2524 array_avr_work => array_avr_work6
2529 if ( space_average(7) )
then
2530 dim_size = array_shape(7)
2532 allocate( array_avr_work7( array_shape(1) &
2533 & , array_shape(2) &
2535 & , array_shape(3) &
2537 & , array_shape(4) &
2539 & , array_shape(5) &
2541 & , array_shape(6) &
2543 & , array_shape(7) &
2546 array_avr_work7 = 0.0
2549 array_avr_work7(:,:,:,:,:,:,1) = array_avr_work7(:,:,:,:,:,:,1) + &
2550 & array_avr_work(:,:,:,:,:,:,i) * real(weight7(i), kind=kind(array_avr_work7))
2551 weight_sum = weight_sum + weight7(i)
2553 array_avr_work7 = array_avr_work7 / &
2554 & real(weight_sum, kind=kind(array_avr_work7))
2555 array_avr_work => array_avr_work7
2564 allocate( array_avr( array_shape(1) &
2565 & , array_shape(2) &
2567 & , array_shape(3) &
2569 & , array_shape(4) &
2571 & , array_shape(5) &
2573 & , array_shape(6) &
2575 & , array_shape(7) &
2579 array_avr = array_avr_work
2581 nullify( array_avr_work )
2583 if (
associated( array_avr_work1 ) )
deallocate( array_avr_work1 )
2585 if (
associated( array_avr_work2 ) )
deallocate( array_avr_work2 )
2587 if (
associated( array_avr_work3 ) )
deallocate( array_avr_work3 )
2589 if (
associated( array_avr_work4 ) )
deallocate( array_avr_work4 )
2591 if (
associated( array_avr_work5 ) )
deallocate( array_avr_work5 )
2593 if (
associated( array_avr_work6 ) )
deallocate( array_avr_work6 )
2595 if (
associated( array_avr_work7 ) )
deallocate( array_avr_work7 )
2844 subroutine averagereducedouble3( &
2845 & array, space_average, & ! (in)
2855 real(DP),
intent(in),
target:: array(:,:,:)
2856 logical,
intent(in):: space_average(3)
2857 real(DP),
intent(in):: weight1(:)
2859 real(DP),
intent(in):: weight2(:)
2861 real(DP),
intent(in):: weight3(:)
2863 real(DP),
pointer:: array_avr(:,:,:)
2865 real(DP),
pointer:: array_avr_work(:,:,:)
2867 real(DP),
pointer:: array_avr_work1(:,:,:)
2869 real(DP),
pointer:: array_avr_work2(:,:,:)
2871 real(DP),
pointer:: array_avr_work3(:,:,:)
2874 integer:: array_shape(3)
2875 integer:: i, dim_size
2876 real(DP):: weight_sum
2879 array_shape = shape( array )
2880 array_avr_work => array
2885 if ( space_average(1) )
then
2886 dim_size = array_shape(1)
2888 allocate( array_avr_work1( array_shape(1) &
2889 & , array_shape(2) &
2891 & , array_shape(3) &
2894 array_avr_work1 = 0.0_dp
2897 array_avr_work1(1,:,:) = array_avr_work1(1,:,:) + array_avr_work(i,:,:) * weight1(i)
2898 weight_sum = weight_sum + weight1(i)
2900 array_avr_work1 = array_avr_work1 / weight_sum
2901 array_avr_work => array_avr_work1
2906 if ( space_average(2) )
then
2907 dim_size = array_shape(2)
2909 allocate( array_avr_work2( array_shape(1) &
2910 & , array_shape(2) &
2912 & , array_shape(3) &
2915 array_avr_work2 = 0.0_dp
2918 array_avr_work2(:,1,:) = array_avr_work2(:,1,:) + array_avr_work(:,i,:) * weight2(i)
2919 weight_sum = weight_sum + weight2(i)
2921 array_avr_work2 = array_avr_work2 / weight_sum
2922 array_avr_work => array_avr_work2
2927 if ( space_average(3) )
then
2928 dim_size = array_shape(3)
2930 allocate( array_avr_work3( array_shape(1) &
2931 & , array_shape(2) &
2933 & , array_shape(3) &
2936 array_avr_work3 = 0.0_dp
2939 array_avr_work3(:,:,1) = array_avr_work3(:,:,1) + array_avr_work(:,:,i) * weight3(i)
2940 weight_sum = weight_sum + weight3(i)
2942 array_avr_work3 = array_avr_work3 / weight_sum
2943 array_avr_work => array_avr_work3
2952 allocate( array_avr( array_shape(1) &
2953 & , array_shape(2) &
2955 & , array_shape(3) &
2959 array_avr = array_avr_work
2961 nullify( array_avr_work )
2963 if (
associated( array_avr_work1 ) )
deallocate( array_avr_work1 )
2965 if (
associated( array_avr_work2 ) )
deallocate( array_avr_work2 )
2967 if (
associated( array_avr_work3 ) )
deallocate( array_avr_work3 )
3001 subroutine averagereducedouble4( &
3002 & array, space_average, & ! (in)
3014 real(DP),
intent(in),
target:: array(:,:,:,:)
3015 logical,
intent(in):: space_average(4)
3016 real(DP),
intent(in):: weight1(:)
3018 real(DP),
intent(in):: weight2(:)
3020 real(DP),
intent(in):: weight3(:)
3022 real(DP),
intent(in):: weight4(:)
3024 real(DP),
pointer:: array_avr(:,:,:,:)
3026 real(DP),
pointer:: array_avr_work(:,:,:,:)
3028 real(DP),
pointer:: array_avr_work1(:,:,:,:)
3030 real(DP),
pointer:: array_avr_work2(:,:,:,:)
3032 real(DP),
pointer:: array_avr_work3(:,:,:,:)
3034 real(DP),
pointer:: array_avr_work4(:,:,:,:)
3037 integer:: array_shape(4)
3038 integer:: i, dim_size
3039 real(DP):: weight_sum
3042 array_shape = shape( array )
3043 array_avr_work => array
3048 if ( space_average(1) )
then
3049 dim_size = array_shape(1)
3051 allocate( array_avr_work1( array_shape(1) &
3052 & , array_shape(2) &
3054 & , array_shape(3) &
3056 & , array_shape(4) &
3059 array_avr_work1 = 0.0_dp
3062 array_avr_work1(1,:,:,:) = array_avr_work1(1,:,:,:) + array_avr_work(i,:,:,:) * weight1(i)
3063 weight_sum = weight_sum + weight1(i)
3065 array_avr_work1 = array_avr_work1 / weight_sum
3066 array_avr_work => array_avr_work1
3071 if ( space_average(2) )
then
3072 dim_size = array_shape(2)
3074 allocate( array_avr_work2( array_shape(1) &
3075 & , array_shape(2) &
3077 & , array_shape(3) &
3079 & , array_shape(4) &
3082 array_avr_work2 = 0.0_dp
3085 array_avr_work2(:,1,:,:) = array_avr_work2(:,1,:,:) + array_avr_work(:,i,:,:) * weight2(i)
3086 weight_sum = weight_sum + weight2(i)
3088 array_avr_work2 = array_avr_work2 / weight_sum
3089 array_avr_work => array_avr_work2
3094 if ( space_average(3) )
then
3095 dim_size = array_shape(3)
3097 allocate( array_avr_work3( array_shape(1) &
3098 & , array_shape(2) &
3100 & , array_shape(3) &
3102 & , array_shape(4) &
3105 array_avr_work3 = 0.0_dp
3108 array_avr_work3(:,:,1,:) = array_avr_work3(:,:,1,:) + array_avr_work(:,:,i,:) * weight3(i)
3109 weight_sum = weight_sum + weight3(i)
3111 array_avr_work3 = array_avr_work3 / weight_sum
3112 array_avr_work => array_avr_work3
3117 if ( space_average(4) )
then
3118 dim_size = array_shape(4)
3120 allocate( array_avr_work4( array_shape(1) &
3121 & , array_shape(2) &
3123 & , array_shape(3) &
3125 & , array_shape(4) &
3128 array_avr_work4 = 0.0_dp
3131 array_avr_work4(:,:,:,1) = array_avr_work4(:,:,:,1) + array_avr_work(:,:,:,i) * weight4(i)
3132 weight_sum = weight_sum + weight4(i)
3134 array_avr_work4 = array_avr_work4 / weight_sum
3135 array_avr_work => array_avr_work4
3144 allocate( array_avr( array_shape(1) &
3145 & , array_shape(2) &
3147 & , array_shape(3) &
3149 & , array_shape(4) &
3153 array_avr = array_avr_work
3155 nullify( array_avr_work )
3157 if (
associated( array_avr_work1 ) )
deallocate( array_avr_work1 )
3159 if (
associated( array_avr_work2 ) )
deallocate( array_avr_work2 )
3161 if (
associated( array_avr_work3 ) )
deallocate( array_avr_work3 )
3163 if (
associated( array_avr_work4 ) )
deallocate( array_avr_work4 )
3197 subroutine averagereducedouble5( &
3198 & array, space_average, & ! (in)
3212 real(DP),
intent(in),
target:: array(:,:,:,:,:)
3213 logical,
intent(in):: space_average(5)
3214 real(DP),
intent(in):: weight1(:)
3216 real(DP),
intent(in):: weight2(:)
3218 real(DP),
intent(in):: weight3(:)
3220 real(DP),
intent(in):: weight4(:)
3222 real(DP),
intent(in):: weight5(:)
3224 real(DP),
pointer:: array_avr(:,:,:,:,:)
3226 real(DP),
pointer:: array_avr_work(:,:,:,:,:)
3228 real(DP),
pointer:: array_avr_work1(:,:,:,:,:)
3230 real(DP),
pointer:: array_avr_work2(:,:,:,:,:)
3232 real(DP),
pointer:: array_avr_work3(:,:,:,:,:)
3234 real(DP),
pointer:: array_avr_work4(:,:,:,:,:)
3236 real(DP),
pointer:: array_avr_work5(:,:,:,:,:)
3239 integer:: array_shape(5)
3240 integer:: i, dim_size
3241 real(DP):: weight_sum
3244 array_shape = shape( array )
3245 array_avr_work => array
3250 if ( space_average(1) )
then
3251 dim_size = array_shape(1)
3253 allocate( array_avr_work1( array_shape(1) &
3254 & , array_shape(2) &
3256 & , array_shape(3) &
3258 & , array_shape(4) &
3260 & , array_shape(5) &
3263 array_avr_work1 = 0.0_dp
3266 array_avr_work1(1,:,:,:,:) = array_avr_work1(1,:,:,:,:) + array_avr_work(i,:,:,:,:) * weight1(i)
3267 weight_sum = weight_sum + weight1(i)
3269 array_avr_work1 = array_avr_work1 / weight_sum
3270 array_avr_work => array_avr_work1
3275 if ( space_average(2) )
then
3276 dim_size = array_shape(2)
3278 allocate( array_avr_work2( array_shape(1) &
3279 & , array_shape(2) &
3281 & , array_shape(3) &
3283 & , array_shape(4) &
3285 & , array_shape(5) &
3288 array_avr_work2 = 0.0_dp
3291 array_avr_work2(:,1,:,:,:) = array_avr_work2(:,1,:,:,:) + array_avr_work(:,i,:,:,:) * weight2(i)
3292 weight_sum = weight_sum + weight2(i)
3294 array_avr_work2 = array_avr_work2 / weight_sum
3295 array_avr_work => array_avr_work2
3300 if ( space_average(3) )
then
3301 dim_size = array_shape(3)
3303 allocate( array_avr_work3( array_shape(1) &
3304 & , array_shape(2) &
3306 & , array_shape(3) &
3308 & , array_shape(4) &
3310 & , array_shape(5) &
3313 array_avr_work3 = 0.0_dp
3316 array_avr_work3(:,:,1,:,:) = array_avr_work3(:,:,1,:,:) + array_avr_work(:,:,i,:,:) * weight3(i)
3317 weight_sum = weight_sum + weight3(i)
3319 array_avr_work3 = array_avr_work3 / weight_sum
3320 array_avr_work => array_avr_work3
3325 if ( space_average(4) )
then
3326 dim_size = array_shape(4)
3328 allocate( array_avr_work4( array_shape(1) &
3329 & , array_shape(2) &
3331 & , array_shape(3) &
3333 & , array_shape(4) &
3335 & , array_shape(5) &
3338 array_avr_work4 = 0.0_dp
3341 array_avr_work4(:,:,:,1,:) = array_avr_work4(:,:,:,1,:) + array_avr_work(:,:,:,i,:) * weight4(i)
3342 weight_sum = weight_sum + weight4(i)
3344 array_avr_work4 = array_avr_work4 / weight_sum
3345 array_avr_work => array_avr_work4
3350 if ( space_average(5) )
then
3351 dim_size = array_shape(5)
3353 allocate( array_avr_work5( array_shape(1) &
3354 & , array_shape(2) &
3356 & , array_shape(3) &
3358 & , array_shape(4) &
3360 & , array_shape(5) &
3363 array_avr_work5 = 0.0_dp
3366 array_avr_work5(:,:,:,:,1) = array_avr_work5(:,:,:,:,1) + array_avr_work(:,:,:,:,i) * weight5(i)
3367 weight_sum = weight_sum + weight5(i)
3369 array_avr_work5 = array_avr_work5 / weight_sum
3370 array_avr_work => array_avr_work5
3379 allocate( array_avr( array_shape(1) &
3380 & , array_shape(2) &
3382 & , array_shape(3) &
3384 & , array_shape(4) &
3386 & , array_shape(5) &
3390 array_avr = array_avr_work
3392 nullify( array_avr_work )
3394 if (
associated( array_avr_work1 ) )
deallocate( array_avr_work1 )
3396 if (
associated( array_avr_work2 ) )
deallocate( array_avr_work2 )
3398 if (
associated( array_avr_work3 ) )
deallocate( array_avr_work3 )
3400 if (
associated( array_avr_work4 ) )
deallocate( array_avr_work4 )
3402 if (
associated( array_avr_work5 ) )
deallocate( array_avr_work5 )
3436 subroutine averagereducedouble6( &
3437 & array, space_average, & ! (in)
3453 real(DP),
intent(in),
target:: array(:,:,:,:,:,:)
3454 logical,
intent(in):: space_average(6)
3455 real(DP),
intent(in):: weight1(:)
3457 real(DP),
intent(in):: weight2(:)
3459 real(DP),
intent(in):: weight3(:)
3461 real(DP),
intent(in):: weight4(:)
3463 real(DP),
intent(in):: weight5(:)
3465 real(DP),
intent(in):: weight6(:)
3467 real(DP),
pointer:: array_avr(:,:,:,:,:,:)
3469 real(DP),
pointer:: array_avr_work(:,:,:,:,:,:)
3471 real(DP),
pointer:: array_avr_work1(:,:,:,:,:,:)
3473 real(DP),
pointer:: array_avr_work2(:,:,:,:,:,:)
3475 real(DP),
pointer:: array_avr_work3(:,:,:,:,:,:)
3477 real(DP),
pointer:: array_avr_work4(:,:,:,:,:,:)
3479 real(DP),
pointer:: array_avr_work5(:,:,:,:,:,:)
3481 real(DP),
pointer:: array_avr_work6(:,:,:,:,:,:)
3484 integer:: array_shape(6)
3485 integer:: i, dim_size
3486 real(DP):: weight_sum
3489 array_shape = shape( array )
3490 array_avr_work => array
3495 if ( space_average(1) )
then
3496 dim_size = array_shape(1)
3498 allocate( array_avr_work1( array_shape(1) &
3499 & , array_shape(2) &
3501 & , array_shape(3) &
3503 & , array_shape(4) &
3505 & , array_shape(5) &
3507 & , array_shape(6) &
3510 array_avr_work1 = 0.0_dp
3513 array_avr_work1(1,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:) * weight1(i)
3514 weight_sum = weight_sum + weight1(i)
3516 array_avr_work1 = array_avr_work1 / weight_sum
3517 array_avr_work => array_avr_work1
3522 if ( space_average(2) )
then
3523 dim_size = array_shape(2)
3525 allocate( array_avr_work2( array_shape(1) &
3526 & , array_shape(2) &
3528 & , array_shape(3) &
3530 & , array_shape(4) &
3532 & , array_shape(5) &
3534 & , array_shape(6) &
3537 array_avr_work2 = 0.0_dp
3540 array_avr_work2(:,1,:,:,:,:) = array_avr_work2(:,1,:,:,:,:) + array_avr_work(:,i,:,:,:,:) * weight2(i)
3541 weight_sum = weight_sum + weight2(i)
3543 array_avr_work2 = array_avr_work2 / weight_sum
3544 array_avr_work => array_avr_work2
3549 if ( space_average(3) )
then
3550 dim_size = array_shape(3)
3552 allocate( array_avr_work3( array_shape(1) &
3553 & , array_shape(2) &
3555 & , array_shape(3) &
3557 & , array_shape(4) &
3559 & , array_shape(5) &
3561 & , array_shape(6) &
3564 array_avr_work3 = 0.0_dp
3567 array_avr_work3(:,:,1,:,:,:) = array_avr_work3(:,:,1,:,:,:) + array_avr_work(:,:,i,:,:,:) * weight3(i)
3568 weight_sum = weight_sum + weight3(i)
3570 array_avr_work3 = array_avr_work3 / weight_sum
3571 array_avr_work => array_avr_work3
3576 if ( space_average(4) )
then
3577 dim_size = array_shape(4)
3579 allocate( array_avr_work4( array_shape(1) &
3580 & , array_shape(2) &
3582 & , array_shape(3) &
3584 & , array_shape(4) &
3586 & , array_shape(5) &
3588 & , array_shape(6) &
3591 array_avr_work4 = 0.0_dp
3594 array_avr_work4(:,:,:,1,:,:) = array_avr_work4(:,:,:,1,:,:) + array_avr_work(:,:,:,i,:,:) * weight4(i)
3595 weight_sum = weight_sum + weight4(i)
3597 array_avr_work4 = array_avr_work4 / weight_sum
3598 array_avr_work => array_avr_work4
3603 if ( space_average(5) )
then
3604 dim_size = array_shape(5)
3606 allocate( array_avr_work5( array_shape(1) &
3607 & , array_shape(2) &
3609 & , array_shape(3) &
3611 & , array_shape(4) &
3613 & , array_shape(5) &
3615 & , array_shape(6) &
3618 array_avr_work5 = 0.0_dp
3621 array_avr_work5(:,:,:,:,1,:) = array_avr_work5(:,:,:,:,1,:) + array_avr_work(:,:,:,:,i,:) * weight5(i)
3622 weight_sum = weight_sum + weight5(i)
3624 array_avr_work5 = array_avr_work5 / weight_sum
3625 array_avr_work => array_avr_work5
3630 if ( space_average(6) )
then
3631 dim_size = array_shape(6)
3633 allocate( array_avr_work6( array_shape(1) &
3634 & , array_shape(2) &
3636 & , array_shape(3) &
3638 & , array_shape(4) &
3640 & , array_shape(5) &
3642 & , array_shape(6) &
3645 array_avr_work6 = 0.0_dp
3648 array_avr_work6(:,:,:,:,:,1) = array_avr_work6(:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,i) * weight6(i)
3649 weight_sum = weight_sum + weight6(i)
3651 array_avr_work6 = array_avr_work6 / weight_sum
3652 array_avr_work => array_avr_work6
3661 allocate( array_avr( array_shape(1) &
3662 & , array_shape(2) &
3664 & , array_shape(3) &
3666 & , array_shape(4) &
3668 & , array_shape(5) &
3670 & , array_shape(6) &
3674 array_avr = array_avr_work
3676 nullify( array_avr_work )
3678 if (
associated( array_avr_work1 ) )
deallocate( array_avr_work1 )
3680 if (
associated( array_avr_work2 ) )
deallocate( array_avr_work2 )
3682 if (
associated( array_avr_work3 ) )
deallocate( array_avr_work3 )
3684 if (
associated( array_avr_work4 ) )
deallocate( array_avr_work4 )
3686 if (
associated( array_avr_work5 ) )
deallocate( array_avr_work5 )
3688 if (
associated( array_avr_work6 ) )
deallocate( array_avr_work6 )
3722 subroutine averagereducedouble7( &
3723 & array, space_average, & ! (in)
3741 real(DP),
intent(in),
target:: array(:,:,:,:,:,:,:)
3742 logical,
intent(in):: space_average(7)
3743 real(DP),
intent(in):: weight1(:)
3745 real(DP),
intent(in):: weight2(:)
3747 real(DP),
intent(in):: weight3(:)
3749 real(DP),
intent(in):: weight4(:)
3751 real(DP),
intent(in):: weight5(:)
3753 real(DP),
intent(in):: weight6(:)
3755 real(DP),
intent(in):: weight7(:)
3757 real(DP),
pointer:: array_avr(:,:,:,:,:,:,:)
3759 real(DP),
pointer:: array_avr_work(:,:,:,:,:,:,:)
3761 real(DP),
pointer:: array_avr_work1(:,:,:,:,:,:,:)
3763 real(DP),
pointer:: array_avr_work2(:,:,:,:,:,:,:)
3765 real(DP),
pointer:: array_avr_work3(:,:,:,:,:,:,:)
3767 real(DP),
pointer:: array_avr_work4(:,:,:,:,:,:,:)
3769 real(DP),
pointer:: array_avr_work5(:,:,:,:,:,:,:)
3771 real(DP),
pointer:: array_avr_work6(:,:,:,:,:,:,:)
3773 real(DP),
pointer:: array_avr_work7(:,:,:,:,:,:,:)
3776 integer:: array_shape(7)
3777 integer:: i, dim_size
3778 real(DP):: weight_sum
3781 array_shape = shape( array )
3782 array_avr_work => array
3787 if ( space_average(1) )
then
3788 dim_size = array_shape(1)
3790 allocate( array_avr_work1( array_shape(1) &
3791 & , array_shape(2) &
3793 & , array_shape(3) &
3795 & , array_shape(4) &
3797 & , array_shape(5) &
3799 & , array_shape(6) &
3801 & , array_shape(7) &
3804 array_avr_work1 = 0.0_dp
3807 array_avr_work1(1,:,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:,:) * weight1(i)
3808 weight_sum = weight_sum + weight1(i)
3810 array_avr_work1 = array_avr_work1 / weight_sum
3811 array_avr_work => array_avr_work1
3816 if ( space_average(2) )
then
3817 dim_size = array_shape(2)
3819 allocate( array_avr_work2( array_shape(1) &
3820 & , array_shape(2) &
3822 & , array_shape(3) &
3824 & , array_shape(4) &
3826 & , array_shape(5) &
3828 & , array_shape(6) &
3830 & , array_shape(7) &
3833 array_avr_work2 = 0.0_dp
3836 array_avr_work2(:,1,:,:,:,:,:) = array_avr_work2(:,1,:,:,:,:,:) + array_avr_work(:,i,:,:,:,:,:) * weight2(i)
3837 weight_sum = weight_sum + weight2(i)
3839 array_avr_work2 = array_avr_work2 / weight_sum
3840 array_avr_work => array_avr_work2
3845 if ( space_average(3) )
then
3846 dim_size = array_shape(3)
3848 allocate( array_avr_work3( array_shape(1) &
3849 & , array_shape(2) &
3851 & , array_shape(3) &
3853 & , array_shape(4) &
3855 & , array_shape(5) &
3857 & , array_shape(6) &
3859 & , array_shape(7) &
3862 array_avr_work3 = 0.0_dp
3865 array_avr_work3(:,:,1,:,:,:,:) = array_avr_work3(:,:,1,:,:,:,:) + array_avr_work(:,:,i,:,:,:,:) * weight3(i)
3866 weight_sum = weight_sum + weight3(i)
3868 array_avr_work3 = array_avr_work3 / weight_sum
3869 array_avr_work => array_avr_work3
3874 if ( space_average(4) )
then
3875 dim_size = array_shape(4)
3877 allocate( array_avr_work4( array_shape(1) &
3878 & , array_shape(2) &
3880 & , array_shape(3) &
3882 & , array_shape(4) &
3884 & , array_shape(5) &
3886 & , array_shape(6) &
3888 & , array_shape(7) &
3891 array_avr_work4 = 0.0_dp
3894 array_avr_work4(:,:,:,1,:,:,:) = array_avr_work4(:,:,:,1,:,:,:) + array_avr_work(:,:,:,i,:,:,:) * weight4(i)
3895 weight_sum = weight_sum + weight4(i)
3897 array_avr_work4 = array_avr_work4 / weight_sum
3898 array_avr_work => array_avr_work4
3903 if ( space_average(5) )
then
3904 dim_size = array_shape(5)
3906 allocate( array_avr_work5( array_shape(1) &
3907 & , array_shape(2) &
3909 & , array_shape(3) &
3911 & , array_shape(4) &
3913 & , array_shape(5) &
3915 & , array_shape(6) &
3917 & , array_shape(7) &
3920 array_avr_work5 = 0.0_dp
3923 array_avr_work5(:,:,:,:,1,:,:) = array_avr_work5(:,:,:,:,1,:,:) + array_avr_work(:,:,:,:,i,:,:) * weight5(i)
3924 weight_sum = weight_sum + weight5(i)
3926 array_avr_work5 = array_avr_work5 / weight_sum
3927 array_avr_work => array_avr_work5
3932 if ( space_average(6) )
then
3933 dim_size = array_shape(6)
3935 allocate( array_avr_work6( array_shape(1) &
3936 & , array_shape(2) &
3938 & , array_shape(3) &
3940 & , array_shape(4) &
3942 & , array_shape(5) &
3944 & , array_shape(6) &
3946 & , array_shape(7) &
3949 array_avr_work6 = 0.0_dp
3952 array_avr_work6(:,:,:,:,:,1,:) = array_avr_work6(:,:,:,:,:,1,:) + array_avr_work(:,:,:,:,:,i,:) * weight6(i)
3953 weight_sum = weight_sum + weight6(i)
3955 array_avr_work6 = array_avr_work6 / weight_sum
3956 array_avr_work => array_avr_work6
3961 if ( space_average(7) )
then
3962 dim_size = array_shape(7)
3964 allocate( array_avr_work7( array_shape(1) &
3965 & , array_shape(2) &
3967 & , array_shape(3) &
3969 & , array_shape(4) &
3971 & , array_shape(5) &
3973 & , array_shape(6) &
3975 & , array_shape(7) &
3978 array_avr_work7 = 0.0_dp
3981 array_avr_work7(:,:,:,:,:,:,1) = array_avr_work7(:,:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,:,i) * weight7(i)
3982 weight_sum = weight_sum + weight7(i)
3984 array_avr_work7 = array_avr_work7 / weight_sum
3985 array_avr_work => array_avr_work7
3994 allocate( array_avr( array_shape(1) &
3995 & , array_shape(2) &
3997 & , array_shape(3) &
3999 & , array_shape(4) &
4001 & , array_shape(5) &
4003 & , array_shape(6) &
4005 & , array_shape(7) &
4009 array_avr = array_avr_work
4011 nullify( array_avr_work )
4013 if (
associated( array_avr_work1 ) )
deallocate( array_avr_work1 )
4015 if (
associated( array_avr_work2 ) )
deallocate( array_avr_work2 )
4017 if (
associated( array_avr_work3 ) )
deallocate( array_avr_work3 )
4019 if (
associated( array_avr_work4 ) )
deallocate( array_avr_work4 )
4021 if (
associated( array_avr_work5 ) )
deallocate( array_avr_work5 )
4023 if (
associated( array_avr_work6 ) )
deallocate( array_avr_work6 )
4025 if (
associated( array_avr_work7 ) )
deallocate( array_avr_work7 )
4289 subroutine averagereduceint3( &
4290 & array, space_average, & ! (in)
4300 integer,
intent(in),
target:: array(:,:,:)
4301 logical,
intent(in):: space_average(3)
4302 real(DP),
intent(in):: weight1(:)
4304 real(DP),
intent(in):: weight2(:)
4306 real(DP),
intent(in):: weight3(:)
4308 integer,
pointer:: array_avr(:,:,:)
4310 integer,
pointer:: array_avr_work(:,:,:)
4312 integer,
pointer:: array_avr_work1(:,:,:)
4314 integer,
pointer:: array_avr_work2(:,:,:)
4316 integer,
pointer:: array_avr_work3(:,:,:)
4319 integer:: array_shape(3)
4320 integer:: i, dim_size
4321 real(DP):: weight_sum
4324 array_shape = shape( array )
4325 array_avr_work => array
4330 if ( space_average(1) )
then
4331 dim_size = array_shape(1)
4333 allocate( array_avr_work1( array_shape(1) &
4334 & , array_shape(2) &
4336 & , array_shape(3) &
4342 array_avr_work1(1,:,:) = int( &
4343 & real(array_avr_work1(1,:,:), kind=dp) + &
4344 & real(array_avr_work(i,:,:), kind=dp) * weight1(i), &
4345 & kind=kind(array_avr_work1) )
4346 weight_sum = weight_sum + weight1(i)
4348 array_avr_work1 = int( &
4349 & real(array_avr_work1, kind=dp) / weight_sum, &
4350 & kind=kind(array_avr_work1) )
4351 array_avr_work => array_avr_work1
4356 if ( space_average(2) )
then
4357 dim_size = array_shape(2)
4359 allocate( array_avr_work2( array_shape(1) &
4360 & , array_shape(2) &
4362 & , array_shape(3) &
4368 array_avr_work2(:,1,:) = int( &
4369 & real(array_avr_work2(:,1,:), kind=dp) + &
4370 & real(array_avr_work(:,i,:), kind=dp) * weight2(i), &
4371 & kind=kind(array_avr_work2) )
4372 weight_sum = weight_sum + weight2(i)
4374 array_avr_work2 = int( &
4375 & real(array_avr_work2, kind=dp) / weight_sum, &
4376 & kind=kind(array_avr_work2) )
4377 array_avr_work => array_avr_work2
4382 if ( space_average(3) )
then
4383 dim_size = array_shape(3)
4385 allocate( array_avr_work3( array_shape(1) &
4386 & , array_shape(2) &
4388 & , array_shape(3) &
4394 array_avr_work3(:,:,1) = int( &
4395 & real(array_avr_work3(:,:,1), kind=dp) + &
4396 & real(array_avr_work(:,:,i), kind=dp) * weight3(i), &
4397 & kind=kind(array_avr_work3) )
4398 weight_sum = weight_sum + weight3(i)
4400 array_avr_work3 = int( &
4401 & real(array_avr_work3, kind=dp) / weight_sum, &
4402 & kind=kind(array_avr_work3) )
4403 array_avr_work => array_avr_work3
4412 allocate( array_avr( array_shape(1) &
4413 & , array_shape(2) &
4415 & , array_shape(3) &
4419 array_avr = array_avr_work
4421 nullify( array_avr_work )
4423 if (
associated( array_avr_work1 ) )
deallocate( array_avr_work1 )
4425 if (
associated( array_avr_work2 ) )
deallocate( array_avr_work2 )
4427 if (
associated( array_avr_work3 ) )
deallocate( array_avr_work3 )
4461 subroutine averagereduceint4( &
4462 & array, space_average, & ! (in)
4474 integer,
intent(in),
target:: array(:,:,:,:)
4475 logical,
intent(in):: space_average(4)
4476 real(DP),
intent(in):: weight1(:)
4478 real(DP),
intent(in):: weight2(:)
4480 real(DP),
intent(in):: weight3(:)
4482 real(DP),
intent(in):: weight4(:)
4484 integer,
pointer:: array_avr(:,:,:,:)
4486 integer,
pointer:: array_avr_work(:,:,:,:)
4488 integer,
pointer:: array_avr_work1(:,:,:,:)
4490 integer,
pointer:: array_avr_work2(:,:,:,:)
4492 integer,
pointer:: array_avr_work3(:,:,:,:)
4494 integer,
pointer:: array_avr_work4(:,:,:,:)
4497 integer:: array_shape(4)
4498 integer:: i, dim_size
4499 real(DP):: weight_sum
4502 array_shape = shape( array )
4503 array_avr_work => array
4508 if ( space_average(1) )
then
4509 dim_size = array_shape(1)
4511 allocate( array_avr_work1( array_shape(1) &
4512 & , array_shape(2) &
4514 & , array_shape(3) &
4516 & , array_shape(4) &
4522 array_avr_work1(1,:,:,:) = int( &
4523 & real(array_avr_work1(1,:,:,:), kind=dp) + &
4524 & real(array_avr_work(i,:,:,:), kind=dp) * weight1(i), &
4525 & kind=kind(array_avr_work1) )
4526 weight_sum = weight_sum + weight1(i)
4528 array_avr_work1 = int( &
4529 & real(array_avr_work1, kind=dp) / weight_sum, &
4530 & kind=kind(array_avr_work1) )
4531 array_avr_work => array_avr_work1
4536 if ( space_average(2) )
then
4537 dim_size = array_shape(2)
4539 allocate( array_avr_work2( array_shape(1) &
4540 & , array_shape(2) &
4542 & , array_shape(3) &
4544 & , array_shape(4) &
4550 array_avr_work2(:,1,:,:) = int( &
4551 & real(array_avr_work2(:,1,:,:), kind=dp) + &
4552 & real(array_avr_work(:,i,:,:), kind=dp) * weight2(i), &
4553 & kind=kind(array_avr_work2) )
4554 weight_sum = weight_sum + weight2(i)
4556 array_avr_work2 = int( &
4557 & real(array_avr_work2, kind=dp) / weight_sum, &
4558 & kind=kind(array_avr_work2) )
4559 array_avr_work => array_avr_work2
4564 if ( space_average(3) )
then
4565 dim_size = array_shape(3)
4567 allocate( array_avr_work3( array_shape(1) &
4568 & , array_shape(2) &
4570 & , array_shape(3) &
4572 & , array_shape(4) &
4578 array_avr_work3(:,:,1,:) = int( &
4579 & real(array_avr_work3(:,:,1,:), kind=dp) + &
4580 & real(array_avr_work(:,:,i,:), kind=dp) * weight3(i), &
4581 & kind=kind(array_avr_work3) )
4582 weight_sum = weight_sum + weight3(i)
4584 array_avr_work3 = int( &
4585 & real(array_avr_work3, kind=dp) / weight_sum, &
4586 & kind=kind(array_avr_work3) )
4587 array_avr_work => array_avr_work3
4592 if ( space_average(4) )
then
4593 dim_size = array_shape(4)
4595 allocate( array_avr_work4( array_shape(1) &
4596 & , array_shape(2) &
4598 & , array_shape(3) &
4600 & , array_shape(4) &
4606 array_avr_work4(:,:,:,1) = int( &
4607 & real(array_avr_work4(:,:,:,1), kind=dp) + &
4608 & real(array_avr_work(:,:,:,i), kind=dp) * weight4(i), &
4609 & kind=kind(array_avr_work4) )
4610 weight_sum = weight_sum + weight4(i)
4612 array_avr_work4 = int( &
4613 & real(array_avr_work4, kind=dp) / weight_sum, &
4614 & kind=kind(array_avr_work4) )
4615 array_avr_work => array_avr_work4
4624 allocate( array_avr( array_shape(1) &
4625 & , array_shape(2) &
4627 & , array_shape(3) &
4629 & , array_shape(4) &
4633 array_avr = array_avr_work
4635 nullify( array_avr_work )
4637 if (
associated( array_avr_work1 ) )
deallocate( array_avr_work1 )
4639 if (
associated( array_avr_work2 ) )
deallocate( array_avr_work2 )
4641 if (
associated( array_avr_work3 ) )
deallocate( array_avr_work3 )
4643 if (
associated( array_avr_work4 ) )
deallocate( array_avr_work4 )
4677 subroutine averagereduceint5( &
4678 & array, space_average, & ! (in)
4692 integer,
intent(in),
target:: array(:,:,:,:,:)
4693 logical,
intent(in):: space_average(5)
4694 real(DP),
intent(in):: weight1(:)
4696 real(DP),
intent(in):: weight2(:)
4698 real(DP),
intent(in):: weight3(:)
4700 real(DP),
intent(in):: weight4(:)
4702 real(DP),
intent(in):: weight5(:)
4704 integer,
pointer:: array_avr(:,:,:,:,:)
4706 integer,
pointer:: array_avr_work(:,:,:,:,:)
4708 integer,
pointer:: array_avr_work1(:,:,:,:,:)
4710 integer,
pointer:: array_avr_work2(:,:,:,:,:)
4712 integer,
pointer:: array_avr_work3(:,:,:,:,:)
4714 integer,
pointer:: array_avr_work4(:,:,:,:,:)
4716 integer,
pointer:: array_avr_work5(:,:,:,:,:)
4719 integer:: array_shape(5)
4720 integer:: i, dim_size
4721 real(DP):: weight_sum
4724 array_shape = shape( array )
4725 array_avr_work => array
4730 if ( space_average(1) )
then
4731 dim_size = array_shape(1)
4733 allocate( array_avr_work1( array_shape(1) &
4734 & , array_shape(2) &
4736 & , array_shape(3) &
4738 & , array_shape(4) &
4740 & , array_shape(5) &
4746 array_avr_work1(1,:,:,:,:) = int( &
4747 & real(array_avr_work1(1,:,:,:,:), kind=dp) + &
4748 & real(array_avr_work(i,:,:,:,:), kind=dp) * weight1(i), &
4749 & kind=kind(array_avr_work1) )
4750 weight_sum = weight_sum + weight1(i)
4752 array_avr_work1 = int( &
4753 & real(array_avr_work1, kind=dp) / weight_sum, &
4754 & kind=kind(array_avr_work1) )
4755 array_avr_work => array_avr_work1
4760 if ( space_average(2) )
then
4761 dim_size = array_shape(2)
4763 allocate( array_avr_work2( array_shape(1) &
4764 & , array_shape(2) &
4766 & , array_shape(3) &
4768 & , array_shape(4) &
4770 & , array_shape(5) &
4776 array_avr_work2(:,1,:,:,:) = int( &
4777 & real(array_avr_work2(:,1,:,:,:), kind=dp) + &
4778 & real(array_avr_work(:,i,:,:,:), kind=dp) * weight2(i), &
4779 & kind=kind(array_avr_work2) )
4780 weight_sum = weight_sum + weight2(i)
4782 array_avr_work2 = int( &
4783 & real(array_avr_work2, kind=dp) / weight_sum, &
4784 & kind=kind(array_avr_work2) )
4785 array_avr_work => array_avr_work2
4790 if ( space_average(3) )
then
4791 dim_size = array_shape(3)
4793 allocate( array_avr_work3( array_shape(1) &
4794 & , array_shape(2) &
4796 & , array_shape(3) &
4798 & , array_shape(4) &
4800 & , array_shape(5) &
4806 array_avr_work3(:,:,1,:,:) = int( &
4807 & real(array_avr_work3(:,:,1,:,:), kind=dp) + &
4808 & real(array_avr_work(:,:,i,:,:), kind=dp) * weight3(i), &
4809 & kind=kind(array_avr_work3) )
4810 weight_sum = weight_sum + weight3(i)
4812 array_avr_work3 = int( &
4813 & real(array_avr_work3, kind=dp) / weight_sum, &
4814 & kind=kind(array_avr_work3) )
4815 array_avr_work => array_avr_work3
4820 if ( space_average(4) )
then
4821 dim_size = array_shape(4)
4823 allocate( array_avr_work4( array_shape(1) &
4824 & , array_shape(2) &
4826 & , array_shape(3) &
4828 & , array_shape(4) &
4830 & , array_shape(5) &
4836 array_avr_work4(:,:,:,1,:) = int( &
4837 & real(array_avr_work4(:,:,:,1,:), kind=dp) + &
4838 & real(array_avr_work(:,:,:,i,:), kind=dp) * weight4(i), &
4839 & kind=kind(array_avr_work4) )
4840 weight_sum = weight_sum + weight4(i)
4842 array_avr_work4 = int( &
4843 & real(array_avr_work4, kind=dp) / weight_sum, &
4844 & kind=kind(array_avr_work4) )
4845 array_avr_work => array_avr_work4
4850 if ( space_average(5) )
then
4851 dim_size = array_shape(5)
4853 allocate( array_avr_work5( array_shape(1) &
4854 & , array_shape(2) &
4856 & , array_shape(3) &
4858 & , array_shape(4) &
4860 & , array_shape(5) &
4866 array_avr_work5(:,:,:,:,1) = int( &
4867 & real(array_avr_work5(:,:,:,:,1), kind=dp) + &
4868 & real(array_avr_work(:,:,:,:,i), kind=dp) * weight5(i), &
4869 & kind=kind(array_avr_work5) )
4870 weight_sum = weight_sum + weight5(i)
4872 array_avr_work5 = int( &
4873 & real(array_avr_work5, kind=dp) / weight_sum, &
4874 & kind=kind(array_avr_work5) )
4875 array_avr_work => array_avr_work5
4884 allocate( array_avr( array_shape(1) &
4885 & , array_shape(2) &
4887 & , array_shape(3) &
4889 & , array_shape(4) &
4891 & , array_shape(5) &
4895 array_avr = array_avr_work
4897 nullify( array_avr_work )
4899 if (
associated( array_avr_work1 ) )
deallocate( array_avr_work1 )
4901 if (
associated( array_avr_work2 ) )
deallocate( array_avr_work2 )
4903 if (
associated( array_avr_work3 ) )
deallocate( array_avr_work3 )
4905 if (
associated( array_avr_work4 ) )
deallocate( array_avr_work4 )
4907 if (
associated( array_avr_work5 ) )
deallocate( array_avr_work5 )
4941 subroutine averagereduceint6( &
4942 & array, space_average, & ! (in)
4958 integer,
intent(in),
target:: array(:,:,:,:,:,:)
4959 logical,
intent(in):: space_average(6)
4960 real(DP),
intent(in):: weight1(:)
4962 real(DP),
intent(in):: weight2(:)
4964 real(DP),
intent(in):: weight3(:)
4966 real(DP),
intent(in):: weight4(:)
4968 real(DP),
intent(in):: weight5(:)
4970 real(DP),
intent(in):: weight6(:)
4972 integer,
pointer:: array_avr(:,:,:,:,:,:)
4974 integer,
pointer:: array_avr_work(:,:,:,:,:,:)
4976 integer,
pointer:: array_avr_work1(:,:,:,:,:,:)
4978 integer,
pointer:: array_avr_work2(:,:,:,:,:,:)
4980 integer,
pointer:: array_avr_work3(:,:,:,:,:,:)
4982 integer,
pointer:: array_avr_work4(:,:,:,:,:,:)
4984 integer,
pointer:: array_avr_work5(:,:,:,:,:,:)
4986 integer,
pointer:: array_avr_work6(:,:,:,:,:,:)
4989 integer:: array_shape(6)
4990 integer:: i, dim_size
4991 real(DP):: weight_sum
4994 array_shape = shape( array )
4995 array_avr_work => array
5000 if ( space_average(1) )
then
5001 dim_size = array_shape(1)
5003 allocate( array_avr_work1( array_shape(1) &
5004 & , array_shape(2) &
5006 & , array_shape(3) &
5008 & , array_shape(4) &
5010 & , array_shape(5) &
5012 & , array_shape(6) &
5018 array_avr_work1(1,:,:,:,:,:) = int( &
5019 & real(array_avr_work1(1,:,:,:,:,:), kind=dp) + &
5020 & real(array_avr_work(i,:,:,:,:,:), kind=dp) * weight1(i), &
5021 & kind=kind(array_avr_work1) )
5022 weight_sum = weight_sum + weight1(i)
5024 array_avr_work1 = int( &
5025 & real(array_avr_work1, kind=dp) / weight_sum, &
5026 & kind=kind(array_avr_work1) )
5027 array_avr_work => array_avr_work1
5032 if ( space_average(2) )
then
5033 dim_size = array_shape(2)
5035 allocate( array_avr_work2( array_shape(1) &
5036 & , array_shape(2) &
5038 & , array_shape(3) &
5040 & , array_shape(4) &
5042 & , array_shape(5) &
5044 & , array_shape(6) &
5050 array_avr_work2(:,1,:,:,:,:) = int( &
5051 & real(array_avr_work2(:,1,:,:,:,:), kind=dp) + &
5052 & real(array_avr_work(:,i,:,:,:,:), kind=dp) * weight2(i), &
5053 & kind=kind(array_avr_work2) )
5054 weight_sum = weight_sum + weight2(i)
5056 array_avr_work2 = int( &
5057 & real(array_avr_work2, kind=dp) / weight_sum, &
5058 & kind=kind(array_avr_work2) )
5059 array_avr_work => array_avr_work2
5064 if ( space_average(3) )
then
5065 dim_size = array_shape(3)
5067 allocate( array_avr_work3( array_shape(1) &
5068 & , array_shape(2) &
5070 & , array_shape(3) &
5072 & , array_shape(4) &
5074 & , array_shape(5) &
5076 & , array_shape(6) &
5082 array_avr_work3(:,:,1,:,:,:) = int( &
5083 & real(array_avr_work3(:,:,1,:,:,:), kind=dp) + &
5084 & real(array_avr_work(:,:,i,:,:,:), kind=dp) * weight3(i), &
5085 & kind=kind(array_avr_work3) )
5086 weight_sum = weight_sum + weight3(i)
5088 array_avr_work3 = int( &
5089 & real(array_avr_work3, kind=dp) / weight_sum, &
5090 & kind=kind(array_avr_work3) )
5091 array_avr_work => array_avr_work3
5096 if ( space_average(4) )
then
5097 dim_size = array_shape(4)
5099 allocate( array_avr_work4( array_shape(1) &
5100 & , array_shape(2) &
5102 & , array_shape(3) &
5104 & , array_shape(4) &
5106 & , array_shape(5) &
5108 & , array_shape(6) &
5114 array_avr_work4(:,:,:,1,:,:) = int( &
5115 & real(array_avr_work4(:,:,:,1,:,:), kind=dp) + &
5116 & real(array_avr_work(:,:,:,i,:,:), kind=dp) * weight4(i), &
5117 & kind=kind(array_avr_work4) )
5118 weight_sum = weight_sum + weight4(i)
5120 array_avr_work4 = int( &
5121 & real(array_avr_work4, kind=dp) / weight_sum, &
5122 & kind=kind(array_avr_work4) )
5123 array_avr_work => array_avr_work4
5128 if ( space_average(5) )
then
5129 dim_size = array_shape(5)
5131 allocate( array_avr_work5( array_shape(1) &
5132 & , array_shape(2) &
5134 & , array_shape(3) &
5136 & , array_shape(4) &
5138 & , array_shape(5) &
5140 & , array_shape(6) &
5146 array_avr_work5(:,:,:,:,1,:) = int( &
5147 & real(array_avr_work5(:,:,:,:,1,:), kind=dp) + &
5148 & real(array_avr_work(:,:,:,:,i,:), kind=dp) * weight5(i), &
5149 & kind=kind(array_avr_work5) )
5150 weight_sum = weight_sum + weight5(i)
5152 array_avr_work5 = int( &
5153 & real(array_avr_work5, kind=dp) / weight_sum, &
5154 & kind=kind(array_avr_work5) )
5155 array_avr_work => array_avr_work5
5160 if ( space_average(6) )
then
5161 dim_size = array_shape(6)
5163 allocate( array_avr_work6( array_shape(1) &
5164 & , array_shape(2) &
5166 & , array_shape(3) &
5168 & , array_shape(4) &
5170 & , array_shape(5) &
5172 & , array_shape(6) &
5178 array_avr_work6(:,:,:,:,:,1) = int( &
5179 & real(array_avr_work6(:,:,:,:,:,1), kind=dp) + &
5180 & real(array_avr_work(:,:,:,:,:,i), kind=dp) * weight6(i), &
5181 & kind=kind(array_avr_work6) )
5182 weight_sum = weight_sum + weight6(i)
5184 array_avr_work6 = int( &
5185 & real(array_avr_work6, kind=dp) / weight_sum, &
5186 & kind=kind(array_avr_work6) )
5187 array_avr_work => array_avr_work6
5196 allocate( array_avr( array_shape(1) &
5197 & , array_shape(2) &
5199 & , array_shape(3) &
5201 & , array_shape(4) &
5203 & , array_shape(5) &
5205 & , array_shape(6) &
5209 array_avr = array_avr_work
5211 nullify( array_avr_work )
5213 if (
associated( array_avr_work1 ) )
deallocate( array_avr_work1 )
5215 if (
associated( array_avr_work2 ) )
deallocate( array_avr_work2 )
5217 if (
associated( array_avr_work3 ) )
deallocate( array_avr_work3 )
5219 if (
associated( array_avr_work4 ) )
deallocate( array_avr_work4 )
5221 if (
associated( array_avr_work5 ) )
deallocate( array_avr_work5 )
5223 if (
associated( array_avr_work6 ) )
deallocate( array_avr_work6 )
5257 subroutine averagereduceint7( &
5258 & array, space_average, & ! (in)
5276 integer,
intent(in),
target:: array(:,:,:,:,:,:,:)
5277 logical,
intent(in):: space_average(7)
5278 real(DP),
intent(in):: weight1(:)
5280 real(DP),
intent(in):: weight2(:)
5282 real(DP),
intent(in):: weight3(:)
5284 real(DP),
intent(in):: weight4(:)
5286 real(DP),
intent(in):: weight5(:)
5288 real(DP),
intent(in):: weight6(:)
5290 real(DP),
intent(in):: weight7(:)
5292 integer,
pointer:: array_avr(:,:,:,:,:,:,:)
5294 integer,
pointer:: array_avr_work(:,:,:,:,:,:,:)
5296 integer,
pointer:: array_avr_work1(:,:,:,:,:,:,:)
5298 integer,
pointer:: array_avr_work2(:,:,:,:,:,:,:)
5300 integer,
pointer:: array_avr_work3(:,:,:,:,:,:,:)
5302 integer,
pointer:: array_avr_work4(:,:,:,:,:,:,:)
5304 integer,
pointer:: array_avr_work5(:,:,:,:,:,:,:)
5306 integer,
pointer:: array_avr_work6(:,:,:,:,:,:,:)
5308 integer,
pointer:: array_avr_work7(:,:,:,:,:,:,:)
5311 integer:: array_shape(7)
5312 integer:: i, dim_size
5313 real(DP):: weight_sum
5316 array_shape = shape( array )
5317 array_avr_work => array
5322 if ( space_average(1) )
then
5323 dim_size = array_shape(1)
5325 allocate( array_avr_work1( array_shape(1) &
5326 & , array_shape(2) &
5328 & , array_shape(3) &
5330 & , array_shape(4) &
5332 & , array_shape(5) &
5334 & , array_shape(6) &
5336 & , array_shape(7) &
5342 array_avr_work1(1,:,:,:,:,:,:) = int( &
5343 & real(array_avr_work1(1,:,:,:,:,:,:), kind=dp) + &
5344 & real(array_avr_work(i,:,:,:,:,:,:), kind=dp) * weight1(i), &
5345 & kind=kind(array_avr_work1) )
5346 weight_sum = weight_sum + weight1(i)
5348 array_avr_work1 = int( &
5349 & real(array_avr_work1, kind=dp) / weight_sum, &
5350 & kind=kind(array_avr_work1) )
5351 array_avr_work => array_avr_work1
5356 if ( space_average(2) )
then
5357 dim_size = array_shape(2)
5359 allocate( array_avr_work2( array_shape(1) &
5360 & , array_shape(2) &
5362 & , array_shape(3) &
5364 & , array_shape(4) &
5366 & , array_shape(5) &
5368 & , array_shape(6) &
5370 & , array_shape(7) &
5376 array_avr_work2(:,1,:,:,:,:,:) = int( &
5377 & real(array_avr_work2(:,1,:,:,:,:,:), kind=dp) + &
5378 & real(array_avr_work(:,i,:,:,:,:,:), kind=dp) * weight2(i), &
5379 & kind=kind(array_avr_work2) )
5380 weight_sum = weight_sum + weight2(i)
5382 array_avr_work2 = int( &
5383 & real(array_avr_work2, kind=dp) / weight_sum, &
5384 & kind=kind(array_avr_work2) )
5385 array_avr_work => array_avr_work2
5390 if ( space_average(3) )
then
5391 dim_size = array_shape(3)
5393 allocate( array_avr_work3( array_shape(1) &
5394 & , array_shape(2) &
5396 & , array_shape(3) &
5398 & , array_shape(4) &
5400 & , array_shape(5) &
5402 & , array_shape(6) &
5404 & , array_shape(7) &
5410 array_avr_work3(:,:,1,:,:,:,:) = int( &
5411 & real(array_avr_work3(:,:,1,:,:,:,:), kind=dp) + &
5412 & real(array_avr_work(:,:,i,:,:,:,:), kind=dp) * weight3(i), &
5413 & kind=kind(array_avr_work3) )
5414 weight_sum = weight_sum + weight3(i)
5416 array_avr_work3 = int( &
5417 & real(array_avr_work3, kind=dp) / weight_sum, &
5418 & kind=kind(array_avr_work3) )
5419 array_avr_work => array_avr_work3
5424 if ( space_average(4) )
then
5425 dim_size = array_shape(4)
5427 allocate( array_avr_work4( array_shape(1) &
5428 & , array_shape(2) &
5430 & , array_shape(3) &
5432 & , array_shape(4) &
5434 & , array_shape(5) &
5436 & , array_shape(6) &
5438 & , array_shape(7) &
5444 array_avr_work4(:,:,:,1,:,:,:) = int( &
5445 & real(array_avr_work4(:,:,:,1,:,:,:), kind=dp) + &
5446 & real(array_avr_work(:,:,:,i,:,:,:), kind=dp) * weight4(i), &
5447 & kind=kind(array_avr_work4) )
5448 weight_sum = weight_sum + weight4(i)
5450 array_avr_work4 = int( &
5451 & real(array_avr_work4, kind=dp) / weight_sum, &
5452 & kind=kind(array_avr_work4) )
5453 array_avr_work => array_avr_work4
5458 if ( space_average(5) )
then
5459 dim_size = array_shape(5)
5461 allocate( array_avr_work5( array_shape(1) &
5462 & , array_shape(2) &
5464 & , array_shape(3) &
5466 & , array_shape(4) &
5468 & , array_shape(5) &
5470 & , array_shape(6) &
5472 & , array_shape(7) &
5478 array_avr_work5(:,:,:,:,1,:,:) = int( &
5479 & real(array_avr_work5(:,:,:,:,1,:,:), kind=dp) + &
5480 & real(array_avr_work(:,:,:,:,i,:,:), kind=dp) * weight5(i), &
5481 & kind=kind(array_avr_work5) )
5482 weight_sum = weight_sum + weight5(i)
5484 array_avr_work5 = int( &
5485 & real(array_avr_work5, kind=dp) / weight_sum, &
5486 & kind=kind(array_avr_work5) )
5487 array_avr_work => array_avr_work5
5492 if ( space_average(6) )
then
5493 dim_size = array_shape(6)
5495 allocate( array_avr_work6( array_shape(1) &
5496 & , array_shape(2) &
5498 & , array_shape(3) &
5500 & , array_shape(4) &
5502 & , array_shape(5) &
5504 & , array_shape(6) &
5506 & , array_shape(7) &
5512 array_avr_work6(:,:,:,:,:,1,:) = int( &
5513 & real(array_avr_work6(:,:,:,:,:,1,:), kind=dp) + &
5514 & real(array_avr_work(:,:,:,:,:,i,:), kind=dp) * weight6(i), &
5515 & kind=kind(array_avr_work6) )
5516 weight_sum = weight_sum + weight6(i)
5518 array_avr_work6 = int( &
5519 & real(array_avr_work6, kind=dp) / weight_sum, &
5520 & kind=kind(array_avr_work6) )
5521 array_avr_work => array_avr_work6
5526 if ( space_average(7) )
then
5527 dim_size = array_shape(7)
5529 allocate( array_avr_work7( array_shape(1) &
5530 & , array_shape(2) &
5532 & , array_shape(3) &
5534 & , array_shape(4) &
5536 & , array_shape(5) &
5538 & , array_shape(6) &
5540 & , array_shape(7) &
5546 array_avr_work7(:,:,:,:,:,:,1) = int( &
5547 & real(array_avr_work7(:,:,:,:,:,:,1), kind=dp) + &
5548 & real(array_avr_work(:,:,:,:,:,:,i), kind=dp) * weight7(i), &
5549 & kind=kind(array_avr_work7) )
5550 weight_sum = weight_sum + weight7(i)
5552 array_avr_work7 = int( &
5553 & real(array_avr_work7, kind=dp) / weight_sum, &
5554 & kind=kind(array_avr_work7) )
5555 array_avr_work => array_avr_work7
5564 allocate( array_avr( array_shape(1) &
5565 & , array_shape(2) &
5567 & , array_shape(3) &
5569 & , array_shape(4) &
5571 & , array_shape(5) &
5573 & , array_shape(6) &
5575 & , array_shape(7) &
5579 array_avr = array_avr_work
5581 nullify( array_avr_work )
5583 if (
associated( array_avr_work1 ) )
deallocate( array_avr_work1 )
5585 if (
associated( array_avr_work2 ) )
deallocate( array_avr_work2 )
5587 if (
associated( array_avr_work3 ) )
deallocate( array_avr_work3 )
5589 if (
associated( array_avr_work4 ) )
deallocate( array_avr_work4 )
5591 if (
associated( array_avr_work5 ) )
deallocate( array_avr_work5 )
5593 if (
associated( array_avr_work6 ) )
deallocate( array_avr_work6 )
5595 if (
associated( array_avr_work7 ) )
deallocate( array_avr_work7 )