84 SUBROUTINE complete_gamma(mp2_env, B_ia_Q, dimen_RI, homo, virtual, para_env, para_env_sub, ngroup, &
85 my_group_L_size, my_group_L_start, my_group_L_end, &
86 my_B_size, my_B_virtual_start, gd_array, gd_B_virtual, kspin)
89 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :, :), &
90 INTENT(INOUT) :: b_ia_q
91 INTEGER,
INTENT(IN) :: dimen_ri, homo, virtual
93 INTEGER,
INTENT(IN) :: ngroup, my_group_l_size, &
94 my_group_l_start, my_group_l_end, &
95 my_b_size, my_b_virtual_start
97 INTEGER,
INTENT(IN) :: kspin
99 CHARACTER(LEN=*),
PARAMETER :: routinen =
'complete_gamma'
101 INTEGER :: dimen_ia, handle, i, ispin, kkb, my_ia_end, my_ia_size, my_ia_start, my_p_end, &
102 my_p_size, my_p_start, nspins, pos_group, pos_sub
103 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: pos_info
104 INTEGER,
ALLOCATABLE,
DIMENSION(:, :) :: group_grid_2_mepos, mepos_2_grid_group
105 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: bib_c_2d, gamma_2d, gamma_pq
108 TYPE(
cp_fm_type) :: fm_gamma, fm_gamma_pq, fm_gamma_pq_2, fm_gamma_pq_temp, &
109 fm_gamma_pq_temp_2, fm_ia_p, fm_y, operator_half, pq_half
113 CALL timeset(routinen, handle)
118 dimen_ia = homo*virtual
120 CALL get_group_dist(gd_ia, para_env_sub%mepos, my_ia_start, my_ia_end, my_ia_size)
122 CALL mat_3d_to_2d(b_ia_q, bib_c_2d, homo, my_b_size, virtual, my_b_virtual_start, &
123 my_ia_start, my_ia_end, my_ia_size, my_group_l_size, para_env_sub, gd_b_virtual)
125 CALL mat_3d_to_2d_gamma(mp2_env%ri_grad%Gamma_P_ia(kspin)%array, gamma_2d, homo, my_b_size, virtual, my_b_virtual_start, &
126 my_ia_start, my_ia_end, my_ia_size, my_group_l_size, para_env_sub, gd_b_virtual)
134 CALL get_group_dist(gd_p, para_env_sub%mepos, my_p_start, my_p_end, my_p_size)
137 group_grid_2_mepos, mepos_2_grid_group, pos_info=pos_info)
139 DO i = 0, para_env%num_pe - 1
141 pos_group = i/para_env_sub%num_pe
143 pos_sub = pos_info(i)
154 NULLIFY (fm_struct_ia)
156 ncol_global=dimen_ri, para_env=para_env)
159 CALL array2fm(gamma_2d, fm_struct_ia, my_ia_start, my_ia_end, &
160 my_group_l_start, my_group_l_end, &
161 gd_ia_new, gd_array_new, &
162 group_grid_2_mepos, para_env_sub%num_pe, ngroup, &
165 CALL array2fm(bib_c_2d, fm_struct_ia, my_ia_start, my_ia_end, &
166 my_group_l_start, my_group_l_end, &
167 gd_ia_new, gd_array_new, &
168 group_grid_2_mepos, para_env_sub%num_pe, ngroup, &
171 NULLIFY (fm_struct_ri)
173 ncol_global=dimen_ri, para_env=para_env)
176 CALL array2fm(mp2_env%ri_grad%PQ_half, fm_struct_ri, my_p_start, my_p_end, &
177 my_group_l_start, my_group_l_end, &
178 gd_p_new, gd_array_new, &
179 group_grid_2_mepos, para_env_sub%num_pe, ngroup, &
180 pq_half, do_release_mat=.false.)
183 CALL array2fm(mp2_env%ri_grad%operator_half, fm_struct_ri, my_p_start, my_p_end, &
184 my_group_l_start, my_group_l_end, &
185 gd_p_new, gd_array_new, &
186 group_grid_2_mepos, para_env_sub%num_pe, ngroup, &
187 operator_half, do_release_mat=.false.)
196 CALL cp_fm_create(fm_gamma, fm_struct_ia, name=
"fm_Gamma")
199 CALL parallel_gemm(transa=
"N", transb=
"T", m=dimen_ia, n=dimen_ri, k=dimen_ri, alpha=1.0_dp, &
200 matrix_a=fm_y, matrix_b=pq_half, beta=0.0_dp, &
207 CALL cp_fm_create(fm_gamma_pq_temp, fm_struct_ri, name=
"fm_Gamma_PQ_temp")
208 CALL parallel_gemm(transa=
"T", transb=
"N", m=dimen_ri, n=dimen_ri, k=dimen_ia, alpha=1.0_dp, &
209 matrix_a=fm_gamma, matrix_b=fm_ia_p, beta=0.0_dp, &
210 matrix_c=fm_gamma_pq_temp)
213 CALL cp_fm_create(fm_gamma_pq, fm_struct_ri, name=
"fm_Gamma_PQ")
216 CALL parallel_gemm(transa=
"N", transb=
"T", m=dimen_ri, n=dimen_ri, k=dimen_ri, alpha=1.0_dp, &
217 matrix_a=fm_gamma_pq_temp, matrix_b=pq_half, beta=0.0_dp, &
218 matrix_c=fm_gamma_pq)
224 CALL cp_fm_create(fm_gamma_pq_temp, fm_struct_ri, name=
"fm_Gamma_PQ_temp")
225 CALL parallel_gemm(transa=
"T", transb=
"N", m=dimen_ri, n=dimen_ri, k=dimen_ia, alpha=1.0_dp, &
226 matrix_a=fm_y, matrix_b=fm_ia_p, beta=0.0_dp, &
227 matrix_c=fm_gamma_pq_temp)
230 CALL cp_fm_create(fm_gamma, fm_struct_ia, name=
"fm_Gamma")
233 CALL parallel_gemm(transa=
"N", transb=
"T", m=dimen_ia, n=dimen_ri, k=dimen_ri, alpha=1.0_dp, &
234 matrix_a=fm_y, matrix_b=pq_half, beta=0.0_dp, &
238 CALL cp_fm_create(fm_gamma_pq_temp_2, fm_struct_ri, name=
"fm_Gamma_PQ_temp_2")
239 CALL parallel_gemm(transa=
"N", transb=
"T", m=dimen_ri, n=dimen_ri, k=dimen_ri, alpha=1.0_dp, &
240 matrix_a=fm_gamma_pq_temp, matrix_b=operator_half, beta=0.0_dp, &
241 matrix_c=fm_gamma_pq_temp_2)
243 CALL cp_fm_create(fm_gamma_pq_2, fm_struct_ri, name=
"fm_Gamma_PQ_2")
244 CALL parallel_gemm(transa=
"N", transb=
"N", m=dimen_ri, n=dimen_ri, k=dimen_ri, alpha=1.0_dp, &
245 matrix_a=pq_half, matrix_b=fm_gamma_pq_temp_2, beta=0.0_dp, &
246 matrix_c=fm_gamma_pq_temp)
248 CALL cp_fm_geadd(1.0_dp,
"T", fm_gamma_pq_temp, 1.0_dp, fm_gamma_pq_2)
254 CALL parallel_gemm(transa=
"N", transb=
"N", m=dimen_ri, n=dimen_ri, k=dimen_ri, alpha=-1.0_dp, &
255 matrix_a=operator_half, matrix_b=fm_gamma_pq_temp_2, beta=0.0_dp, &
256 matrix_c=fm_gamma_pq)
263 CALL fm2array(gamma_2d, my_ia_size, my_ia_start, my_ia_end, &
264 my_group_l_size, my_group_l_start, my_group_l_end, &
265 group_grid_2_mepos, mepos_2_grid_group, &
266 para_env_sub%num_pe, ngroup, &
269 ALLOCATE (gamma_pq(my_p_size, my_group_l_size))
270 CALL fm2array(gamma_pq, my_p_size, my_p_start, my_p_end, &
271 my_group_l_size, my_group_l_start, my_group_l_end, &
272 group_grid_2_mepos, mepos_2_grid_group, &
273 para_env_sub%num_pe, ngroup, &
275 IF (.NOT.
ALLOCATED(mp2_env%ri_grad%Gamma_PQ))
THEN
276 CALL move_alloc(gamma_pq, mp2_env%ri_grad%Gamma_PQ)
278 mp2_env%ri_grad%Gamma_PQ(:, :) = mp2_env%ri_grad%Gamma_PQ + gamma_pq
279 DEALLOCATE (gamma_pq)
283 ALLOCATE (gamma_pq(my_p_size, my_group_l_size))
284 CALL fm2array(gamma_pq, my_p_size, my_p_start, my_p_end, &
285 my_group_l_size, my_group_l_start, my_group_l_end, &
286 group_grid_2_mepos, mepos_2_grid_group, &
287 para_env_sub%num_pe, ngroup, &
289 IF (.NOT.
ALLOCATED(mp2_env%ri_grad%Gamma_PQ_2))
THEN
290 CALL move_alloc(gamma_pq, mp2_env%ri_grad%Gamma_PQ_2)
292 mp2_env%ri_grad%Gamma_PQ_2(:, :) = mp2_env%ri_grad%Gamma_PQ_2 + gamma_pq
293 DEALLOCATE (gamma_pq)
298 IF (.NOT.
ALLOCATED(mp2_env%ri_grad%G_P_ia))
THEN
299 nspins =
SIZE(mp2_env%ri_grad%mo_coeff_o)
300 ALLOCATE (mp2_env%ri_grad%G_P_ia(my_group_l_size, nspins))
302 DO kkb = 1, my_group_l_size
303 NULLIFY (mp2_env%ri_grad%G_P_ia(kkb, ispin)%matrix)
310 my_ia_start, my_ia_end, my_group_l_size, gd_ia, &
311 mp2_env%ri_grad%G_P_ia(:, kspin), mp2_env%ri_grad%mo_coeff_o(1)%matrix)
313 DEALLOCATE (pos_info)
314 DEALLOCATE (group_grid_2_mepos, mepos_2_grid_group)
321 CALL timestop(handle)
493 SUBROUTINE array2fm(mat2D, fm_struct, my_start_row, my_end_row, &
494 my_start_col, my_end_col, &
496 group_grid_2_mepos, ngroup_row, ngroup_col, &
497 fm_mat, integ_group_size, color_group, do_release_mat)
499 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :), &
500 INTENT(INOUT) :: mat2d
502 INTEGER,
INTENT(IN) :: my_start_row, my_end_row, my_start_col, &
505 INTEGER,
ALLOCATABLE,
DIMENSION(:, :),
INTENT(IN) :: group_grid_2_mepos
506 INTEGER,
INTENT(IN) :: ngroup_row, ngroup_col
508 INTEGER,
INTENT(IN),
OPTIONAL :: integ_group_size, color_group
509 LOGICAL,
INTENT(IN),
OPTIONAL :: do_release_mat
511 CHARACTER(LEN=*),
PARAMETER :: routinen =
'array2fm'
513 INTEGER :: dummy_proc, end_col_block, end_row_block, handle, handle2, i_global, i_local, &
514 i_sub, iib, iii, itmp(2), j_global, j_local, j_sub, jjb, my_num_col_blocks, &
515 my_num_row_blocks, mypcol, myprow, ncol_local, npcol, nprow, nrow_local, num_cols, &
516 num_rec_cols, num_rows, number_of_rec, number_of_send, proc_receive, proc_send, &
517 proc_shift, rec_col_end, rec_col_size, rec_col_start, rec_counter, rec_pcol, rec_prow, &
518 rec_row_end, rec_row_size, rec_row_start, ref_send_pcol, ref_send_prow, send_counter, &
519 send_pcol, send_prow, size_rec_buffer, size_send_buffer, start_col_block, start_row_block
520 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: iii_vet, index_col_rec, map_rec_size, &
522 INTEGER,
ALLOCATABLE,
DIMENSION(:, :) :: blocks_ranges_col, blocks_ranges_row, &
523 grid_2_mepos, grid_ref_2_send_pos, &
525 INTEGER,
DIMENSION(:),
POINTER :: col_indices, row_indices
526 LOGICAL :: convert_pos, my_do_release_mat
527 REAL(kind=
dp) :: part_col, part_row
529 DIMENSION(:) :: buffer_rec, buffer_send
533 CALL timeset(routinen, handle)
535 my_do_release_mat = .true.
536 IF (
PRESENT(do_release_mat)) my_do_release_mat = do_release_mat
538 CALL cp_fm_struct_get(fm_struct, para_env=para_env, nrow_global=num_rows, ncol_global=num_cols)
547 nrow_local=nrow_local, &
548 ncol_local=ncol_local, &
549 row_indices=row_indices, &
550 col_indices=col_indices)
551 myprow = fm_mat%matrix_struct%context%mepos(1)
552 mypcol = fm_mat%matrix_struct%context%mepos(2)
553 nprow = fm_mat%matrix_struct%context%num_pe(1)
554 npcol = fm_mat%matrix_struct%context%num_pe(2)
559 CALL timeset(routinen//
"_info", handle2)
560 ALLOCATE (grid_2_mepos(0:nprow - 1, 0:npcol - 1))
562 ALLOCATE (mepos_2_grid(2, 0:para_env%num_pe - 1))
563 grid_2_mepos(myprow, mypcol) = para_env%mepos
565 CALL para_env%sum(grid_2_mepos)
566 CALL para_env%allgather([myprow, mypcol], mepos_2_grid)
569 ALLOCATE (map_send_size(0:para_env%num_pe - 1))
572 DO jjb = my_start_col, my_end_col
573 send_pcol = fm_mat%matrix_struct%g2p_col(jjb)
574 DO iib = my_start_row, my_end_row
575 send_prow = fm_mat%matrix_struct%g2p_row(iib)
576 proc_send = grid_2_mepos(send_prow, send_pcol)
577 map_send_size(proc_send) = map_send_size(proc_send) + 1
582 ALLOCATE (map_rec_size(0:para_env%num_pe - 1))
584 part_row = real(num_rows, kind=
dp)/real(ngroup_row, kind=
dp)
585 part_col = real(num_cols, kind=
dp)/real(ngroup_col, kind=
dp)
588 convert_pos = .false.
589 IF (
PRESENT(integ_group_size) .AND.
PRESENT(color_group)) convert_pos = .true.
591 DO jjb = 1, nrow_local
592 j_global = row_indices(jjb)
595 rec_prow = int(real(j_global - 1, kind=
dp)/part_row)
596 rec_prow = max(0, rec_prow)
597 rec_prow = min(rec_prow, ngroup_row - 1)
599 itmp =
get_limit(num_rows, ngroup_row, rec_prow)
600 IF (j_global >= itmp(1) .AND. j_global <= itmp(2))
EXIT
601 IF (j_global < itmp(1)) rec_prow = rec_prow - 1
602 IF (j_global > itmp(2)) rec_prow = rec_prow + 1
605 IF (convert_pos)
THEN
607 IF ((rec_prow/integ_group_size) .NE. color_group) cycle
609 rec_prow = mod(rec_prow, integ_group_size)
612 DO iib = 1, ncol_local
613 i_global = col_indices(iib)
615 rec_pcol = int(real(i_global - 1, kind=
dp)/part_col)
616 rec_pcol = max(0, rec_pcol)
617 rec_pcol = min(rec_pcol, ngroup_col - 1)
619 itmp =
get_limit(num_cols, ngroup_col, rec_pcol)
620 IF (i_global >= itmp(1) .AND. i_global <= itmp(2))
EXIT
621 IF (i_global < itmp(1)) rec_pcol = rec_pcol - 1
622 IF (i_global > itmp(2)) rec_pcol = rec_pcol + 1
625 proc_receive = group_grid_2_mepos(rec_prow, rec_pcol)
627 map_rec_size(proc_receive) = map_rec_size(proc_receive) + 1
633 IF (map_rec_size(para_env%mepos) > 0)
THEN
634 DO jjb = 1, ncol_local
635 j_global = col_indices(jjb)
636 IF (j_global >= my_start_col .AND. j_global <= my_end_col)
THEN
637 DO iib = 1, nrow_local
638 i_global = row_indices(iib)
639 IF (i_global >= my_start_row .AND. i_global <= my_end_row)
THEN
640 fm_mat%local_data(iib, jjb) = mat2d(i_global - my_start_row + 1, j_global - my_start_col + 1)
646 CALL timestop(handle2)
649 CALL timeset(routinen//
"_buffer_send", handle2)
652 DO proc_shift = 1, para_env%num_pe - 1
653 proc_send =
modulo(para_env%mepos + proc_shift, para_env%num_pe)
654 IF (map_send_size(proc_send) > 0)
THEN
655 number_of_send = number_of_send + 1
659 ALLOCATE (buffer_send(number_of_send))
663 ALLOCATE (grid_ref_2_send_pos(0:nprow - 1, 0:npcol - 1))
664 grid_ref_2_send_pos = 0
668 DO proc_shift = 1, para_env%num_pe - 1
669 proc_send =
modulo(para_env%mepos + proc_shift, para_env%num_pe)
670 size_send_buffer = map_send_size(proc_send)
671 IF (map_send_size(proc_send) > 0)
THEN
672 send_counter = send_counter + 1
674 ALLOCATE (buffer_send(send_counter)%msg(size_send_buffer))
675 buffer_send(send_counter)%msg = 0.0_dp
676 buffer_send(send_counter)%proc = proc_send
679 ref_send_prow = mepos_2_grid(1, proc_send)
680 ref_send_pcol = mepos_2_grid(2, proc_send)
682 grid_ref_2_send_pos(ref_send_prow, ref_send_pcol) = send_counter
689 ALLOCATE (iii_vet(number_of_send))
691 DO iib = my_start_row, my_end_row
692 send_prow = fm_mat%matrix_struct%g2p_row(iib)
693 DO jjb = my_start_col, my_end_col
694 send_pcol = fm_mat%matrix_struct%g2p_col(jjb)
696 IF (grid_2_mepos(send_prow, send_pcol) == para_env%mepos) cycle
698 send_counter = grid_ref_2_send_pos(send_prow, send_pcol)
699 iii_vet(send_counter) = iii_vet(send_counter) + 1
700 iii = iii_vet(send_counter)
701 buffer_send(send_counter)%msg(iii) = mat2d(iib - my_start_row + 1, jjb - my_start_col + 1)
706 DEALLOCATE (grid_ref_2_send_pos)
707 IF (my_do_release_mat)
DEALLOCATE (mat2d)
708 CALL timestop(handle2)
713 CALL timeset(routinen//
"_isendrecv", handle2)
716 DO proc_shift = 1, para_env%num_pe - 1
717 proc_receive =
modulo(para_env%mepos - proc_shift, para_env%num_pe)
718 IF (map_rec_size(proc_receive) > 0)
THEN
719 number_of_rec = number_of_rec + 1
723 ALLOCATE (buffer_rec(number_of_rec))
726 DO proc_shift = 1, para_env%num_pe - 1
727 proc_receive =
modulo(para_env%mepos - proc_shift, para_env%num_pe)
728 size_rec_buffer = map_rec_size(proc_receive)
729 IF (map_rec_size(proc_receive) > 0)
THEN
730 rec_counter = rec_counter + 1
732 ALLOCATE (buffer_rec(rec_counter)%msg(size_rec_buffer))
733 buffer_rec(rec_counter)%msg = 0.0_dp
734 buffer_rec(rec_counter)%proc = proc_receive
736 CALL para_env%irecv(buffer_rec(rec_counter)%msg, proc_receive, &
737 buffer_rec(rec_counter)%msg_req)
742 ALLOCATE (req_send(number_of_send))
744 DO proc_shift = 1, para_env%num_pe - 1
745 proc_send =
modulo(para_env%mepos + proc_shift, para_env%num_pe)
746 IF (map_send_size(proc_send) > 0)
THEN
747 send_counter = send_counter + 1
748 CALL para_env%isend(buffer_send(send_counter)%msg, proc_send, &
749 buffer_send(send_counter)%msg_req)
750 req_send(send_counter) = buffer_send(send_counter)%msg_req
753 CALL timestop(handle2)
757 CALL timeset(routinen//
"_fill", handle2)
761 my_num_row_blocks = 1
762 DO iib = 1, nrow_local - 1
763 IF (abs(row_indices(iib + 1) - row_indices(iib)) == 1) cycle
764 my_num_row_blocks = my_num_row_blocks + 1
766 ALLOCATE (blocks_ranges_row(2, my_num_row_blocks))
767 blocks_ranges_row = 0
768 blocks_ranges_row(1, 1) = row_indices(1)
770 DO iib = 1, nrow_local - 1
771 IF (abs(row_indices(iib + 1) - row_indices(iib)) == 1) cycle
773 blocks_ranges_row(2, iii - 1) = row_indices(iib)
774 blocks_ranges_row(1, iii) = row_indices(iib + 1)
776 blocks_ranges_row(2, my_num_row_blocks) = row_indices(max(nrow_local, 1))
778 my_num_col_blocks = 1
779 DO jjb = 1, ncol_local - 1
780 IF (abs(col_indices(jjb + 1) - col_indices(jjb)) == 1) cycle
781 my_num_col_blocks = my_num_col_blocks + 1
783 ALLOCATE (blocks_ranges_col(2, my_num_col_blocks))
784 blocks_ranges_col = 0
785 blocks_ranges_col(1, 1) = col_indices(1)
787 DO jjb = 1, ncol_local - 1
788 IF (abs(col_indices(jjb + 1) - col_indices(jjb)) == 1) cycle
790 blocks_ranges_col(2, iii - 1) = col_indices(jjb)
791 blocks_ranges_col(1, iii) = col_indices(jjb + 1)
793 blocks_ranges_col(2, my_num_col_blocks) = col_indices(max(ncol_local, 1))
796 DO proc_shift = 1, para_env%num_pe - 1
797 proc_receive =
modulo(para_env%mepos - proc_shift, para_env%num_pe)
798 size_rec_buffer = map_rec_size(proc_receive)
800 IF (map_rec_size(proc_receive) > 0)
THEN
801 rec_counter = rec_counter + 1
803 CALL get_group_dist(gd_col, proc_receive, rec_col_start, rec_col_end, rec_col_size)
807 DO jjb = 1, my_num_col_blocks
808 start_col_block = max(blocks_ranges_col(1, jjb), rec_col_start)
809 end_col_block = min(blocks_ranges_col(2, jjb), rec_col_end)
810 DO j_sub = start_col_block, end_col_block
811 num_rec_cols = num_rec_cols + 1
814 ALLOCATE (index_col_rec(num_rec_cols))
817 DO jjb = 1, my_num_col_blocks
818 start_col_block = max(blocks_ranges_col(1, jjb), rec_col_start)
819 end_col_block = min(blocks_ranges_col(2, jjb), rec_col_end)
820 DO j_sub = start_col_block, end_col_block
822 j_local = fm_mat%matrix_struct%g2l_col(j_sub)
823 index_col_rec(iii) = j_local
827 CALL get_group_dist(gd_row, proc_receive, rec_row_start, rec_row_end, rec_row_size)
830 CALL buffer_rec(rec_counter)%msg_req%wait()
834 DO iib = 1, my_num_row_blocks
835 start_row_block = max(blocks_ranges_row(1, iib), rec_row_start)
836 end_row_block = min(blocks_ranges_row(2, iib), rec_row_end)
837 DO i_sub = start_row_block, end_row_block
838 i_local = fm_mat%matrix_struct%g2l_row(i_sub)
839 DO jjb = 1, num_rec_cols
841 j_local = index_col_rec(jjb)
842 fm_mat%local_data(i_local, j_local) = buffer_rec(rec_counter)%msg(iii)
847 DEALLOCATE (buffer_rec(rec_counter)%msg)
848 DEALLOCATE (index_col_rec)
851 DEALLOCATE (buffer_rec)
853 DEALLOCATE (blocks_ranges_row)
854 DEALLOCATE (blocks_ranges_col)
856 CALL timestop(handle2)
859 CALL timeset(routinen//
"_waitall", handle2)
861 DO send_counter = 1, number_of_send
862 DEALLOCATE (buffer_send(send_counter)%msg)
864 DEALLOCATE (buffer_send)
865 CALL timestop(handle2)
867 DEALLOCATE (map_send_size)
868 DEALLOCATE (map_rec_size)
869 DEALLOCATE (grid_2_mepos)
870 DEALLOCATE (mepos_2_grid)
872 CALL timestop(handle)
891 SUBROUTINE fm2array(mat2D, my_rows, my_start_row, my_end_row, &
892 my_cols, my_start_col, my_end_col, &
893 group_grid_2_mepos, mepos_2_grid_group, &
894 ngroup_row, ngroup_col, &
897 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :), &
899 INTEGER,
INTENT(IN) :: my_rows, my_start_row, my_end_row, &
900 my_cols, my_start_col, my_end_col
901 INTEGER,
ALLOCATABLE,
DIMENSION(:, :),
INTENT(IN) :: group_grid_2_mepos, mepos_2_grid_group
902 INTEGER,
INTENT(IN) :: ngroup_row, ngroup_col
905 CHARACTER(LEN=*),
PARAMETER :: routinen =
'fm2array'
907 INTEGER :: dummy_proc, handle, handle2, i_global, iib, iii, itmp(2), j_global, jjb, mypcol, &
908 myprow, ncol_local, npcol, nprow, nrow_local, num_cols, num_rec_rows, num_rows, &
909 number_of_rec, number_of_send, proc_receive, proc_send, proc_shift, rec_col_size, &
910 rec_counter, rec_pcol, rec_prow, rec_row_size, ref_send_pcol, ref_send_prow, &
911 send_counter, send_pcol, send_prow, size_rec_buffer, size_send_buffer
912 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: iii_vet, index_row_rec, map_rec_size, &
914 INTEGER,
ALLOCATABLE,
DIMENSION(:, :) :: grid_2_mepos, grid_ref_2_send_pos, &
916 INTEGER,
DIMENSION(:),
POINTER :: col_indices, row_indices
917 REAL(kind=
dp) :: part_col, part_row
919 DIMENSION(:) :: buffer_rec, buffer_send
923 CALL timeset(routinen, handle)
926 ALLOCATE (mat2d(my_rows, my_cols))
932 nrow_local=nrow_local, &
933 ncol_local=ncol_local, &
934 row_indices=row_indices, &
935 col_indices=col_indices, &
936 nrow_global=num_rows, &
937 ncol_global=num_cols, &
939 myprow = fm_mat%matrix_struct%context%mepos(1)
940 mypcol = fm_mat%matrix_struct%context%mepos(2)
941 nprow = fm_mat%matrix_struct%context%num_pe(1)
942 npcol = fm_mat%matrix_struct%context%num_pe(2)
947 CALL timeset(routinen//
"_info", handle2)
948 ALLOCATE (grid_2_mepos(0:nprow - 1, 0:npcol - 1))
950 ALLOCATE (mepos_2_grid(2, 0:para_env%num_pe - 1))
953 grid_2_mepos(myprow, mypcol) = para_env%mepos
956 CALL para_env%sum(grid_2_mepos)
957 CALL para_env%allgather([myprow, mypcol], mepos_2_grid)
960 ALLOCATE (map_send_size(0:para_env%num_pe - 1))
962 part_row = real(num_rows, kind=
dp)/real(ngroup_row, kind=
dp)
963 part_col = real(num_cols, kind=
dp)/real(ngroup_col, kind=
dp)
965 DO jjb = 1, ncol_local
966 j_global = col_indices(jjb)
969 send_pcol = int(real(j_global - 1, kind=
dp)/part_col)
970 send_pcol = max(0, send_pcol)
971 send_pcol = min(send_pcol, ngroup_col - 1)
973 itmp =
get_limit(num_cols, ngroup_col, send_pcol)
974 IF (j_global >= itmp(1) .AND. j_global <= itmp(2))
EXIT
975 IF (j_global < itmp(1)) send_pcol = send_pcol - 1
976 IF (j_global > itmp(2)) send_pcol = send_pcol + 1
979 DO iib = 1, nrow_local
980 i_global = row_indices(iib)
982 send_prow = int(real(i_global - 1, kind=
dp)/part_row)
983 send_prow = max(0, send_prow)
984 send_prow = min(send_prow, ngroup_row - 1)
986 itmp =
get_limit(num_rows, ngroup_row, send_prow)
987 IF (i_global >= itmp(1) .AND. i_global <= itmp(2))
EXIT
988 IF (i_global < itmp(1)) send_prow = send_prow - 1
989 IF (i_global > itmp(2)) send_prow = send_prow + 1
992 proc_send = group_grid_2_mepos(send_prow, send_pcol)
994 map_send_size(proc_send) = map_send_size(proc_send) + 1
1000 ALLOCATE (map_rec_size(0:para_env%num_pe - 1))
1003 DO jjb = my_start_col, my_end_col
1004 rec_pcol = fm_mat%matrix_struct%g2p_col(jjb)
1005 DO iib = my_start_row, my_end_row
1006 rec_prow = fm_mat%matrix_struct%g2p_row(iib)
1007 proc_receive = grid_2_mepos(rec_prow, rec_pcol)
1008 map_rec_size(proc_receive) = map_rec_size(proc_receive) + 1
1013 IF (map_rec_size(para_env%mepos) > 0)
THEN
1014 DO jjb = 1, ncol_local
1015 j_global = col_indices(jjb)
1016 IF (j_global >= my_start_col .AND. j_global <= my_end_col)
THEN
1017 DO iib = 1, nrow_local
1018 i_global = row_indices(iib)
1019 IF (i_global >= my_start_row .AND. i_global <= my_end_row)
THEN
1020 mat2d(i_global - my_start_row + 1, j_global - my_start_col + 1) = fm_mat%local_data(iib, jjb)
1026 CALL timestop(handle2)
1029 CALL timeset(routinen//
"_buffer_send", handle2)
1032 DO proc_shift = 1, para_env%num_pe - 1
1033 proc_send =
modulo(para_env%mepos + proc_shift, para_env%num_pe)
1034 IF (map_send_size(proc_send) > 0)
THEN
1035 number_of_send = number_of_send + 1
1039 ALLOCATE (buffer_send(number_of_send))
1044 ALLOCATE (grid_ref_2_send_pos(0:ngroup_row - 1, 0:ngroup_col - 1))
1045 grid_ref_2_send_pos = 0
1050 DO proc_shift = 1, para_env%num_pe - 1
1051 proc_send =
modulo(para_env%mepos + proc_shift, para_env%num_pe)
1052 size_send_buffer = map_send_size(proc_send)
1053 IF (map_send_size(proc_send) > 0)
THEN
1054 send_counter = send_counter + 1
1056 ALLOCATE (buffer_send(send_counter)%msg(size_send_buffer))
1057 buffer_send(send_counter)%msg = 0.0_dp
1058 buffer_send(send_counter)%proc = proc_send
1061 ref_send_prow = mepos_2_grid_group(1, proc_send)
1062 ref_send_pcol = mepos_2_grid_group(2, proc_send)
1064 grid_ref_2_send_pos(ref_send_prow, ref_send_pcol) = send_counter
1071 ALLOCATE (iii_vet(number_of_send))
1073 DO jjb = 1, ncol_local
1074 j_global = col_indices(jjb)
1077 send_pcol = int(real(j_global - 1, kind=
dp)/part_col)
1078 send_pcol = max(0, send_pcol)
1079 send_pcol = min(send_pcol, ngroup_col - 1)
1081 itmp =
get_limit(num_cols, ngroup_col, send_pcol)
1082 IF (j_global >= itmp(1) .AND. j_global <= itmp(2))
EXIT
1083 IF (j_global < itmp(1)) send_pcol = send_pcol - 1
1084 IF (j_global > itmp(2)) send_pcol = send_pcol + 1
1087 DO iib = 1, nrow_local
1088 i_global = row_indices(iib)
1090 send_prow = int(real(i_global - 1, kind=
dp)/part_row)
1091 send_prow = max(0, send_prow)
1092 send_prow = min(send_prow, ngroup_row - 1)
1094 itmp =
get_limit(num_rows, ngroup_row, send_prow)
1095 IF (i_global >= itmp(1) .AND. i_global <= itmp(2))
EXIT
1096 IF (i_global < itmp(1)) send_prow = send_prow - 1
1097 IF (i_global > itmp(2)) send_prow = send_prow + 1
1100 IF (group_grid_2_mepos(send_prow, send_pcol) == para_env%mepos) cycle
1102 send_counter = grid_ref_2_send_pos(send_prow, send_pcol)
1103 iii_vet(send_counter) = iii_vet(send_counter) + 1
1104 iii = iii_vet(send_counter)
1105 buffer_send(send_counter)%msg(iii) = fm_mat%local_data(iib, jjb)
1109 DEALLOCATE (iii_vet)
1110 DEALLOCATE (grid_ref_2_send_pos)
1111 CALL timestop(handle2)
1116 CALL timeset(routinen//
"_isendrecv", handle2)
1119 DO proc_shift = 1, para_env%num_pe - 1
1120 proc_receive =
modulo(para_env%mepos - proc_shift, para_env%num_pe)
1121 IF (map_rec_size(proc_receive) > 0)
THEN
1122 number_of_rec = number_of_rec + 1
1126 ALLOCATE (buffer_rec(number_of_rec))
1129 DO proc_shift = 1, para_env%num_pe - 1
1130 proc_receive =
modulo(para_env%mepos - proc_shift, para_env%num_pe)
1131 size_rec_buffer = map_rec_size(proc_receive)
1132 IF (map_rec_size(proc_receive) > 0)
THEN
1133 rec_counter = rec_counter + 1
1135 ALLOCATE (buffer_rec(rec_counter)%msg(size_rec_buffer))
1136 buffer_rec(rec_counter)%msg = 0.0_dp
1137 buffer_rec(rec_counter)%proc = proc_receive
1139 CALL para_env%irecv(buffer_rec(rec_counter)%msg, proc_receive, &
1140 buffer_rec(rec_counter)%msg_req)
1145 ALLOCATE (req_send(number_of_send))
1147 DO proc_shift = 1, para_env%num_pe - 1
1148 proc_send =
modulo(para_env%mepos + proc_shift, para_env%num_pe)
1149 IF (map_send_size(proc_send) > 0)
THEN
1150 send_counter = send_counter + 1
1151 CALL para_env%isend(buffer_send(send_counter)%msg, proc_send, &
1152 buffer_send(send_counter)%msg_req)
1153 req_send(send_counter) = buffer_send(send_counter)%msg_req
1156 CALL timestop(handle2)
1160 CALL timeset(routinen//
"_fill", handle2)
1162 nrow_local=nrow_local, &
1163 ncol_local=ncol_local)
1164 ALLOCATE (sizes(2, 0:para_env%num_pe - 1))
1165 CALL para_env%allgather([nrow_local, ncol_local], sizes)
1166 iib = maxval(sizes(1, :))
1167 ALLOCATE (index_row_rec(iib))
1170 DO proc_shift = 1, para_env%num_pe - 1
1171 proc_receive =
modulo(para_env%mepos - proc_shift, para_env%num_pe)
1172 size_rec_buffer = map_rec_size(proc_receive)
1174 IF (map_rec_size(proc_receive) > 0)
THEN
1175 rec_counter = rec_counter + 1
1177 rec_col_size = sizes(2, proc_receive)
1178 rec_row_size = sizes(1, proc_receive)
1182 DO iib = 1, rec_row_size
1183 i_global = fm_mat%matrix_struct%l2g_row(iib, mepos_2_grid(1, proc_receive))
1184 IF (i_global >= my_start_row .AND. i_global <= my_end_row)
THEN
1185 num_rec_rows = num_rec_rows + 1
1186 index_row_rec(num_rec_rows) = i_global
1190 CALL buffer_rec(rec_counter)%msg_req%wait()
1193 DO jjb = 1, rec_col_size
1194 j_global = fm_mat%matrix_struct%l2g_col(jjb, mepos_2_grid(2, proc_receive))
1195 IF (j_global >= my_start_col .AND. j_global <= my_end_col)
THEN
1196 DO iib = 1, num_rec_rows
1197 i_global = index_row_rec(iib)
1199 mat2d(i_global - my_start_row + 1, j_global - my_start_col + 1) = buffer_rec(rec_counter)%msg(iii)
1204 DEALLOCATE (buffer_rec(rec_counter)%msg)
1207 DEALLOCATE (buffer_rec)
1208 DEALLOCATE (index_row_rec)
1210 CALL timestop(handle2)
1213 CALL timeset(routinen//
"_waitall", handle2)
1215 DO send_counter = 1, number_of_send
1216 DEALLOCATE (buffer_send(send_counter)%msg)
1218 DEALLOCATE (buffer_send)
1219 CALL timestop(handle2)
1221 CALL timestop(handle)
1240 my_ia_start, my_ia_end, my_group_L_size, &
1241 gd_ia, dbcsr_Gamma, mo_coeff_o)
1242 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: gamma_2d
1243 INTEGER,
INTENT(IN) :: homo, virtual, dimen_ia
1245 INTEGER,
INTENT(IN) :: my_ia_start, my_ia_end, my_group_l_size
1247 TYPE(
dbcsr_p_type),
DIMENSION(:),
INTENT(INOUT) :: dbcsr_gamma
1248 TYPE(
dbcsr_type),
INTENT(INOUT) :: mo_coeff_o
1250 CHARACTER(LEN=*),
PARAMETER :: routinen =
'create_dbcsr_gamma'
1252 INTEGER :: dummy_proc, handle, i_global, i_local, iaia, iib, iii, itmp(2), j_global, &
1253 j_local, jjb, jjj, kkb, mypcol, myprow, ncol_local, npcol, nprow, nrow_local, &
1254 number_of_rec, number_of_send, proc_receive, proc_send, proc_shift, rec_counter, &
1255 rec_iaia_end, rec_iaia_size, rec_iaia_start, rec_pcol, rec_prow, ref_send_pcol, &
1256 ref_send_prow, send_counter, send_pcol, send_prow, size_rec_buffer, size_send_buffer
1257 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: iii_vet, map_rec_size, map_send_size
1258 INTEGER,
ALLOCATABLE,
DIMENSION(:, :) :: grid_2_mepos, grid_ref_2_send_pos, &
1259 indeces_map_my, mepos_2_grid
1260 INTEGER,
DIMENSION(:),
POINTER :: col_indices, row_indices
1261 REAL(kind=
dp) :: part_ia
1265 TYPE(index_map),
ALLOCATABLE,
DIMENSION(:) :: indeces_rec
1267 DIMENSION(:) :: buffer_rec, buffer_send
1270 CALL timeset(routinen, handle)
1279 ncol_global=virtual, para_env=para_env_sub)
1288 nrow_local=nrow_local, &
1289 ncol_local=ncol_local, &
1290 row_indices=row_indices, &
1291 col_indices=col_indices)
1292 myprow = fm_ia%matrix_struct%context%mepos(1)
1293 mypcol = fm_ia%matrix_struct%context%mepos(2)
1294 nprow = fm_ia%matrix_struct%context%num_pe(1)
1295 npcol = fm_ia%matrix_struct%context%num_pe(2)
1298 ALLOCATE (grid_2_mepos(0:nprow - 1, 0:npcol - 1))
1300 ALLOCATE (mepos_2_grid(2, 0:para_env_sub%num_pe - 1))
1302 grid_2_mepos(myprow, mypcol) = para_env_sub%mepos
1304 CALL para_env_sub%sum(grid_2_mepos)
1305 CALL para_env_sub%allgather([myprow, mypcol], mepos_2_grid)
1308 ALLOCATE (map_send_size(0:para_env_sub%num_pe - 1))
1311 DO iaia = my_ia_start, my_ia_end
1312 i_global = (iaia - 1)/virtual + 1
1313 j_global = mod(iaia - 1, virtual) + 1
1314 send_prow = fm_ia%matrix_struct%g2p_row(i_global)
1315 send_pcol = fm_ia%matrix_struct%g2p_col(j_global)
1316 proc_send = grid_2_mepos(send_prow, send_pcol)
1317 map_send_size(proc_send) = map_send_size(proc_send) + 1
1321 ALLOCATE (map_rec_size(0:para_env_sub%num_pe - 1))
1323 part_ia = real(dimen_ia, kind=
dp)/real(para_env_sub%num_pe, kind=
dp)
1325 DO iib = 1, nrow_local
1326 i_global = row_indices(iib)
1327 DO jjb = 1, ncol_local
1328 j_global = col_indices(jjb)
1329 iaia = (i_global - 1)*virtual + j_global
1330 proc_receive = int(real(iaia - 1, kind=
dp)/part_ia)
1331 proc_receive = max(0, proc_receive)
1332 proc_receive = min(proc_receive, para_env_sub%num_pe - 1)
1334 itmp =
get_limit(dimen_ia, para_env_sub%num_pe, proc_receive)
1335 IF (iaia >= itmp(1) .AND. iaia <= itmp(2))
EXIT
1336 IF (iaia < itmp(1)) proc_receive = proc_receive - 1
1337 IF (iaia > itmp(2)) proc_receive = proc_receive + 1
1339 map_rec_size(proc_receive) = map_rec_size(proc_receive) + 1
1345 DO proc_shift = 1, para_env_sub%num_pe - 1
1346 proc_send =
modulo(para_env_sub%mepos + proc_shift, para_env_sub%num_pe)
1347 IF (map_send_size(proc_send) > 0)
THEN
1348 number_of_send = number_of_send + 1
1352 ALLOCATE (buffer_send(number_of_send))
1354 ALLOCATE (grid_ref_2_send_pos(0:nprow - 1, 0:npcol - 1))
1355 grid_ref_2_send_pos = 0
1358 DO proc_shift = 1, para_env_sub%num_pe - 1
1359 proc_send =
modulo(para_env_sub%mepos + proc_shift, para_env_sub%num_pe)
1360 size_send_buffer = map_send_size(proc_send)
1361 IF (map_send_size(proc_send) > 0)
THEN
1362 send_counter = send_counter + 1
1364 ALLOCATE (buffer_send(send_counter)%msg(size_send_buffer))
1365 buffer_send(send_counter)%proc = proc_send
1368 ref_send_prow = mepos_2_grid(1, proc_send)
1369 ref_send_pcol = mepos_2_grid(2, proc_send)
1371 grid_ref_2_send_pos(ref_send_prow, ref_send_pcol) = send_counter
1377 DO proc_shift = 1, para_env_sub%num_pe - 1
1378 proc_receive =
modulo(para_env_sub%mepos - proc_shift, para_env_sub%num_pe)
1379 IF (map_rec_size(proc_receive) > 0)
THEN
1380 number_of_rec = number_of_rec + 1
1385 ALLOCATE (buffer_rec(number_of_rec))
1386 ALLOCATE (indeces_rec(number_of_rec))
1389 DO proc_shift = 1, para_env_sub%num_pe - 1
1390 proc_receive =
modulo(para_env_sub%mepos - proc_shift, para_env_sub%num_pe)
1391 size_rec_buffer = map_rec_size(proc_receive)
1392 IF (map_rec_size(proc_receive) > 0)
THEN
1393 rec_counter = rec_counter + 1
1395 ALLOCATE (buffer_rec(rec_counter)%msg(size_rec_buffer))
1396 buffer_rec(rec_counter)%proc = proc_receive
1398 ALLOCATE (indeces_rec(rec_counter)%map(2, size_rec_buffer))
1399 indeces_rec(rec_counter)%map = 0
1400 CALL get_group_dist(gd_ia, proc_receive, rec_iaia_start, rec_iaia_end, rec_iaia_size)
1402 DO iaia = rec_iaia_start, rec_iaia_end
1403 i_global = (iaia - 1)/virtual + 1
1404 j_global = mod(iaia - 1, virtual) + 1
1405 rec_prow = fm_ia%matrix_struct%g2p_row(i_global)
1406 rec_pcol = fm_ia%matrix_struct%g2p_col(j_global)
1407 IF (grid_2_mepos(rec_prow, rec_pcol) /= para_env_sub%mepos) cycle
1409 i_local = fm_ia%matrix_struct%g2l_row(i_global)
1410 j_local = fm_ia%matrix_struct%g2l_col(j_global)
1411 indeces_rec(rec_counter)%map(1, iii) = i_local
1412 indeces_rec(rec_counter)%map(2, iii) = j_local
1417 IF (map_rec_size(para_env_sub%mepos) > 0)
THEN
1418 size_rec_buffer = map_rec_size(para_env_sub%mepos)
1419 ALLOCATE (indeces_map_my(2, size_rec_buffer))
1422 DO iaia = my_ia_start, my_ia_end
1423 i_global = (iaia - 1)/virtual + 1
1424 j_global = mod(iaia - 1, virtual) + 1
1425 rec_prow = fm_ia%matrix_struct%g2p_row(i_global)
1426 rec_pcol = fm_ia%matrix_struct%g2p_col(j_global)
1427 IF (grid_2_mepos(rec_prow, rec_pcol) /= para_env_sub%mepos) cycle
1429 i_local = fm_ia%matrix_struct%g2l_row(i_global)
1430 j_local = fm_ia%matrix_struct%g2l_col(j_global)
1431 indeces_map_my(1, iii) = i_local
1432 indeces_map_my(2, iii) = j_local
1437 ALLOCATE (iii_vet(number_of_send))
1439 ALLOCATE (req_send(number_of_send))
1442 DO kkb = 1, my_group_l_size
1446 DO proc_shift = 1, para_env_sub%num_pe - 1
1447 proc_receive =
modulo(para_env_sub%mepos - proc_shift, para_env_sub%num_pe)
1448 IF (map_rec_size(proc_receive) > 0)
THEN
1449 rec_counter = rec_counter + 1
1450 buffer_rec(rec_counter)%msg = 0.0_dp
1451 CALL para_env_sub%irecv(buffer_rec(rec_counter)%msg, proc_receive, &
1452 buffer_rec(rec_counter)%msg_req)
1456 DO send_counter = 1, number_of_send
1457 buffer_send(send_counter)%msg = 0.0_dp
1461 DO iaia = my_ia_start, my_ia_end
1462 i_global = (iaia - 1)/virtual + 1
1463 j_global = mod(iaia - 1, virtual) + 1
1464 send_prow = fm_ia%matrix_struct%g2p_row(i_global)
1465 send_pcol = fm_ia%matrix_struct%g2p_col(j_global)
1466 proc_send = grid_2_mepos(send_prow, send_pcol)
1468 IF (grid_2_mepos(send_prow, send_pcol) == para_env_sub%mepos)
THEN
1471 i_local = indeces_map_my(1, jjj)
1472 j_local = indeces_map_my(2, jjj)
1473 fm_ia%local_data(i_local, j_local) = gamma_2d(iaia - my_ia_start + 1, kkb)
1475 send_counter = grid_ref_2_send_pos(send_prow, send_pcol)
1476 iii_vet(send_counter) = iii_vet(send_counter) + 1
1477 iii = iii_vet(send_counter)
1478 buffer_send(send_counter)%msg(iii) = gamma_2d(iaia - my_ia_start + 1, kkb)
1483 DO proc_shift = 1, para_env_sub%num_pe - 1
1484 proc_send =
modulo(para_env_sub%mepos + proc_shift, para_env_sub%num_pe)
1485 IF (map_send_size(proc_send) > 0)
THEN
1486 send_counter = send_counter + 1
1487 CALL para_env_sub%isend(buffer_send(send_counter)%msg, proc_send, &
1488 buffer_send(send_counter)%msg_req)
1489 req_send(send_counter) = buffer_send(send_counter)%msg_req
1495 DO proc_shift = 1, para_env_sub%num_pe - 1
1496 proc_receive =
modulo(para_env_sub%mepos - proc_shift, para_env_sub%num_pe)
1497 size_rec_buffer = map_rec_size(proc_receive)
1498 IF (map_rec_size(proc_receive) > 0)
THEN
1499 rec_counter = rec_counter + 1
1501 CALL buffer_rec(rec_counter)%msg_req%wait()
1502 DO iii = 1, size_rec_buffer
1503 i_local = indeces_rec(rec_counter)%map(1, iii)
1504 j_local = indeces_rec(rec_counter)%map(2, iii)
1505 fm_ia%local_data(i_local, j_local) = buffer_rec(rec_counter)%msg(iii)
1514 ALLOCATE (dbcsr_gamma(kkb)%matrix)
1516 template=mo_coeff_o, &
1517 m=homo, n=virtual, sym=dbcsr_type_no_symmetry)
1518 CALL copy_fm_to_dbcsr(fm_ia, dbcsr_gamma(kkb)%matrix, keep_sparsity=.false.)
1523 DEALLOCATE (gamma_2d)
1524 DEALLOCATE (iii_vet)
1525 DEALLOCATE (req_send)
1526 IF (map_rec_size(para_env_sub%mepos) > 0)
THEN
1527 DEALLOCATE (indeces_map_my)
1529 DO rec_counter = 1, number_of_rec
1530 DEALLOCATE (indeces_rec(rec_counter)%map)
1531 DEALLOCATE (buffer_rec(rec_counter)%msg)
1533 DEALLOCATE (indeces_rec)
1534 DEALLOCATE (buffer_rec)
1535 DO send_counter = 1, number_of_send
1536 DEALLOCATE (buffer_send(send_counter)%msg)
1538 DEALLOCATE (buffer_send)
1539 DEALLOCATE (map_send_size)
1540 DEALLOCATE (map_rec_size)
1541 DEALLOCATE (grid_2_mepos)
1542 DEALLOCATE (mepos_2_grid)
1547 CALL timestop(handle)