TABLE OF CONTENTS

ABINIT/xmpi_sum_master [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master

FUNCTION

  This module contains functions that calls MPI routine,
  if we compile the code using the MPI CPP flags.
  xmpi_sum_master is the generic function.

COPYRIGHT

  Copyright (C) 2001-2024 ABINIT group (AR,XG,MB)
  This file is distributed under the terms of the
  GNU General Public License, see ~ABINIT/COPYING
  or http://www.gnu.org/copyleft/gpl.txt .

NOTES

  The workspace array xsum is filled to zeros to avoid SIFPE in [mpiio][t28_MPI4][np=4] on tikal_gnu_4.9_mpich
  On this bot, the code is compiled with -ffpe-trap and the illegal operation in the MPI library
  make tests using xmpi_sum_master abort.
  Strictly speaking the initialization is not needed because xsum has intent(out) --> bug in mpich3-3.1.3 (gcc492)

SOURCE

ABINIT/xmpi_sum_master_c1cplx [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_c1cplx

FUNCTION

  Reduces values on all processes to a single value.
  Target: one-dimensional complex arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

801 subroutine xmpi_sum_master_c1cplx(xval,master,comm,ier)
802 
803 !Arguments-------------------------
804  complex(spc), DEV_CONTARRD intent(inout) :: xval(:)
805  integer ,intent(in) :: master
806  integer ,intent(in) :: comm
807  integer ,intent(out) :: ier
808 
809 !Local variables-------------------
810 #if defined HAVE_MPI
811  integer :: n1,nproc_space_comm
812  complex(spc),allocatable :: xsum(:)
813 #endif
814 
815 ! *************************************************************************
816 
817  ier=0
818 #if defined HAVE_MPI
819  if (comm /= MPI_COMM_NULL) then
820    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
821    if (nproc_space_comm /= 1) then
822      n1 = size(xval,dim=1)
823      ABI_STAT_MALLOC(xsum,(n1), ier)
824      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
825      xsum = (0_sp,0_sp) ! See notes
826 !    Collect xval from processors on master in comm
827      call MPI_REDUCE(xval,xsum,n1,MPI_COMPLEX,MPI_SUM,master,comm,ier)
828      xval = xsum
829      ABI_FREE(xsum)
830    end if
831  end if
832 #endif
833 
834 end subroutine xmpi_sum_master_c1cplx

ABINIT/xmpi_sum_master_c1dpc [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_c1dpc

FUNCTION

  Reduces values on all processes to a single value.
  Target: one-dimensional double complex arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

1155 subroutine xmpi_sum_master_c1dpc(xval,master,comm,ier)
1156 
1157 !Arguments-------------------------
1158  complex(dpc), DEV_CONTARRD intent(inout) :: xval(:)
1159  integer,intent(in) :: master
1160  integer,intent(in) :: comm
1161  integer,intent(out) :: ier
1162 
1163 !Local variables-------------------
1164 #if defined HAVE_MPI
1165  integer :: n1
1166  integer :: nproc_space_comm
1167  complex(dpc),allocatable :: xsum(:)
1168 #endif
1169 
1170 ! *************************************************************************
1171 
1172  ier=0
1173 #if defined HAVE_MPI
1174  if (comm /= MPI_COMM_NULL) then
1175    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1176    if (nproc_space_comm /= 1) then
1177      n1 = size(xval,dim=1)
1178 !    Collect xval from processors on master in comm
1179      ABI_STAT_MALLOC(xsum,(n1), ier)
1180      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
1181      xsum = (0_dp,0_dp) ! See notes
1182      call MPI_REDUCE(xval,xsum,n1,MPI_DOUBLE_COMPLEX,MPI_SUM,master,comm,ier)
1183      xval (:) = xsum(:)
1184      ABI_FREE(xsum)
1185    end if
1186  end if
1187 #endif
1188 
1189 end subroutine xmpi_sum_master_c1dpc

ABINIT/xmpi_sum_master_c2cplx [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_c2cplx

FUNCTION

  Reduces values on all processes to a single value.
  Target: two-dimensional complex arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

857 subroutine xmpi_sum_master_c2cplx(xval,master,comm,ier)
858 
859 !Arguments-------------------------
860  complex(spc), DEV_CONTARRD intent(inout) :: xval(:,:)
861  integer,intent(in) :: master
862  integer,intent(in) :: comm
863  integer,intent(out) :: ier
864 
865 !Local variables-------------------
866 #if defined HAVE_MPI
867  integer :: my_dt,my_op,n1,n2
868  integer(kind=int64) :: ntot
869  integer :: nproc_space_comm
870  complex(spc),allocatable :: xsum(:,:)
871 #endif
872 
873 ! *************************************************************************
874 
875  ier=0
876 #if defined HAVE_MPI
877  if (comm /= MPI_COMM_NULL) then
878    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
879    if (nproc_space_comm /= 1) then
880      n1 = size(xval,dim=1)
881      n2 = size(xval,dim=2)
882 
883      ABI_STAT_MALLOC(xsum,(n1,n2), ier)
884      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
885      xsum = (0_sp,0_sp) ! See notes
886 
887      !This product of dimensions can be greater than a 32bit integer
888      !We use a INT64 to store it. If it is too large, we switch to an
889      !alternate routine because MPI<4 doesnt handle 64 bit counts.
890      ntot=int(n1*n2,kind=int64)
891 
892 !    Accumulate xval on all proc. in comm
893      if (ntot<=xmpi_maxint32_64) then
894        call MPI_reduce(xval,xsum,n1*n2,MPI_COMPLEX,MPI_SUM,master,comm,ier)
895      else
896        call xmpi_largetype_create(ntot,MPI_COMPLEX,my_dt,my_op,MPI_SUM)
897        call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
898        call xmpi_largetype_free(my_dt,my_op)
899      end if
900 
901      xval (:,:) = xsum(:,:)
902      ABI_FREE(xsum)
903    end if
904  end if
905 #endif
906 
907 end subroutine xmpi_sum_master_c2cplx

ABINIT/xmpi_sum_master_c2dpc [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_c2dpc

FUNCTION

  Reduces values on all processes to a single value.
  Target: two-dimensional double complex arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

1212 subroutine xmpi_sum_master_c2dpc(xval,master,comm,ier)
1213 
1214 !Arguments-------------------------
1215  complex(dpc), DEV_CONTARRD intent(inout) :: xval(:,:)
1216  integer ,intent(in) :: master
1217  integer ,intent(in) :: comm
1218  integer ,intent(out) :: ier
1219 
1220 !Local variables-------------------
1221 #if defined HAVE_MPI
1222  integer :: my_dt,my_op,n1,n2
1223  integer(kind=int64) :: ntot
1224  complex(dpc) , allocatable :: xsum(:,:)
1225  integer :: nproc_space_comm
1226 #endif
1227 
1228 ! *************************************************************************
1229 
1230  ier=0
1231 #if defined HAVE_MPI
1232  if (comm /= MPI_COMM_NULL) then
1233    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1234    if (nproc_space_comm /= 1) then
1235      n1 = size(xval,dim=1)
1236      n2 = size(xval,dim=2)
1237 
1238      ABI_STAT_MALLOC(xsum,(n1,n2), ier)
1239      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
1240      xsum = (0_dp,0_dp) ! See notes
1241 
1242      !This product of dimensions can be greater than a 32bit integer
1243      !We use a INT64 to store it. If it is too large, we switch to an
1244      !alternate routine because MPI<4 doesnt handle 64 bit counts.
1245      ntot=int(n1*n2,kind=int64)
1246 
1247 !    Accumulate xval on all proc. in comm
1248      if (ntot<=xmpi_maxint32_64) then
1249        call MPI_reduce(xval,xsum,n1*n2,MPI_DOUBLE_COMPLEX,MPI_SUM,master,comm,ier)
1250      else
1251        call xmpi_largetype_create(ntot,MPI_DOUBLE_COMPLEX,my_dt,my_op,MPI_SUM)
1252        call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
1253        call xmpi_largetype_free(my_dt,my_op)
1254      end if
1255 
1256      xval (:,:) = xsum(:,:)
1257      ABI_FREE(xsum)
1258    end if
1259  end if
1260 #endif
1261 
1262 end subroutine xmpi_sum_master_c2dpc

ABINIT/xmpi_sum_master_c3cplx [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_c3cplx

FUNCTION

  Reduces values on all processes to a single value.
  Target: three-dimensional complex arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

930 subroutine xmpi_sum_master_c3cplx(xval,master,comm,ier)
931 
932 !Arguments-------------------------
933  complex(spc), DEV_CONTARRD intent(inout) :: xval(:,:,:)
934  integer,intent(in) :: master
935  integer,intent(in) :: comm
936  integer,intent(out) :: ier
937 
938 !Local variables-------------------
939 #if defined HAVE_MPI
940  integer :: my_dt,my_op,n1,n2,n3
941  integer(kind=int64) :: ntot
942  complex(spc), allocatable :: xsum(:,:,:)
943  integer :: nproc_space_comm
944 #endif
945 
946 ! *************************************************************************
947 
948  ier=0
949 #if defined HAVE_MPI
950  if (comm /= MPI_COMM_NULL) then
951    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
952    if (nproc_space_comm /= 1) then
953      n1 = size(xval,dim=1)
954      n2 = size(xval,dim=2)
955      n3 = size(xval,dim=3)
956 
957      ABI_STAT_MALLOC(xsum,(n1,n2,n3), ier)
958      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
959      xsum = (0_sp,0_sp) ! See notes
960 
961      !This product of dimensions can be greater than a 32bit integer
962      !We use a INT64 to store it. If it is too large, we switch to an
963      !alternate routine because MPI<4 doesnt handle 64 bit counts.
964      ntot=int(n1*n2*n3,kind=int64)
965 
966 !    Accumulate xval on all proc. in comm
967      if (ntot<=xmpi_maxint32_64) then
968        call MPI_reduce(xval,xsum,n1*n2*n3,MPI_COMPLEX,MPI_SUM,master,comm,ier)
969      else
970        call xmpi_largetype_create(ntot,MPI_COMPLEX,my_dt,my_op,MPI_SUM)
971        call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
972        call xmpi_largetype_free(my_dt,my_op)
973      end if
974 
975      xval (:,:,:) = xsum(:,:,:)
976      ABI_FREE(xsum)
977    end if
978  end if
979 #endif
980 
981 end subroutine xmpi_sum_master_c3cplx

ABINIT/xmpi_sum_master_c3dpc [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_c3dpc

FUNCTION

  Reduces values on all processes to a single value.
  Target: three-dimensional double complex arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

1285 subroutine xmpi_sum_master_c3dpc(xval,master,comm,ier)
1286 
1287 !Arguments-------------------------
1288  complex(dpc), DEV_CONTARRD intent(inout) :: xval(:,:,:)
1289  integer,intent(in) :: master
1290  integer,intent(in) :: comm
1291  integer,intent(out) :: ier
1292 
1293 !Local variables-------------------
1294 #if defined HAVE_MPI
1295  integer :: my_dt,my_op,n1,n2,n3
1296  integer(kind=int64) :: ntot
1297  complex(dpc) , allocatable :: xsum(:,:,:)
1298  integer :: nproc_space_comm
1299 #endif
1300 
1301 ! *************************************************************************
1302 
1303  ier=0
1304 #if defined HAVE_MPI
1305  if (comm /= MPI_COMM_NULL) then
1306    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1307    if (nproc_space_comm /= 1) then
1308      n1 = size(xval,dim=1)
1309      n2 = size(xval,dim=2)
1310      n3 = size(xval,dim=3)
1311 
1312      ABI_STAT_MALLOC(xsum,(n1,n2,n3), ier)
1313      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
1314      xsum = (0_dp,0_dp) ! See notes
1315 
1316      !This product of dimensions can be greater than a 32bit integer
1317      !We use a INT64 to store it. If it is too large, we switch to an
1318      !alternate routine because MPI<4 doesnt handle 64 bit counts.
1319      ntot=int(n1*n2*n3,kind=int64)
1320 
1321 !    Accumulate xval on all proc. in comm
1322      if (ntot<=xmpi_maxint32_64) then
1323        call MPI_reduce(xval,xsum,n1*n2*n3,MPI_DOUBLE_COMPLEX,MPI_SUM,master,comm,ier)
1324      else
1325        call xmpi_largetype_create(ntot,MPI_DOUBLE_COMPLEX,my_dt,my_op,MPI_SUM)
1326        call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
1327        call xmpi_largetype_free(my_dt,my_op)
1328      end if
1329 
1330      xval (:,:,:) = xsum(:,:,:)
1331      ABI_FREE(xsum)
1332    end if
1333  end if
1334 #endif
1335 end subroutine xmpi_sum_master_c3dpc

ABINIT/xmpi_sum_master_c4cplx [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_c4cplx

FUNCTION

  Reduces values on all processes to a single value.
  Target: four-dimensional complex arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

1004 subroutine xmpi_sum_master_c4cplx(xval,master,comm,ier)
1005 
1006 !Arguments-------------------------
1007  complex(spc), DEV_CONTARRD intent(inout) :: xval(:,:,:,:)
1008  integer,intent(in) :: master
1009  integer,intent(in) :: comm
1010  integer,intent(out) :: ier
1011 
1012 !Local variables-------------------
1013 #if defined HAVE_MPI
1014  integer :: my_dt,my_op,n1,n2,n3,n4
1015  integer(kind=int64) :: ntot
1016  integer :: nproc_space_comm
1017  complex(spc), allocatable :: xsum(:,:,:,:)
1018 #endif
1019 
1020 ! *************************************************************************
1021 
1022  ier=0
1023 #if defined HAVE_MPI
1024  if (comm /= MPI_COMM_NULL) then
1025    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1026    if (nproc_space_comm /= 1) then
1027      n1 = size(xval,dim=1)
1028      n2 = size(xval,dim=2)
1029      n3 = size(xval,dim=3)
1030      n4 = size(xval,dim=4)
1031 
1032      ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4), ier)
1033      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
1034      xsum = (0_sp,0_sp) ! See notes
1035 
1036      !This product of dimensions can be greater than a 32bit integer
1037      !We use a INT64 to store it. If it is too large, we switch to an
1038      !alternate routine because MPI<4 doesnt handle 64 bit counts.
1039      ntot=int(n1*n2*n3*n4,kind=int64)
1040 
1041 !    Accumulate xval on all proc. in comm
1042      if (ntot<=xmpi_maxint32_64) then
1043        call MPI_reduce(xval,xsum,n1*n2*n3*n4,MPI_COMPLEX,MPI_SUM,master,comm,ier)
1044      else
1045        call xmpi_largetype_create(ntot,MPI_COMPLEX,my_dt,my_op,MPI_SUM)
1046        call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
1047        call xmpi_largetype_free(my_dt,my_op)
1048      end if
1049 
1050      xval (:,:,:,:) = xsum(:,:,:,:)
1051      ABI_FREE(xsum)
1052    end if
1053  end if
1054 #endif
1055 end subroutine xmpi_sum_master_c4cplx

ABINIT/xmpi_sum_master_c4dpc [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_c4dpc

FUNCTION

  Reduces values on all processes to a single value.
  Target: four-dimensional double complex arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

1358 subroutine xmpi_sum_master_c4dpc(xval,master,comm,ier)
1359 
1360 !Arguments-------------------------
1361  complex(dpc), DEV_CONTARRD intent(inout) :: xval(:,:,:,:)
1362  integer,intent(in) :: master
1363  integer,intent(in) :: comm
1364  integer,intent(out) :: ier
1365 
1366 !Local variables-------------------
1367 #if defined HAVE_MPI
1368  integer :: my_dt,my_op,n1,n2,n3,n4
1369  integer(kind=int64) :: ntot
1370  complex(dpc) , allocatable :: xsum(:,:,:,:)
1371  integer :: nproc_space_comm
1372 #endif
1373 
1374 ! *************************************************************************
1375 
1376  ier=0
1377 #if defined HAVE_MPI
1378  if (comm /= MPI_COMM_NULL) then
1379    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1380    if (nproc_space_comm /= 1) then
1381      n1 = size(xval,dim=1)
1382      n2 = size(xval,dim=2)
1383      n3 = size(xval,dim=3)
1384      n4 = size(xval,dim=4)
1385 
1386      ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4), ier)
1387      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
1388      xsum = (0_dp,0_dp) ! See notes
1389 
1390      !This product of dimensions can be greater than a 32bit integer
1391      !We use a INT64 to store it. If it is too large, we switch to an
1392      !alternate routine because MPI<4 doesnt handle 64 bit counts.
1393      ntot=int(n1*n2*n3*n4,kind=int64)
1394 
1395 !    Accumulate xval on all proc. in comm
1396      if (ntot<=xmpi_maxint32_64) then
1397        call MPI_reduce(xval,xsum,n1*n2*n3*n4,MPI_DOUBLE_COMPLEX,MPI_SUM,master,comm,ier)
1398      else
1399        call xmpi_largetype_create(ntot,MPI_DOUBLE_COMPLEX,my_dt,my_op,MPI_SUM)
1400        call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
1401        call xmpi_largetype_free(my_dt,my_op)
1402      end if
1403 
1404      xval (:,:,:,:) = xsum(:,:,:,:)
1405      ABI_FREE(xsum)
1406    end if
1407  end if
1408 #endif
1409 end subroutine xmpi_sum_master_c4dpc

ABINIT/xmpi_sum_master_c5cplx [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_c5cplx

FUNCTION

  Reduces values on all processes to a single value.
  Target: five-dimensional single precision complex arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

1080 subroutine xmpi_sum_master_c5cplx(xval,master,comm,ier)
1081 
1082 !Arguments-------------------------
1083  complex(spc), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:)
1084  integer,intent(in) :: master
1085  integer,intent(in) :: comm
1086  integer,intent(out) :: ier
1087 
1088 !Local variables-------------------
1089 #if defined HAVE_MPI
1090  integer :: my_dt,my_op,n1,n2,n3,n4,n5
1091  integer(kind=int64) :: ntot
1092  complex(spc),allocatable :: xsum(:,:,:,:,:)
1093  integer :: nproc_space_comm
1094 #endif
1095 
1096 ! *************************************************************************
1097 
1098  ier=0
1099 #if defined HAVE_MPI
1100  if (comm /= MPI_COMM_NULL) then
1101    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1102    if (nproc_space_comm /= 1) then
1103      n1 = size(xval,dim=1)
1104      n2 = size(xval,dim=2)
1105      n3 = size(xval,dim=3)
1106      n4 = size(xval,dim=4)
1107      n5 = size(xval,dim=5)
1108 
1109      ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5), ier)
1110      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
1111      xsum = (0_sp,0_sp) ! See notes
1112 
1113      !This product of dimensions can be greater than a 32bit integer
1114      !We use a INT64 to store it. If it is too large, we switch to an
1115      !alternate routine because MPI<4 doesnt handle 64 bit counts.
1116      ntot=int(n1*n2*n3*n4*n5,kind=int64)
1117 
1118 !    Accumulate xval on all proc. in comm
1119      if (ntot<=xmpi_maxint32_64) then
1120        call MPI_reduce(xval,xsum,n1*n2*n3*n4*n5,MPI_COMPLEX,MPI_SUM,master,comm,ier)
1121      else
1122        call xmpi_largetype_create(ntot,MPI_COMPLEX,my_dt,my_op,MPI_SUM)
1123        call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
1124        call xmpi_largetype_free(my_dt,my_op)
1125      end if
1126 
1127      xval = xsum
1128      ABI_FREE(xsum)
1129    end if
1130  end if
1131 #endif
1132 end subroutine xmpi_sum_master_c5cplx

ABINIT/xmpi_sum_master_c5dpc [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_c5dpc

FUNCTION

  Reduces values on all processes to a single value.
  Target: five-dimensional double complex arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

1432 subroutine xmpi_sum_master_c5dpc(xval,master,comm,ier)
1433 
1434 !Arguments-------------------------
1435  complex(dpc), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:)
1436  integer,intent(in) :: master
1437  integer,intent(in) :: comm
1438  integer,intent(out) :: ier
1439 
1440 !Local variables-------------------
1441 #if defined HAVE_MPI
1442  integer :: my_dt,my_op,n1,n2,n3,n4,n5
1443  integer(kind=int64) :: ntot
1444  complex(dpc),allocatable :: xsum(:,:,:,:,:)
1445  integer :: nproc_space_comm
1446 #endif
1447 
1448 ! *************************************************************************
1449 
1450  ier=0
1451 #if defined HAVE_MPI
1452  if (comm /= MPI_COMM_NULL) then
1453    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
1454    if (nproc_space_comm /= 1) then
1455      n1 = size(xval,dim=1)
1456      n2 = size(xval,dim=2)
1457      n3 = size(xval,dim=3)
1458      n4 = size(xval,dim=4)
1459      n5 = size(xval,dim=5)
1460 
1461      ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5), ier)
1462      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
1463      xsum = (0_dp,0_dp) ! See notes
1464 
1465      !This product of dimensions can be greater than a 32bit integer
1466      !We use a INT64 to store it. If it is too large, we switch to an
1467      !alternate routine because MPI<4 doesnt handle 64 bit counts.
1468      ntot=int(n1*n2*n3*n4*n5,kind=int64)
1469 
1470 !    Accumulate xval on all proc. in comm
1471      if (ntot<=xmpi_maxint32_64) then
1472        call MPI_reduce(xval,xsum,n1*n2*n3*n4*n5,MPI_DOUBLE_COMPLEX,MPI_SUM,master,comm,ier)
1473      else
1474        call xmpi_largetype_create(ntot,MPI_DOUBLE_COMPLEX,my_dt,my_op,MPI_SUM)
1475        call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
1476        call xmpi_largetype_free(my_dt,my_op)
1477      end if
1478 
1479      xval (:,:,:,:,:) = xsum(:,:,:,:,:)
1480      ABI_FREE(xsum)
1481    end if
1482  end if
1483 #endif
1484 end subroutine xmpi_sum_master_c5dpc

ABINIT/xmpi_sum_master_dp [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_p

FUNCTION

  Reduces values on all processes to a single value.
  Target: integer scalars.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

 97 subroutine xmpi_sum_master_dp(xval,master,comm,ier)
 98 
 99 !Arguments-------------------------
100  real(dp),intent(inout) :: xval
101  integer ,intent(in) :: master
102  integer ,intent(in) :: comm
103  integer ,intent(out)   :: ier
104 
105 !Local variables-------------------
106 #if defined HAVE_MPI
107  integer :: nproc_space_comm
108  real(dp) :: arr_xsum(1)
109 #endif
110 
111 ! *************************************************************************
112 
113  ier=0
114 #if defined HAVE_MPI
115  if (comm /= MPI_COMM_NULL) then
116    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
117    if (nproc_space_comm /= 1) then
118 !    Accumulate xval on all proc. in comm
119      call MPI_REDUCE([xval],arr_xsum,1,MPI_DOUBLE_PRECISION,MPI_SUM,master,comm,ier)
120      xval = arr_xsum(1)
121    end if
122  end if
123 #endif
124 end subroutine xmpi_sum_master_dp

ABINIT/xmpi_sum_master_dp1d [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_dp1d

FUNCTION

  Reduces values on all processes to a single value.
  Target: double precision one-dimensional arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

219 subroutine xmpi_sum_master_dp1d(xval,master,comm,ier)
220 
221 !Arguments-------------------------
222  real(dp), DEV_CONTARRD intent(inout) :: xval(:)
223  integer ,intent(in) :: master
224  integer ,intent(in) :: comm
225  integer ,intent(out) :: ier
226 
227 !Local variables-------------------
228 #if defined HAVE_MPI
229  integer :: n1
230  real(dp) , allocatable :: xsum(:)
231  integer :: nproc_space_comm
232 #endif
233 
234 ! *************************************************************************
235 
236  ier=0
237 #if defined HAVE_MPI
238  if (comm /= MPI_COMM_NULL) then
239    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
240    if (nproc_space_comm /= 1) then
241      n1 = size(xval,dim=1)
242 !    Accumulate xval on all proc. in comm
243      ABI_STAT_MALLOC(xsum,(n1), ier)
244      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
245      xsum = zero ! See notes
246      call MPI_REDUCE(xval,xsum,n1,MPI_DOUBLE_PRECISION,MPI_SUM,master,comm,ier)
247      xval (:) = xsum(:)
248      ABI_FREE(xsum)
249    end if
250  end if
251 #endif
252 end subroutine xmpi_sum_master_dp1d

ABINIT/xmpi_sum_master_dp2d [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_dp2d

FUNCTION

  Reduces values on all processes to a single value.
  Target: double precision two-dimensional arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

275 subroutine xmpi_sum_master_dp2d(xval,master,comm,ier)
276 
277 !Arguments-------------------------
278  real(dp), DEV_CONTARRD intent(inout) :: xval(:,:)
279  integer ,intent(in) :: master
280  integer ,intent(in) :: comm
281  integer ,intent(out) :: ier
282 
283 !Local variables-------------------
284 #if defined HAVE_MPI
285  integer :: my_dt,my_op,n1,n2
286  integer(kind=int64) :: ntot
287  real(dp) , allocatable :: xsum(:,:)
288  integer :: nproc_space_comm
289 #endif
290 
291 ! *************************************************************************
292 
293  ier=0
294 #if defined HAVE_MPI
295  if (comm /= MPI_COMM_NULL) then
296    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
297    if (nproc_space_comm /= 1) then
298      n1 = size(xval,dim=1)
299      n2 = size(xval,dim=2)
300 
301      ABI_STAT_MALLOC(xsum,(n1,n2), ier)
302      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
303      xsum = zero ! See notes
304 
305      !This product of dimensions can be greater than a 32bit integer
306      !We use a INT64 to store it. If it is too large, we switch to an
307      !alternate routine because MPI<4 doesnt handle 64 bit counts.
308      ntot=int(n1*n2,kind=int64)
309 
310 !    Accumulate xval on all proc. in comm
311      if (ntot<=xmpi_maxint32_64) then
312        call MPI_reduce(xval,xsum,n1*n2,MPI_DOUBLE_PRECISION,MPI_SUM,master,comm,ier)
313      else
314        call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_SUM)
315        call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
316        call xmpi_largetype_free(my_dt,my_op)
317      end if
318 
319      xval (:,:) = xsum(:,:)
320      ABI_FREE(xsum)
321    end if
322  end if
323 #endif
324 end subroutine xmpi_sum_master_dp2d

ABINIT/xmpi_sum_master_dp3d [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_dp3d

FUNCTION

  Reduces values on all processes to a single value.
  Target: double precision three-dimensional arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

347 subroutine xmpi_sum_master_dp3d(xval,master,comm,ier)
348 
349 !Arguments-------------------------
350  real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:)
351  integer ,intent(in) :: master
352  integer ,intent(in) :: comm
353  integer ,intent(out) :: ier
354 
355 !Local variables-------------------
356 #if defined HAVE_MPI
357  integer :: my_dt,my_op,n1,n2,n3
358  integer(kind=int64) :: ntot
359  real(dp) , allocatable :: xsum(:,:,:)
360  integer :: nproc_space_comm
361 #endif
362 
363 ! *************************************************************************
364 
365  ier=0
366 #if defined HAVE_MPI
367  if (comm /= MPI_COMM_NULL) then
368    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
369    if (nproc_space_comm /= 1) then
370      n1 = size(xval,dim=1)
371      n2 = size(xval,dim=2)
372      n3 = size(xval,dim=3)
373      ABI_STAT_MALLOC(xsum,(n1,n2,n3), ier)
374      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
375      xsum = zero ! See notes
376 
377 
378      !This product of dimensions can be greater than a 32bit integer
379      !We use a INT64 to store it. If it is too large, we switch to an
380      !alternate routine because MPI<4 doesnt handle 64 bit counts.
381      ntot=int(n1*n2*n3,kind=int64)
382 
383 !    Accumulate xval on all proc. in comm
384      if (ntot<=xmpi_maxint32_64) then
385        call MPI_reduce(xval,xsum,n1*n2*n3,MPI_DOUBLE_PRECISION,MPI_SUM,master,comm,ier)
386      else
387        call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_SUM)
388        call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
389        call xmpi_largetype_free(my_dt,my_op)
390      end if
391 
392      xval (:,:,:) = xsum(:,:,:)
393      ABI_FREE(xsum)
394    end if
395  end if
396 #endif
397 
398 end subroutine xmpi_sum_master_dp3d

ABINIT/xmpi_sum_master_dp4d [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_dp4d

FUNCTION

  Reduces values on all processes to a single value.
  Target: double precision four-dimensional arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

421 subroutine xmpi_sum_master_dp4d(xval,master,comm,ier)
422 
423 !Arguments-------------------------
424  real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:)
425  integer ,intent(in) :: master
426  integer ,intent(in) :: comm
427  integer ,intent(out) :: ier
428 
429 !Local variables-------------------
430 #if defined HAVE_MPI
431  integer :: my_dt,my_op,n1,n2,n3,n4
432  integer(kind=int64) :: ntot
433  real(dp) , allocatable :: xsum(:,:,:,:)
434  integer :: nproc_space_comm
435 #endif
436 
437 ! *************************************************************************
438 
439  ier=0
440 #if defined HAVE_MPI
441  if (comm /= MPI_COMM_NULL) then
442    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
443    if (nproc_space_comm /= 1) then
444      n1 = size(xval,dim=1)
445      n2 = size(xval,dim=2)
446      n3 = size(xval,dim=3)
447      n4 = size(xval,dim=4)
448      ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4), ier)
449      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
450      xsum = zero ! See notes
451 
452      !This product of dimensions can be greater than a 32bit integer
453      !We use a INT64 to store it. If it is too large, we switch to an
454      !alternate routine because MPI<4 doesnt handle 64 bit counts.
455      ntot=int(n1*n2*n3*n4,kind=int64)
456 
457 !    Accumulate xval on all proc. in comm
458      if (ntot<=xmpi_maxint32_64) then
459        call MPI_reduce(xval,xsum,n1*n2*n3*n4,MPI_DOUBLE_PRECISION,MPI_SUM,master,comm,ier)
460      else
461        call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_SUM)
462        call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
463        call xmpi_largetype_free(my_dt,my_op)
464      end if
465 
466      xval (:,:,:,:) = xsum(:,:,:,:)
467      ABI_FREE(xsum)
468    end if
469  end if
470 #endif
471 
472 end subroutine xmpi_sum_master_dp4d

