|
CP2K 2.4 (Revision 12889)
|
00001 !-----------------------------------------------------------------------------! 00002 ! CP2K: A general program to perform molecular dynamics simulations ! 00003 ! Copyright (C) 2000 - 2013 CP2K developers group ! 00004 !-----------------------------------------------------------------------------! 00005 00006 ! ***************************************************************************** 00015 MODULE dbcsr_mp_operations 00016 00017 USE dbcsr_config, ONLY: has_MPI 00018 USE dbcsr_data_methods, ONLY: dbcsr_data_get_type 00019 USE dbcsr_error_handling 00020 USE dbcsr_kinds, ONLY: real_4,& 00021 real_8 00022 USE dbcsr_message_passing, ONLY: & 00023 mp_allgather, mp_alltoall, mp_irecv, mp_isend, mp_recv, mp_send, & 00024 mp_type_descriptor_type, mp_type_make, mp_waitall 00025 USE dbcsr_methods, ONLY: & 00026 dbcsr_mp_get_process, dbcsr_mp_grid_setup, dbcsr_mp_group, & 00027 dbcsr_mp_has_subgroups, dbcsr_mp_my_col_group, dbcsr_mp_my_row_group, & 00028 dbcsr_mp_mynode, dbcsr_mp_mypcol, dbcsr_mp_myprow, dbcsr_mp_npcols, & 00029 dbcsr_mp_nprows, dbcsr_mp_numnodes, dbcsr_mp_pgrid 00030 USE dbcsr_types, ONLY: dbcsr_data_obj,& 00031 dbcsr_mp_obj,& 00032 dbcsr_type_complex_4,& 00033 dbcsr_type_complex_8,& 00034 dbcsr_type_real_4,& 00035 dbcsr_type_real_8 00036 00037 !$ USE OMP_LIB 00038 00039 IMPLICIT NONE 00040 00041 PRIVATE 00042 00043 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'dbcsr_mp_operations' 00044 00045 REAL, PARAMETER :: default_resize_factor = 1.618034 00046 00047 ! MP routines 00048 PUBLIC :: dbcsr_hybrid_alltoall 00049 PUBLIC :: hybrid_alltoall_s1, hybrid_alltoall_d1,& 00050 hybrid_alltoall_c1, hybrid_alltoall_z1,& 00051 hybrid_alltoall_i1, hybrid_alltoall_any 00052 PUBLIC :: dbcsr_allgatherv 00053 PUBLIC :: dbcsr_send_any, dbcsr_recv_any 00054 PUBLIC :: dbcsr_isend_any, dbcsr_irecv_any 00055 ! Type helpers 00056 PUBLIC :: dbcsr_mp_type_from_anytype 00057 00058 INTERFACE dbcsr_hybrid_alltoall 00059 MODULE PROCEDURE hybrid_alltoall_s1, hybrid_alltoall_d1,& 00060 hybrid_alltoall_c1, hybrid_alltoall_z1 00061 MODULE PROCEDURE hybrid_alltoall_i1 00062 MODULE PROCEDURE hybrid_alltoall_any 00063 END INTERFACE 00064 00065 CONTAINS 00066 00067 00068 SUBROUTINE hybrid_alltoall_any (sb, scount, sdispl,& 00069 rb, rcount, rdispl, mp_env, most_ptp, remainder_ptp, no_hybrid,& 00070 error) 00071 TYPE(dbcsr_data_obj), INTENT(IN) :: sb 00072 INTEGER, DIMENSION(:), INTENT(IN) :: scount, sdispl 00073 TYPE(dbcsr_data_obj), INTENT(INOUT) :: rb 00074 INTEGER, DIMENSION(:), INTENT(IN) :: rcount, rdispl 00075 TYPE(dbcsr_mp_obj), INTENT(IN) :: mp_env 00076 LOGICAL, INTENT(in), OPTIONAL :: most_ptp, remainder_ptp, 00077 no_hybrid 00078 TYPE(dbcsr_error_type) :: error 00079 00080 CHARACTER(len=*), PARAMETER :: routineN = 'hybrid_alltoall_any', 00081 routineP = moduleN//':'//routineN 00082 00083 INTEGER :: error_handle 00084 00085 ! --------------------------------------------------------------------------- 00086 00087 CALL dbcsr_error_set(routineN, error_handle, error) 00088 00089 SELECT CASE (dbcsr_data_get_type (sb)) 00090 CASE (dbcsr_type_real_4) 00091 CALL hybrid_alltoall_s1 (sb%d%r_sp, scount, sdispl,& 00092 rb%d%r_sp, rcount, rdispl, mp_env,& 00093 most_ptp, remainder_ptp, no_hybrid) 00094 CASE (dbcsr_type_real_8) 00095 CALL hybrid_alltoall_d1 (sb%d%r_dp, scount, sdispl,& 00096 rb%d%r_dp, rcount, rdispl, mp_env,& 00097 most_ptp, remainder_ptp, no_hybrid) 00098 CASE (dbcsr_type_complex_4) 00099 CALL hybrid_alltoall_c1 (sb%d%c_sp, scount, sdispl,& 00100 rb%d%c_sp, rcount, rdispl, mp_env,& 00101 most_ptp, remainder_ptp, no_hybrid) 00102 CASE (dbcsr_type_complex_8) 00103 CALL hybrid_alltoall_z1 (sb%d%c_dp, scount, sdispl,& 00104 rb%d%c_dp, rcount, rdispl, mp_env,& 00105 most_ptp, remainder_ptp, no_hybrid) 00106 CASE default 00107 CALL dbcsr_assert (.FALSE., dbcsr_fatal_level, dbcsr_internal_error,& 00108 routineN, "Invalid data type",__LINE__,error) 00109 END SELECT 00110 00111 CALL dbcsr_error_stop(error_handle, error) 00112 END SUBROUTINE hybrid_alltoall_any 00113 00114 00115 ! ***************************************************************************** 00131 SUBROUTINE hybrid_alltoall_i1 (sb, scount, sdispl,& 00132 rb, rcount, rdispl, mp_env, most_ptp, remainder_ptp, no_hybrid) 00133 INTEGER, DIMENSION(:), INTENT(in), 00134 TARGET :: sb 00135 INTEGER, DIMENSION(:), INTENT(IN) :: scount, sdispl 00136 INTEGER, DIMENSION(:), 00137 INTENT(INOUT), TARGET :: rb 00138 INTEGER, DIMENSION(:), INTENT(IN) :: rcount, rdispl 00139 TYPE(dbcsr_mp_obj), INTENT(IN) :: mp_env 00140 LOGICAL, INTENT(IN), OPTIONAL :: most_ptp, remainder_ptp, 00141 no_hybrid 00142 00143 CHARACTER(len=*), PARAMETER :: routineN = 'hybrid_alltoall_i1', 00144 routineP = moduleN//':'//routineN 00145 00146 INTEGER :: all_group, mynode, mypcol, myprow, nall_rr, nall_sr, ncol_rr, 00147 ncol_sr, npcols, nprows, nrow_rr, nrow_sr, numnodes, dst, src, 00148 prow, pcol, send_cnt, recv_cnt, tag, grp, i 00149 INTEGER, ALLOCATABLE, DIMENSION(:) :: all_rr, all_sr, col_rr, col_sr, 00150 new_rcount, new_rdispl, new_scount, new_sdispl, row_rr, row_sr 00151 INTEGER, DIMENSION(:, :), POINTER :: pgrid 00152 LOGICAL :: most_collective, 00153 remainder_collective, no_h 00154 INTEGER, DIMENSION(:), POINTER :: send_data_p, recv_data_p 00155 TYPE(dbcsr_mp_obj) :: mpe 00156 00157 !CALL dbcsr_assert (mp_env%mp%subgroups_defined, dbcsr_warning_level,& 00158 ! dbcsr_caller_error, routineN, "Row/col communicators undefined.") 00159 IF (.NOT. dbcsr_mp_has_subgroups (mp_env)) THEN 00160 mpe = mp_env 00161 CALL dbcsr_mp_grid_setup (mpe) 00162 ENDIF 00163 most_collective = .TRUE. 00164 remainder_collective = .TRUE. 00165 no_h = .FALSE. 00166 IF (PRESENT (most_ptp)) most_collective = .NOT. most_ptp 00167 IF (PRESENT (remainder_ptp)) remainder_collective = .NOT. remainder_ptp 00168 IF (PRESENT (no_hybrid)) no_h = no_hybrid 00169 all_group = dbcsr_mp_group (mp_env) 00170 ! Don't use subcommunicators if they're not defined. 00171 no_h = no_h .OR. .NOT. dbcsr_mp_has_subgroups (mp_env) .OR. .NOT. has_MPI 00172 subgrouped: IF (mp_env%mp%subgroups_defined .AND. .NOT. no_h) THEN 00173 mynode = dbcsr_mp_mynode (mp_env) 00174 numnodes = dbcsr_mp_numnodes (mp_env) 00175 nprows = dbcsr_mp_nprows (mp_env) 00176 npcols = dbcsr_mp_npcols (mp_env) 00177 myprow = dbcsr_mp_myprow (mp_env) 00178 mypcol = dbcsr_mp_mypcol (mp_env) 00179 pgrid => dbcsr_mp_pgrid (mp_env) 00180 ALLOCATE (row_sr(0:npcols-1)) ; nrow_sr = 0 00181 ALLOCATE (row_rr(0:npcols-1)) ; nrow_rr = 0 00182 ALLOCATE (col_sr(0:nprows-1)) ; ncol_sr = 0 00183 ALLOCATE (col_rr(0:nprows-1)) ; ncol_rr = 0 00184 ALLOCATE (all_sr(0:numnodes-1)) ; nall_sr = 0 00185 ALLOCATE (all_rr(0:numnodes-1)) ; nall_rr = 0 00186 ALLOCATE (new_scount(numnodes), new_rcount(numnodes)) 00187 ALLOCATE (new_sdispl(numnodes), new_rdispl(numnodes)) 00188 IF (.NOT.remainder_collective) THEN 00189 CALL remainder_point_to_point () 00190 ENDIF 00191 IF (.NOT.most_collective) THEN 00192 CALL most_point_to_point () 00193 ELSE 00194 CALL most_alltoall () 00195 ENDIF 00196 IF (remainder_collective) THEN 00197 CALL remainder_alltoall () 00198 ENDIF 00199 ! Wait for all issued sends and receives. 00200 IF (.NOT.most_collective) THEN 00201 CALL mp_waitall (row_sr(0:nrow_sr-1)) 00202 CALL mp_waitall (col_sr(0:ncol_sr-1)) 00203 CALL mp_waitall (row_rr(0:nrow_rr-1)) 00204 CALL mp_waitall (col_rr(0:ncol_rr-1)) 00205 END IF 00206 IF (.NOT.remainder_collective) THEN 00207 CALL mp_waitall (all_sr(1:nall_sr)) 00208 CALL mp_waitall (all_rr(1:nall_rr)) 00209 ENDIF 00210 ELSE 00211 CALL mp_alltoall (sb, scount, sdispl,& 00212 rb, rcount, rdispl,& 00213 all_group) 00214 ENDIF subgrouped 00215 CONTAINS 00216 SUBROUTINE most_alltoall() 00217 FORALL (pcol = 0 : npcols-1) 00218 new_scount(1+pcol) = scount(1+pgrid(myprow, pcol)) 00219 new_rcount(1+pcol) = rcount(1+pgrid(myprow, pcol)) 00220 new_sdispl(1+pcol) = sdispl(1+pgrid(myprow, pcol)) 00221 new_rdispl(1+pcol) = rdispl(1+pgrid(myprow, pcol)) 00222 END FORALL 00223 CALL mp_alltoall (sb, new_scount(1:npcols), new_sdispl(1:npcols),& 00224 rb, new_rcount(1:npcols), new_rdispl(1:npcols),& 00225 dbcsr_mp_my_row_group (mp_env)) 00226 FORALL (prow = 0 : nprows-1) 00227 new_scount(1+prow) = scount(1+pgrid(prow, mypcol)) 00228 new_rcount(1+prow) = rcount(1+pgrid(prow, mypcol)) 00229 new_sdispl(1+prow) = sdispl(1+pgrid(prow, mypcol)) 00230 new_rdispl(1+prow) = rdispl(1+pgrid(prow, mypcol)) 00231 END FORALL 00232 CALL mp_alltoall (sb, new_scount(1:nprows), new_sdispl(1:nprows),& 00233 rb, new_rcount(1:nprows), new_rdispl(1:nprows),& 00234 dbcsr_mp_my_col_group (mp_env)) 00235 END SUBROUTINE most_alltoall 00236 SUBROUTINE most_point_to_point () 00237 ! Go through my prow and exchange. 00238 DO i = 0, npcols - 1 00239 pcol = MOD (mypcol+i, npcols) 00240 grp = dbcsr_mp_my_row_group (mp_env) 00241 ! 00242 dst = dbcsr_mp_get_process (mp_env, myprow, pcol) 00243 send_cnt = scount(dst+1) 00244 send_data_p => sb( 1+sdispl(dst+1) : 1+sdispl(dst+1)+send_cnt-1 ) 00245 tag = 4*mypcol 00246 IF (send_cnt .GT. 0) THEN 00247 CALL mp_isend (send_data_p, pcol, grp, row_sr(nrow_sr), tag) 00248 nrow_sr = nrow_sr+1 00249 ENDIF 00250 ! 00251 pcol = MODULO (mypcol-i, npcols) 00252 src = dbcsr_mp_get_process (mp_env, myprow, pcol) 00253 recv_cnt = rcount(src+1) 00254 recv_data_p => rb( 1+rdispl(src+1) : 1+rdispl(src+1)+recv_cnt-1 ) 00255 tag = 4*pcol 00256 IF (recv_cnt .GT. 0) THEN 00257 CALL mp_irecv (recv_data_p, pcol, grp, row_rr(nrow_rr), tag) 00258 nrow_rr = nrow_rr+1 00259 ENDIF 00260 ENDDO 00261 ! go through my pcol and exchange 00262 DO i = 0, nprows - 1 00263 prow = MOD (myprow+i, nprows) 00264 grp = dbcsr_mp_my_col_group (mp_env) 00265 ! 00266 dst = dbcsr_mp_get_process (mp_env, prow, mypcol) 00267 send_cnt = scount(dst+1) 00268 IF (send_cnt .GT. 0) THEN 00269 send_data_p => sb( 1+sdispl(dst+1) : 1+sdispl(dst+1)+send_cnt-1 ) 00270 tag = 4*myprow+1 00271 CALL mp_isend (send_data_p, prow, grp, col_sr(ncol_sr), tag) 00272 ncol_sr = ncol_sr + 1 00273 ENDIF 00274 ! 00275 prow = MODULO (myprow-i, nprows) 00276 src = dbcsr_mp_get_process (mp_env, prow, mypcol) 00277 recv_cnt = rcount(src+1) 00278 IF (recv_cnt .GT. 0) THEN 00279 recv_data_p => rb( 1+rdispl(src+1) : 1+rdispl(src+1)+recv_cnt-1 ) 00280 tag = 4*prow+1 00281 CALL mp_irecv (recv_data_p, prow, grp, col_rr(ncol_rr), tag) 00282 ncol_rr = ncol_rr + 1 00283 ENDIF 00284 ENDDO 00285 END SUBROUTINE most_point_to_point 00286 SUBROUTINE remainder_alltoall () 00287 new_scount(:) = scount(:) 00288 new_rcount(:) = rcount(:) 00289 FORALL (prow = 0:nprows-1) 00290 new_scount(1+pgrid(prow, mypcol)) = 0 00291 new_rcount(1+pgrid(prow, mypcol)) = 0 00292 END FORALL 00293 FORALL (pcol = 0:npcols-1) 00294 new_scount(1+pgrid(myprow, pcol)) = 0 00295 new_rcount(1+pgrid(myprow, pcol)) = 0 00296 END FORALL 00297 CALL mp_alltoall (sb, new_scount, sdispl,& 00298 rb, new_rcount, rdispl, all_group) 00299 END SUBROUTINE remainder_alltoall 00300 SUBROUTINE remainder_point_to_point() 00301 INTEGER :: col, row 00302 00303 DO row = 0, nprows-1 00304 prow = MOD(row+myprow, nprows) 00305 IF (prow .EQ. myprow) CYCLE 00306 DO col = 0, npcols-1 00307 pcol = MOD (col+mypcol, npcols) 00308 IF (pcol .EQ. mypcol) CYCLE 00309 dst = dbcsr_mp_get_process (mp_env, prow, pcol) 00310 send_cnt = scount(dst+1) 00311 IF (send_cnt .GT. 0) THEN 00312 tag = 4*mynode+2 00313 send_data_p => sb( 1+sdispl(dst+1) : 1+sdispl(dst+1)+send_cnt-1 ) 00314 CALL mp_isend (send_data_p, dst, all_group, all_sr(nall_sr+1), tag) 00315 nall_sr = nall_sr + 1 00316 ENDIF 00317 ! 00318 src = dbcsr_mp_get_process (mp_env, prow, pcol) 00319 recv_cnt = rcount(src+1) 00320 IF (recv_cnt .GT. 0) THEN 00321 recv_data_p => rb( 1+rdispl(src+1) : 1+rdispl(src+1)+recv_cnt-1 ) 00322 tag = 4*src+2 00323 CALL mp_irecv (recv_data_p, src, all_group, all_rr(nall_rr+1), tag) 00324 nall_rr = nall_rr+1 00325 ENDIF 00326 ENDDO 00327 ENDDO 00328 END SUBROUTINE remainder_point_to_point 00329 END SUBROUTINE hybrid_alltoall_i1 00330 00331 ! ***************************************************************************** 00336 FUNCTION dbcsr_mp_type_from_anytype(data_area) RESULT (mp_type) 00337 TYPE(dbcsr_data_obj), INTENT(IN) :: data_area 00338 TYPE(mp_type_descriptor_type) :: mp_type 00339 00340 SELECT CASE (data_area%d%data_type) 00341 CASE (dbcsr_type_real_4) 00342 mp_type = mp_type_make (data_area%d%r_sp) 00343 CASE (dbcsr_type_real_8) 00344 mp_type = mp_type_make (data_area%d%r_dp) 00345 CASE (dbcsr_type_complex_4) 00346 mp_type = mp_type_make (data_area%d%c_sp) 00347 CASE (dbcsr_type_complex_8) 00348 mp_type = mp_type_make (data_area%d%c_dp) 00349 END SELECT 00350 END FUNCTION dbcsr_mp_type_from_anytype 00351 00352 00353 ! ***************************************************************************** 00357 SUBROUTINE dbcsr_send_any(msgin,dest,tag,comm, error) 00358 TYPE(dbcsr_data_obj), INTENT(IN) :: msgin 00359 INTEGER, INTENT(IN) :: dest, tag, comm 00360 TYPE(dbcsr_error_type), INTENT(INOUT) :: error 00361 00362 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_send_any', 00363 routineP = moduleN//':'//routineN 00364 00365 SELECT CASE (dbcsr_data_get_type (msgin)) 00366 CASE (dbcsr_type_real_4) 00367 CALL mp_send (msgin%d%r_sp, dest, tag, comm) 00368 CASE (dbcsr_type_real_8) 00369 CALL mp_send (msgin%d%r_dp, dest, tag, comm) 00370 CASE (dbcsr_type_complex_4) 00371 CALL mp_send (msgin%d%c_sp, dest, tag, comm) 00372 CASE (dbcsr_type_complex_8) 00373 CALL mp_send (msgin%d%c_dp, dest, tag, comm) 00374 CASE default 00375 CALL dbcsr_assert (.FALSE., dbcsr_fatal_level, dbcsr_caller_error,& 00376 routineN, "Incorrect data type", __LINE__, error=error) 00377 END SELECT 00378 END SUBROUTINE dbcsr_send_any 00379 00380 ! ***************************************************************************** 00384 SUBROUTINE dbcsr_isend_any(msgin,dest,comm,request,tag, error) 00385 TYPE(dbcsr_data_obj), INTENT(IN) :: msgin 00386 INTEGER, INTENT(IN) :: dest, comm 00387 INTEGER, INTENT(OUT) :: request 00388 INTEGER, INTENT(IN), OPTIONAL :: tag 00389 TYPE(dbcsr_error_type), INTENT(INOUT) :: error 00390 00391 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_isend_any', 00392 routineP = moduleN//':'//routineN 00393 00394 SELECT CASE (dbcsr_data_get_type (msgin)) 00395 CASE (dbcsr_type_real_4) 00396 CALL mp_isend (msgin%d%r_sp, dest, comm, request, tag) 00397 CASE (dbcsr_type_real_8) 00398 CALL mp_isend (msgin%d%r_dp, dest, comm, request, tag) 00399 CASE (dbcsr_type_complex_4) 00400 CALL mp_isend (msgin%d%c_sp, dest, comm, request, tag) 00401 CASE (dbcsr_type_complex_8) 00402 CALL mp_isend (msgin%d%c_dp, dest, comm, request, tag) 00403 CASE default 00404 CALL dbcsr_assert (.FALSE., dbcsr_fatal_level, dbcsr_caller_error,& 00405 routineN, "Incorrect data type", __LINE__, error=error) 00406 END SELECT 00407 END SUBROUTINE dbcsr_isend_any 00408 00409 ! ***************************************************************************** 00413 SUBROUTINE dbcsr_recv_any(msgin,source,tag, comm, error) 00414 TYPE(dbcsr_data_obj), INTENT(INOUT) :: msgin 00415 INTEGER, INTENT(IN) :: source, tag, comm 00416 TYPE(dbcsr_error_type), INTENT(INOUT) :: error 00417 00418 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_recv_any', 00419 routineP = moduleN//':'//routineN 00420 00421 INTEGER :: io_comm, io_source, io_tag 00422 00423 io_source = source ; io_comm = comm; io_tag = tag 00424 00425 SELECT CASE (dbcsr_data_get_type (msgin)) 00426 CASE (dbcsr_type_real_4) 00427 CALL mp_recv (msgin%d%r_sp, io_source, io_tag, io_comm) 00428 CASE (dbcsr_type_real_8) 00429 CALL mp_recv (msgin%d%r_dp, io_source, io_tag, io_comm) 00430 CASE (dbcsr_type_complex_4) 00431 CALL mp_recv (msgin%d%c_sp, io_source, io_tag, io_comm) 00432 CASE (dbcsr_type_complex_8) 00433 CALL mp_recv (msgin%d%c_dp, io_source, io_tag, io_comm) 00434 CASE default 00435 CALL dbcsr_assert (.FALSE., dbcsr_fatal_level, dbcsr_caller_error,& 00436 routineN, "Incorrect data type", __LINE__, error=error) 00437 END SELECT 00438 END SUBROUTINE dbcsr_recv_any 00439 00440 ! ***************************************************************************** 00444 SUBROUTINE dbcsr_irecv_any(msgin,source,comm,request,tag, error) 00445 TYPE(dbcsr_data_obj), INTENT(IN) :: msgin 00446 INTEGER, INTENT(IN) :: source, comm 00447 INTEGER, INTENT(OUT) :: request 00448 INTEGER, INTENT(IN), OPTIONAL :: tag 00449 TYPE(dbcsr_error_type), INTENT(INOUT) :: error 00450 00451 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_irecv_any', 00452 routineP = moduleN//':'//routineN 00453 00454 SELECT CASE (dbcsr_data_get_type (msgin)) 00455 CASE (dbcsr_type_real_4) 00456 CALL mp_irecv (msgin%d%r_sp, source, comm, request, tag) 00457 CASE (dbcsr_type_real_8) 00458 CALL mp_irecv (msgin%d%r_dp, source, comm, request, tag) 00459 CASE (dbcsr_type_complex_4) 00460 CALL mp_irecv (msgin%d%c_sp, source, comm, request, tag) 00461 CASE (dbcsr_type_complex_8) 00462 CALL mp_irecv (msgin%d%c_dp, source, comm, request, tag) 00463 CASE default 00464 CALL dbcsr_assert (.FALSE., dbcsr_fatal_level, dbcsr_caller_error,& 00465 routineN, "Incorrect data type", __LINE__, error=error) 00466 END SELECT 00467 END SUBROUTINE dbcsr_irecv_any 00468 00469 00470 ! ***************************************************************************** 00474 SUBROUTINE dbcsr_allgatherv(send_data, recv_data, recv_count, recv_displ, gid) 00475 TYPE(dbcsr_data_obj), INTENT(IN) :: send_data 00476 TYPE(dbcsr_data_obj), INTENT(INOUT) :: recv_data 00477 INTEGER, DIMENSION(:), INTENT(IN) :: recv_count, recv_displ 00478 INTEGER, INTENT(IN) :: gid 00479 00480 CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_allgatherv', 00481 routineP = moduleN//':'//routineN 00482 00483 TYPE(dbcsr_error_type) :: error 00484 00485 CALL dbcsr_assert (dbcsr_data_get_type (send_data), "EQ",& 00486 dbcsr_data_get_type (recv_data), dbcsr_fatal_level,& 00487 dbcsr_wrong_args_error, routineN, "Data type mismatch", __LINE__,& 00488 error=error) 00489 SELECT CASE (dbcsr_data_get_type(send_data)) 00490 CASE (dbcsr_type_real_4) 00491 CALL mp_allgather(send_data%d%r_sp, recv_data%d%r_sp,& 00492 recv_count, recv_displ, gid) 00493 CASE (dbcsr_type_real_8) 00494 CALL mp_allgather(send_data%d%r_dp, recv_data%d%r_dp,& 00495 recv_count, recv_displ, gid) 00496 CASE (dbcsr_type_complex_4) 00497 CALL mp_allgather(send_data%d%c_sp, recv_data%d%c_sp,& 00498 recv_count, recv_displ, gid) 00499 CASE (dbcsr_type_complex_8) 00500 CALL mp_allgather(send_data%d%c_dp, recv_data%d%c_dp,& 00501 recv_count, recv_displ, gid) 00502 CASE default 00503 CALL dbcsr_assert (.FALSE., dbcsr_fatal_level, dbcsr_wrong_args_error,& 00504 routineN, "Invalid data type", __LINE__, error=error) 00505 END SELECT 00506 END SUBROUTINE dbcsr_allgatherv 00507 00508 00509 #include "dbcsr_mp_operations_d.F" 00510 #include "dbcsr_mp_operations_z.F" 00511 #include "dbcsr_mp_operations_s.F" 00512 #include "dbcsr_mp_operations_c.F" 00513 00514 END MODULE dbcsr_mp_operations
1.7.3