ABINIT/xmpi_sum_master_dp5d [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_dp5d

FUNCTION

  Reduces values on all processes to a single value.
  Target: double precision five-dimensional arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

495 subroutine xmpi_sum_master_dp5d(xval,master,comm,ier)
496 
497 !Arguments ------------------------------------
498  real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:)
499  integer ,intent(in) :: master
500  integer ,intent(in) :: comm
501  integer ,intent(out)   :: ier
502 
503 !Local variables-------------------------------
504 #if defined HAVE_MPI
505  integer :: my_dt,my_op,n1,n2,n3,n4,n5
506  integer(kind=int64) :: ntot
507  real(dp), allocatable :: xsum(:,:,:,:,:)
508  integer :: nproc_space_comm
509 #endif
510 
511 ! *************************************************************************
512 
513  ier=0
514 #if defined HAVE_MPI
515  if (comm /= MPI_COMM_NULL) then
516    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
517    if (nproc_space_comm /= 1) then
518      n1 = size(xval,dim=1)
519      n2 = size(xval,dim=2)
520      n3 = size(xval,dim=3)
521      n4 = size(xval,dim=4)
522      n5 = size(xval,dim=5)
523 
524      ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5), ier)
525      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
526      xsum = zero ! See notes
527 
528      !This product of dimensions can be greater than a 32bit integer
529      !We use a INT64 to store it. If it is too large, we switch to an
530      !alternate routine because MPI<4 doesnt handle 64 bit counts.
531      ntot=int(n1*n2*n3*n4*n5,kind=int64)
532 
533 !    Accumulate xval on all proc. in comm
534      if (ntot<=xmpi_maxint32_64) then
535        call MPI_reduce(xval,xsum,n1*n2*n3*n4*n5,MPI_DOUBLE_PRECISION,MPI_SUM,master,comm,ier)
536      else
537        call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_SUM)
538        call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
539        call xmpi_largetype_free(my_dt,my_op)
540      end if
541 
542      xval (:,:,:,:,:) = xsum(:,:,:,:,:)
543      ABI_FREE(xsum)
544    end if
545  end if
546 #endif
547 
548 end subroutine xmpi_sum_master_dp5d

ABINIT/xmpi_sum_master_dp6d [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_dp6d

FUNCTION

  Reduces values on all processes to a single value.
  Target: double precision six-dimensional arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

571 subroutine xmpi_sum_master_dp6d(xval,master,comm,ier)
572 
573 !Arguments ------------------------------------
574  real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:,:)
575  integer ,intent(in) :: master
576  integer ,intent(in) :: comm
577  integer ,intent(out) :: ier
578 
579 !Local variables-------------------------------
580 #if defined HAVE_MPI
581  integer :: my_dt,my_op,n1,n2,n3,n4,n5,n6
582  integer(kind=int64) :: ntot
583  real(dp), allocatable :: xsum(:,:,:,:,:,:)
584  integer :: nproc_space_comm
585 #endif
586 
587 ! *************************************************************************
588 
589  ier=0
590 #if defined HAVE_MPI
591  if (comm /= MPI_COMM_NULL) then
592    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
593    if (nproc_space_comm /= 1) then
594      n1 = size(xval,dim=1)
595      n2 = size(xval,dim=2)
596      n3 = size(xval,dim=3)
597      n4 = size(xval,dim=4)
598      n5 = size(xval,dim=5)
599      n6 = size(xval,dim=6)
600 
601      ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5,n6), ier)
602      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
603      xsum = zero ! See notes
604 
605      !This product of dimensions can be greater than a 32bit integer
606      !We use a INT64 to store it. If it is too large, we switch to an
607      !alternate routine because MPI<4 doesnt handle 64 bit counts.
608      ntot=int(n1*n2*n3*n4*n5*n6,kind=int64)
609 
610 !    Accumulate xval on all proc. in comm
611      if (ntot<=xmpi_maxint32_64) then
612        call MPI_reduce(xval,xsum,n1*n2*n3*n4*n5*n6,MPI_DOUBLE_PRECISION,MPI_SUM,master,comm,ier)
613      else
614        call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_SUM)
615        call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
616        call xmpi_largetype_free(my_dt,my_op)
617      end if
618 
619      xval (:,:,:,:,:,:) = xsum(:,:,:,:,:,:)
620      ABI_FREE(xsum)
621    end if
622  end if
623 #endif
624 
625 end subroutine xmpi_sum_master_dp6d

ABINIT/xmpi_sum_master_dp7d [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_dp7d

FUNCTION

  Reduces values on all processes to a single value.
  Target: double precision seven-dimensional arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

648 subroutine xmpi_sum_master_dp7d(xval,master,comm,ier)
649 
650 !Arguments ------------------------------------
651  real(dp), DEV_CONTARRD intent(inout) :: xval(:,:,:,:,:,:,:)
652  integer ,intent(in) :: master
653  integer ,intent(in) :: comm
654  integer ,intent(out) :: ier
655 
656 !Local variables-------------------------------
657 #if defined HAVE_MPI
658  integer :: my_dt,my_op,n1,n2,n3,n4,n5,n6,n7
659  integer(kind=int64) :: ntot
660  real(dp), allocatable :: xsum(:,:,:,:,:,:,:)
661  integer :: nproc_space_comm
662 #endif
663 
664 ! *************************************************************************
665 
666  ier=0
667 #if defined HAVE_MPI
668  if (comm /= MPI_COMM_NULL) then
669    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
670    if (nproc_space_comm /= 1) then
671      n1 = size(xval,dim=1)
672      n2 = size(xval,dim=2)
673      n3 = size(xval,dim=3)
674      n4 = size(xval,dim=4)
675      n5 = size(xval,dim=5)
676      n6 = size(xval,dim=6)
677      n7 = size(xval,dim=7)
678 
679      ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4,n5,n6,n7), ier)
680      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
681      xsum = zero ! See notes
682 
683      !This product of dimensions can be greater than a 32bit integer
684      !We use a INT64 to store it. If it is too large, we switch to an
685      !alternate routine because MPI<4 doesnt handle 64 bit counts.
686      ntot=int(n1*n2*n3*n4*n5*n6*n7,kind=int64)
687 
688 !    Accumulate xval on all proc. in comm
689      if (ntot<=xmpi_maxint32_64) then
690        call MPI_reduce(xval,xsum,n1*n2*n3*n4*n5*n6*n7,MPI_DOUBLE_PRECISION,MPI_SUM,master,comm,ier)
691      else
692        call xmpi_largetype_create(ntot,MPI_DOUBLE_PRECISION,my_dt,my_op,MPI_SUM)
693        call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
694        call xmpi_largetype_free(my_dt,my_op)
695      end if
696 
697      xval (:,:,:,:,:,:,:) = xsum(:,:,:,:,:,:,:)
698      ABI_FREE(xsum)
699    end if
700  end if
701 #endif
702 
703 end subroutine xmpi_sum_master_dp7d

ABINIT/xmpi_sum_master_int [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_int

FUNCTION

  Reduces values on all processes to a single value.
  Target: integer scalars.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

47 subroutine xmpi_sum_master_int(xval,master,comm,ier)
48 
49 !Arguments-------------------------
50  integer,intent(inout) :: xval
51  integer ,intent(in) :: master
52  integer ,intent(in) :: comm
53  integer ,intent(out)   :: ier
54 
55 !Local variables-------------------
56 #if defined HAVE_MPI
57  integer :: nproc_space_comm
58  integer :: arr_xsum(1)
59 #endif
60 
61 ! *************************************************************************
62 
63  ier=0
64 #if defined HAVE_MPI
65  if (comm /= MPI_COMM_NULL) then
66    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
67    if (nproc_space_comm /= 1) then
68 !    Accumulate xval on all proc. in comm
69      call MPI_REDUCE([xval],arr_xsum,1,MPI_INTEGER,MPI_SUM,master,comm,ier)
70      xval = arr_xsum(1)
71    end if
72  end if
73 #endif
74 end subroutine xmpi_sum_master_int

ABINIT/xmpi_sum_master_int2d [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_int2d

FUNCTION

  Reduces values on all processes to a single value.
  Target: two-dimensional integer arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

147 subroutine xmpi_sum_master_int2d(xval,master,comm,ier)
148 
149 !Arguments ------------------------------------
150  integer, DEV_CONTARRD intent(inout) :: xval(:,:)
151  integer,intent(in) :: master,comm
152  integer,intent(out) :: ier
153 
154 !Local variables-------------------------------
155 #if defined HAVE_MPI
156  integer :: my_dt,my_op,n1,n2
157  integer(kind=int64) :: ntot
158  integer, allocatable :: xsum(:,:)
159  integer :: nproc_space_comm
160 #endif
161 
162 ! *************************************************************************
163 
164  ier=0
165 #if defined HAVE_MPI
166  if (comm /= MPI_COMM_NULL) then
167    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
168    if (nproc_space_comm /= 1) then
169      n1 = size(xval,dim=1)
170      n2 = size(xval,dim=2)
171 
172      ABI_STAT_MALLOC(xsum,(n1,n2), ier)
173      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
174      xsum = 0 ! See notes
175 
176      !This product of dimensions can be greater than a 32bit integer
177      !We use a INT64 to store it. If it is too large, we switch to an
178      !alternate routine because MPI<4 doesnt handle 64 bit counts.
179      ntot=int(n1*n2,kind=int64)
180 
181 !    Accumulate xval on all proc. in comm
182      if (ntot<=xmpi_maxint32_64) then
183        call MPI_reduce(xval,xsum,n1*n2,MPI_INTEGER,MPI_SUM,master,comm,ier)
184      else
185        call xmpi_largetype_create(ntot,MPI_INTEGER,my_dt,my_op,MPI_SUM)
186        call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
187        call xmpi_largetype_free(my_dt,my_op)
188      end if
189 
190      xval = xsum
191      ABI_FREE(xsum)
192    end if
193  end if
194 #endif
195 
196 end subroutine xmpi_sum_master_int2d

ABINIT/xmpi_sum_master_int4d [ Functions ]

[ Top ] [ Functions ]

NAME

  xmpi_sum_master_int4d

FUNCTION

  Reduces values on all processes to a single value.
  Target: four-diemnsional integer arrays.

INPUTS

  master= master MPI node
  comm= MPI communicator

OUTPUT

  ier= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  xval= buffer array

SOURCE

726 subroutine xmpi_sum_master_int4d(xval,master,comm,ier)
727 
728 !Arguments ------------------------------------
729  integer, DEV_CONTARRD intent(inout) :: xval(:,:,:,:)
730  integer,intent(in) :: master
731  integer,intent(in) :: comm
732  integer,intent(out) :: ier
733 
734 !Local variables-------------------------------
735 #if defined HAVE_MPI
736  integer :: my_dt,my_op,n1,n2,n3,n4
737  integer(kind=int64) :: ntot
738  integer, allocatable :: xsum(:,:,:,:)
739  integer :: nproc_space_comm
740 #endif
741 
742 ! *************************************************************************
743 
744  ier=0
745 #if defined HAVE_MPI
746  if (comm /= MPI_COMM_NULL) then
747    call MPI_COMM_SIZE(comm,nproc_space_comm,ier)
748    if (nproc_space_comm /= 1) then
749      n1 = size(xval,dim=1)
750      n2 = size(xval,dim=2)
751      n3 = size(xval,dim=3)
752      n4 = size(xval,dim=4)
753 
754      ABI_STAT_MALLOC(xsum,(n1,n2,n3,n4), ier)
755      if (ier /= 0) call xmpi_abort(msg='error allocating xsum')
756      xsum = 0 ! See notes
757 
758      !This product of dimensions can be greater than a 32bit integer
759      !We use a INT64 to store it. If it is too large, we switch to an
760      !alternate routine because MPI<4 doesnt handle 64 bit counts.
761      ntot=int(n1*n2*n3*n4,kind=int64)
762 
763 !    Accumulate xval on all proc. in comm
764      if (ntot<=xmpi_maxint32_64) then
765        call MPI_reduce(xval,xsum,n1*n2*n3*n4,MPI_INTEGER,MPI_SUM,master,comm,ier)
766      else
767        call xmpi_largetype_create(ntot,MPI_INTEGER,my_dt,my_op,MPI_SUM)
768        call MPI_reduce(xval,xsum,1,my_dt,my_op,master,comm,ier)
769        call xmpi_largetype_free(my_dt,my_op)
770      end if
771 
772      xval (:,:,:,:) = xsum(:,:,:,:)
773      ABI_FREE(xsum)
774    end if
775  end if
776 #endif
777 
778 end subroutine xmpi_sum_master_int4d