SCALE-RM
Data Types | Functions/Subroutines | Variables
scale_comm Module Reference

module COMMUNICATION More...

Functions/Subroutines

subroutine, public comm_setup
 Setup. More...
 
subroutine, public comm_vars_init (varname, var, vid)
 Register variables. More...
 
subroutine, public comm_vars8_init (varname, var, vid)
 Register variables. More...
 
subroutine, public comm_horizontal_mean (varmean, var)
 calculate horizontal mean (global total with communication) More...
 
subroutine comm_horizontal_max_2d (varmax, var)
 Get maximum value in horizontal area. More...
 
subroutine comm_horizontal_min_2d (varmin, var)
 Get minimum value in horizontal area. More...
 
subroutine comm_gather_2d (recv, send, gIA, gJA)
 Get data from whole process value in 2D field. More...
 
subroutine comm_gather_3d (recv, send, gIA, gJA, gKA)
 Get data from whole process value in 3D field. More...
 
subroutine comm_bcast_scr (var)
 Broadcast data for whole process value in scalar field. More...
 
subroutine comm_bcast_1d (var, gIA)
 Broadcast data for whole process value in 1D field. More...
 
subroutine comm_bcast_2d (var, gIA, gJA)
 Broadcast data for whole process value in 2D field. More...
 
subroutine comm_bcast_3d (var, gIA, gJA, gKA)
 Broadcast data for whole process value in 3D field. More...
 
subroutine comm_bcast_4d (var, gIA, gJA, gKA, gTime)
 Broadcast data for whole process value in 4D field. More...
 
subroutine comm_bcast_int_scr (var)
 Broadcast data for whole process value in scalar (integer) More...
 
subroutine comm_bcast_int_1d (var, gIA)
 Broadcast data for whole process value in 1D field (integer) More...
 
subroutine comm_bcast_int_2d (var, gIA, gJA)
 Broadcast data for whole process value in 2D field (integer) More...
 
subroutine comm_bcast_logical_scr (var)
 Broadcast data for whole process value in scalar (logical) More...
 
subroutine vars_init_mpi_pc (var, vid, seqid)
 
subroutine vars8_3d_mpi (var, vid)
 
subroutine vars_2d_mpi (var, vid)
 
subroutine vars8_2d_mpi (var, vid)
 
subroutine vars_3d_mpi_pc (var, vid)
 
subroutine wait_3d_mpi (var, vid)
 
subroutine, public comm_cleanup
 

Variables

integer, public comm_datatype
 datatype of variable More...
 
integer, public comm_world
 communication world ID More...
 
logical, public comm_fill_bnd = .true.
 switch whether fill boundary data More...
 

Detailed Description

module COMMUNICATION

Description
MPI Communication module
Author
Team SCALE
History
  • 2011-10-11 (R.Yoshida) [new]
  • 2011-11-11 (H.Yashiro) [mod] Integrate to SCALE-LES ver.3
  • 2012-01-10 (Y.Ohno) [mod] Nonblocking communication (MPI)
  • 2012-01-23 (Y.Ohno) [mod] Self unpacking (MPI)
  • 2012-03-12 (H.Yashiro) [mod] REAL4(MPI)
  • 2012-03-12 (Y.Ohno) [mod] RDMA communication
  • 2012-03-23 (H.Yashiro) [mod] Explicit index parameter inclusion
  • 2012-03-27 (H.Yashiro) [mod] Area/volume weighted total value report
  • 2014-06-13 (R.Yoshida) [mod] gather data from whole processes
  • 2014-11-26 (S.Nishizawa) [mod] MPI persistent communication (MPI PC)
NAMELIST
  • PARAM_COMM
    nametypedefault valuecomment
    COMM_VSIZE_MAX_PC integer # limit of total communication variables for MPI PC
    COMM_USE_MPI_PC logical .true.

History Output
No history output

Function/Subroutine Documentation

◆ comm_setup()

subroutine, public scale_comm::comm_setup ( )

Setup.

Definition at line 165 of file scale_comm.F90.

References comm_datatype, comm_world, scale_grid_index::ia, scale_grid_index::ihalo, scale_grid_index::imax, scale_stdio::io_fid_conf, scale_grid_index::ja, scale_grid_index::jhalo, scale_grid_index::jmax, scale_grid_index::ka, scale_rm_process::prc_has_e, scale_rm_process::prc_has_n, scale_rm_process::prc_has_s, scale_rm_process::prc_has_w, scale_process::prc_local_comm_world, scale_tracer::qa, and scale_precision::rp.

Referenced by mod_rm_driver::scalerm(), and mod_rm_prep::scalerm_prep().

165  use scale_stdio, only: &
167  use scale_process, only: &
169  implicit none
170 
171  namelist / param_comm / &
172  comm_vsize_max, &
173  comm_vsize_max_pc, &
174  comm_use_mpi_pc
175 
176  integer :: nreq_NS, nreq_WE, nreq_4C
177 
178  integer :: ierr
179  !---------------------------------------------------------------------------
180 
181  if( io_l ) write(io_fid_log,*)
182  if( io_l ) write(io_fid_log,*) '++++++ Module[COMM] / Categ[ATMOS-RM COMM] / Origin[SCALElib]'
183 
184  comm_vsize_max = max( 10 + qa*2, 25 )
185  comm_vsize_max_pc = 50 + qa*2
186 
187  !--- read namelist
188  rewind(io_fid_conf)
189  read(io_fid_conf,nml=param_comm,iostat=ierr)
190  if( ierr < 0 ) then !--- missing
191  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
192  elseif( ierr > 0 ) then !--- fatal error
193  write(*,*) 'xxx Not appropriate names in namelist PARAM_COMM. Check!'
194  call prc_mpistop
195  endif
196  if( io_nml ) write(io_fid_nml,nml=param_comm)
197 
198  nreq_ns = 2 * jhalo !--- send x JHALO, recv x JHALO
199  nreq_we = 2 !--- send x 1 , recv x 1
200  nreq_4c = 2 * jhalo !--- send x JHALO, recv x JHALO
201 
202  if ( comm_use_mpi_pc ) then
203  comm_nreq_max = 2 * nreq_ns + 2 * nreq_we + 4 * nreq_4c + 1
204  else
205  comm_nreq_max = 2 * nreq_ns + 2 * nreq_we + 4 * nreq_4c
206  end if
207 
208  comm_size2d_ns4 = ia * jhalo
209  comm_size2d_ns8 = imax
210  comm_size2d_we = jmax * ihalo
211  comm_size2d_4c = ihalo
212 
213  allocate( recvpack_w2p(comm_size2d_we*ka,comm_vsize_max) )
214  allocate( recvpack_e2p(comm_size2d_we*ka,comm_vsize_max) )
215  allocate( sendpack_p2w(comm_size2d_we*ka,comm_vsize_max) )
216  allocate( sendpack_p2e(comm_size2d_we*ka,comm_vsize_max) )
217 #ifdef DEBUG
218  allocate( use_packbuf(comm_vsize_max) )
219  use_packbuf(:) = .false.
220 #endif
221 
222  allocate( req_cnt( comm_vsize_max) )
223  allocate( req_list(comm_nreq_max,comm_vsize_max) )
224  req_cnt(:) = -1
225  req_list(:,:) = mpi_request_null
226 
227  if ( comm_use_mpi_pc ) then
228  allocate( preq_cnt( comm_vsize_max_pc) )
229  allocate( preq_list(comm_nreq_max+1,comm_vsize_max_pc) )
230  preq_cnt(:) = -1
231  preq_list(:,:) = mpi_request_null
232 
233  allocate( pseqid(comm_vsize_max_pc) )
234  end if
235 
236  if ( prc_has_n .AND. prc_has_s .AND. prc_has_w .AND. prc_has_e ) then
237  comm_isallperiodic = .true.
238  else
239  comm_isallperiodic = .false.
240  endif
241 
242  if ( rp == kind(0.d0) ) then
243  comm_datatype = mpi_double_precision
244  elseif( rp == kind(0.0) ) then
245  comm_datatype = mpi_real
246  else
247  write(*,*) 'xxx precision is not supportd'
248  call prc_mpistop
249  endif
250 
251  comm_world = prc_local_comm_world
252 
253  if( io_l ) write(io_fid_log,*)
254  if( io_l ) write(io_fid_log,*) '*** Maximum number of vars for one communication: ', &
255  comm_vsize_max
256  if( io_l ) write(io_fid_log,*) '*** Data size of var (3D,including halo) [byte] : ', &
257  rp*ka*ia*ja
258  if( io_l ) write(io_fid_log,*) '*** Data size of halo [byte] : ', &
259  rp*ka*(2*ia*jhalo+2*jmax*ihalo)
260  if( io_l ) write(io_fid_log,*) '*** Ratio of halo against the whole 3D grid : ', &
261  real(2*IA*JHALO+2*JMAX*IHALO) / real(IA*JA)
262  if( io_l ) write(io_fid_log,*) '*** All side is periodic? : ', comm_isallperiodic
263 
264  return
integer, public imax
of computational cells: x, local
logical, public prc_has_n
integer, public prc_local_comm_world
local communicator
logical, public prc_has_e
module STDIO
Definition: scale_stdio.F90:12
logical, public prc_has_s
integer, public jhalo
of halo cells: y
module PROCESS
integer, public io_fid_conf
Config file ID.
Definition: scale_stdio.F90:55
logical, public prc_has_w
integer, public jmax
of computational cells: y, local
integer, public ihalo
of halo cells: x
Here is the caller graph for this function:

◆ comm_vars_init()

subroutine, public scale_comm::comm_vars_init ( character(len=*), intent(in)  varname,
real(rp), dimension(:,:,:), intent(inout)  var,
integer, intent(inout)  vid 
)

Register variables.

Parameters
[in]varnamevariable name
[in,out]varvariable array for register
[in,out]vidvariable ID

Definition at line 273 of file scale_comm.F90.

References scale_stdio::io_fid_log, scale_stdio::io_l, scale_process::prc_mpistop(), scale_prof::prof_rapend(), scale_prof::prof_rapstart(), and vars_init_mpi_pc().

273  implicit none
274 
275  character(len=*), intent(in) :: varname
276  real(RP), intent(inout) :: var(:,:,:)
277  integer, intent(inout) :: vid
278  !---------------------------------------------------------------------------
279 
280  if ( vid > comm_vsize_max ) then
281  write(*,*) 'xxx vid exceeds max', vid, comm_vsize_max
282  call prc_mpistop
283  end if
284 
285  if ( comm_use_mpi_pc ) then
286 
287  comm_vars_id = comm_vars_id + 1
288  if ( comm_vars_id > comm_vsize_max_pc ) then
289  write(*,*) 'xxx number of variable for MPI PC exceeds max', comm_vars_id, comm_vsize_max_pc
290  call prc_mpistop
291  end if
292 
293  call prof_rapstart('COMM_init_pers', 2)
294  call vars_init_mpi_pc(var, comm_vars_id, vid)
295  call prof_rapend ('COMM_init_pers', 2)
296 
297  vid = comm_vars_id + comm_vsize_max
298 
299  if( io_l ) write(io_fid_log,'(1x,A,I3.3,2A)') '*** [Pers.COMM] Initialize variable : ID = ', vid, &
300  ', name = ', trim(varname)
301 
302  end if
303 
304  return
Here is the call graph for this function:

◆ comm_vars8_init()

subroutine, public scale_comm::comm_vars8_init ( character(len=*), intent(in)  varname,
real(rp), dimension(:,:,:), intent(inout)  var,
integer, intent(inout)  vid 
)

Register variables.

Parameters
[in]varnamevariable name
[in,out]varvariable array for register
[in,out]vidvariable ID

Definition at line 313 of file scale_comm.F90.

References scale_stdio::io_fid_log, scale_stdio::io_l, scale_process::prc_mpistop(), scale_prof::prof_rapend(), scale_prof::prof_rapstart(), vars8_2d_mpi(), vars8_3d_mpi(), vars_2d_mpi(), vars_3d_mpi_pc(), and wait_3d_mpi().

Referenced by scale_atmos_dyn_common::atmos_dyn_filter_setup(), scale_atmos_dyn::atmos_dyn_setup(), scale_atmos_dyn_tinteg_short_rk3::atmos_dyn_tinteg_short_rk3_setup(), scale_atmos_dyn_tinteg_short_rk4::atmos_dyn_tinteg_short_rk4_setup(), scale_atmos_dyn_tinteg_tracer_rk3::atmos_dyn_tinteg_tracer_rk3_setup(), and scale_atmos_dyn_tstep_large_fvm_heve::atmos_dyn_tstep_large_fvm_heve_setup().

313  implicit none
314 
315  character(len=*), intent(in) :: varname
316  real(RP), intent(inout) :: var(:,:,:)
317  integer, intent(inout) :: vid
318  !---------------------------------------------------------------------------
319 
320  if ( vid > comm_vsize_max ) then
321  write(*,*) 'xxx vid exceeds max', vid, comm_vsize_max
322  call prc_mpistop
323  end if
324 
325  if ( comm_use_mpi_pc ) then
326 
327  comm_vars_id = comm_vars_id + 1
328  if ( comm_vars_id > comm_vsize_max_pc ) then
329  write(*,*) 'xxx number of variable for MPI PC exceeds max', comm_vars_id, comm_vsize_max_pc
330  call prc_mpistop
331  end if
332 
333  call prof_rapstart('COMM_init_pers', 2)
334  call vars8_init_mpi_pc(var, comm_vars_id, vid)
335  call prof_rapend ('COMM_init_pers', 2)
336 
337  vid = comm_vars_id + comm_vsize_max
338 
339  if( io_l ) write(io_fid_log,'(1x,A,I3.3,2A)') '*** [Pers.COMM] Initialize variable : ID = ', vid, &
340  ', name = ', trim(varname)
341 
342  end if
343 
344  return
Here is the call graph for this function:
Here is the caller graph for this function:

◆ comm_horizontal_mean()

subroutine, public scale_comm::comm_horizontal_mean ( real(rp), dimension(ka), intent(out)  varmean,
real(rp), dimension (ka,ia,ja), intent(in)  var 
)

calculate horizontal mean (global total with communication)

Parameters
[out]varmeanhorizontal mean
[in]var3D value

Definition at line 482 of file scale_comm.F90.

References comm_datatype, comm_world, scale_const::const_undef, scale_grid_index::ie, scale_grid_index::is, scale_grid_index::je, scale_grid_index::js, scale_grid_index::ka, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Referenced by scale_atmos_hydrostatic::atmos_hydrostatic_buildrho_3d(), scale_atmos_phy_mp_kessler::atmos_phy_mp_kessler(), scale_atmos_refstate::atmos_refstate_update(), scale_atmos_refstate::atmos_refstate_write(), and mod_atmos_vars::atmos_vars_history().

482  use scale_const, only: &
484  implicit none
485 
486  real(RP), intent(out) :: varmean(KA)
487  real(RP), intent(in) :: var (KA,IA,JA)
488 
489  real(RP) :: statval (KA)
490  real(RP) :: statcnt (KA)
491  real(RP) :: allstatval(KA)
492  real(RP) :: allstatcnt(KA)
493  real(RP) :: zerosw
494 
495  integer :: ierr
496  integer :: k, i, j
497  !---------------------------------------------------------------------------
498 
499  statval(:) = 0.0_rp
500  statcnt(:) = 0.0_rp
501  do j = js, je
502  do i = is, ie
503  do k = 1, ka
504  if ( abs(var(k,i,j)) < abs(const_undef) ) then
505  statval(k) = statval(k) + var(k,i,j)
506  statcnt(k) = statcnt(k) + 1.0_rp
507  endif
508  enddo
509  enddo
510  enddo
511 
512  ! [NOTE] always communicate globally
513  call prof_rapstart('COMM_Allreduce', 2)
514  ! All reduce
515  call mpi_allreduce( statval(1), &
516  allstatval(1), &
517  ka, &
518  comm_datatype, &
519  mpi_sum, &
520  comm_world, &
521  ierr )
522  ! All reduce
523  call mpi_allreduce( statcnt(1), &
524  allstatcnt(1), &
525  ka, &
526  comm_datatype, &
527  mpi_sum, &
528  comm_world, &
529  ierr )
530 
531  call prof_rapend ('COMM_Allreduce', 2)
532 
533  do k = 1, ka
534  zerosw = 0.5_rp - sign(0.5_rp, allstatcnt(k) - 1.e-12_rp )
535  varmean(k) = allstatval(k) / ( allstatcnt(k) + zerosw ) * ( 1.0_rp - zerosw )
536  !if( IO_L ) write(IO_FID_LOG,*) k, varmean(k), allstatval(k), allstatcnt(k)
537  enddo
538 
539  return
integer, public is
start point of inner domain: x, local
integer, public je
end point of inner domain: y, local
real(rp), public const_undef
Definition: scale_const.F90:43
integer, public js
start point of inner domain: y, local
module CONSTANT
Definition: scale_const.F90:14
integer, public ie
end point of inner domain: x, local
Here is the call graph for this function:
Here is the caller graph for this function:

◆ comm_horizontal_max_2d()

subroutine scale_comm::comm_horizontal_max_2d ( real(rp), intent(out)  varmax,
real(rp), dimension(ia,ja), intent(in)  var 
)

Get maximum value in horizontal area.

Parameters
[out]varmaxhorizontal maximum
[in]var2D value

Definition at line 545 of file scale_comm.F90.

References comm_datatype, comm_world, scale_const::const_huge, scale_grid_index::ie, scale_grid_index::is, scale_grid_index::je, scale_grid_index::js, scale_grid_index::ke, scale_grid_index::ks, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

545  implicit none
546 
547  real(RP), intent(out) :: varmax
548  real(RP), intent(in) :: var(IA,JA)
549 
550  real(RP) :: statval
551  real(RP) :: allstatval
552 
553  integer :: ierr
554  !---------------------------------------------------------------------------
555 
556  statval = maxval(var(is:ie,js:je))
557 
558  ! [NOTE] always communicate globally
559  call prof_rapstart('COMM_Allreduce', 2)
560  ! All reduce
561  call mpi_allreduce( statval, &
562  allstatval, &
563  1, &
564  comm_datatype, &
565  mpi_max, &
566  comm_world, &
567  ierr )
568 
569  call prof_rapend ('COMM_Allreduce', 2)
570 
571  varmax = allstatval
572 
573  return
integer, public is
start point of inner domain: x, local
integer, public je
end point of inner domain: y, local
integer, public js
start point of inner domain: y, local
integer, public ie
end point of inner domain: x, local
Here is the call graph for this function:

◆ comm_horizontal_min_2d()

subroutine scale_comm::comm_horizontal_min_2d ( real(rp), intent(out)  varmin,
real(rp), dimension(ia,ja), intent(in)  var 
)

Get minimum value in horizontal area.

Parameters
[out]varminhorizontal minimum
[in]var2D value

Definition at line 623 of file scale_comm.F90.

References comm_datatype, comm_world, scale_const::const_huge, scale_grid_index::ie, scale_grid_index::is, scale_grid_index::je, scale_grid_index::js, scale_grid_index::ke, scale_grid_index::ks, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

623  implicit none
624 
625  real(RP), intent(out) :: varmin
626  real(RP), intent(in) :: var(IA,JA)
627 
628  real(RP) :: statval
629  real(RP) :: allstatval
630 
631  integer :: ierr
632  !---------------------------------------------------------------------------
633 
634  statval = minval(var(is:ie,js:je))
635 
636  ! [NOTE] always communicate globally
637  call prof_rapstart('COMM_Allreduce', 2)
638  ! All reduce
639  call mpi_allreduce( statval, &
640  allstatval, &
641  1, &
642  comm_datatype, &
643  mpi_min, &
644  comm_world, &
645  ierr )
646 
647  call prof_rapend ('COMM_Allreduce', 2)
648 
649  varmin = allstatval
650 
651  return
integer, public is
start point of inner domain: x, local
integer, public je
end point of inner domain: y, local
integer, public js
start point of inner domain: y, local
integer, public ie
end point of inner domain: x, local
Here is the call graph for this function:

◆ comm_gather_2d()

subroutine scale_comm::comm_gather_2d ( real(rp), dimension(:,:), intent(out)  recv,
real(rp), dimension(:,:), intent(in)  send,
integer, intent(in)  gIA,
integer, intent(in)  gJA 
)

Get data from whole process value in 2D field.

Parameters
[out]recvreceive buffer (gIA,gJA)
[in]sendsend buffer (gIA,gJA)
[in]giadimension size of x
[in]gjadimension size of y

Definition at line 701 of file scale_comm.F90.

References comm_datatype, comm_world, and scale_process::prc_masterrank.

701  use scale_process, only: &
703  implicit none
704 
705  real(RP), intent(out) :: recv(:,:)
706  real(RP), intent(in) :: send(:,:)
707  integer, intent(in) :: gIA
708  integer, intent(in) :: gJA
709 
710  integer :: sendcounts, recvcounts
711  integer :: ierr
712  !---------------------------------------------------------------------------
713 
714  sendcounts = gia * gja
715  recvcounts = gia * gja
716 
717  call mpi_gather( send(:,:), &
718  sendcounts, &
719  comm_datatype, &
720  recv(:,:), &
721  recvcounts, &
722  comm_datatype, &
723  prc_masterrank, &
724  comm_world, &
725  ierr )
726 
727  return
module PROCESS
integer, parameter, public prc_masterrank
master process in each communicator

◆ comm_gather_3d()

subroutine scale_comm::comm_gather_3d ( real(rp), dimension(:,:,:), intent(out)  recv,
real(rp), dimension(:,:,:), intent(in)  send,
integer, intent(in)  gIA,
integer, intent(in)  gJA,
integer, intent(in)  gKA 
)

Get data from whole process value in 3D field.

Parameters
[out]recvreceive buffer(gIA,gJA,gKA)
[in]sendsend buffer (gIA,gJA,gKA)
[in]giadimension size of x
[in]gjadimension size of y
[in]gkadimension size of z

Definition at line 733 of file scale_comm.F90.

References comm_datatype, comm_world, and scale_process::prc_masterrank.

733  use scale_process, only: &
735  implicit none
736 
737  real(RP), intent(out) :: recv(:,:,:)
738  real(RP), intent(in) :: send(:,:,:)
739  integer, intent(in) :: gIA
740  integer, intent(in) :: gJA
741  integer, intent(in) :: gKA
742 
743  integer :: sendcounts, recvcounts
744  integer :: ierr
745  !---------------------------------------------------------------------------
746 
747  sendcounts = gia * gja * gka
748  recvcounts = gia * gja * gka
749 
750  call mpi_gather( send(:,:,:), &
751  sendcounts, &
752  comm_datatype, &
753  recv(:,:,:), &
754  recvcounts, &
755  comm_datatype, &
756  prc_masterrank, &
757  comm_world, &
758  ierr )
759 
760  return
module PROCESS
integer, parameter, public prc_masterrank
master process in each communicator

◆ comm_bcast_scr()

subroutine scale_comm::comm_bcast_scr ( real(rp), intent(inout)  var)

Broadcast data for whole process value in scalar field.

Parameters
[in,out]varbroadcast buffer (gIA)

Definition at line 766 of file scale_comm.F90.

References comm_datatype, comm_world, scale_process::prc_masterrank, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

766  use scale_process, only: &
768  implicit none
769 
770  real(RP), intent(inout) :: var
771 
772  integer :: counts
773  integer :: ierr
774  !---------------------------------------------------------------------------
775 
776  call prof_rapstart('COMM_Bcast', 2)
777 
778  counts = 1
779 
780  call mpi_bcast( var, &
781  counts, &
782  comm_datatype, &
783  prc_masterrank, &
784  comm_world, &
785  ierr )
786 
787  call prof_rapend('COMM_Bcast', 2)
788 
789  return
module PROCESS
integer, parameter, public prc_masterrank
master process in each communicator
Here is the call graph for this function:

◆ comm_bcast_1d()

subroutine scale_comm::comm_bcast_1d ( real(rp), dimension(:), intent(inout)  var,
integer, intent(in)  gIA 
)

Broadcast data for whole process value in 1D field.

Parameters
[in,out]varbroadcast buffer (gIA)
[in]giadimension size of x

Definition at line 795 of file scale_comm.F90.

References comm_datatype, comm_world, scale_process::prc_masterrank, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

795  use scale_process, only: &
797  implicit none
798 
799  real(RP), intent(inout) :: var(:)
800  integer, intent(in) :: gIA
801 
802  integer :: counts
803  integer :: ierr
804  !---------------------------------------------------------------------------
805 
806  call prof_rapstart('COMM_Bcast', 2)
807 
808  counts = gia
809 
810  call mpi_bcast( var(:), &
811  counts, &
812  comm_datatype, &
813  prc_masterrank, &
814  comm_world, &
815  ierr )
816 
817  call prof_rapend('COMM_Bcast', 2)
818 
819  return
module PROCESS
integer, parameter, public prc_masterrank
master process in each communicator
Here is the call graph for this function:

◆ comm_bcast_2d()

subroutine scale_comm::comm_bcast_2d ( real(rp), dimension(:,:), intent(inout)  var,
integer, intent(in)  gIA,
integer, intent(in)  gJA 
)

Broadcast data for whole process value in 2D field.

Parameters
[in,out]varbroadcast buffer (gIA,gJA)
[in]giadimension size of x
[in]gjadimension size of y

Definition at line 825 of file scale_comm.F90.

References comm_datatype, comm_world, scale_process::prc_masterrank, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

825  use scale_process, only: &
827  implicit none
828 
829  real(RP), intent(inout) :: var(:,:)
830  integer, intent(in) :: gIA
831  integer, intent(in) :: gJA
832 
833  integer :: counts
834  integer :: ierr
835  !---------------------------------------------------------------------------
836 
837  call prof_rapstart('COMM_Bcast', 2)
838 
839  counts = gia * gja
840 
841  call mpi_bcast( var(:,:), &
842  counts, &
843  comm_datatype, &
844  prc_masterrank, &
845  comm_world, &
846  ierr )
847 
848  call prof_rapend('COMM_Bcast', 2)
849 
850  return
module PROCESS
integer, parameter, public prc_masterrank
master process in each communicator
Here is the call graph for this function:

◆ comm_bcast_3d()

subroutine scale_comm::comm_bcast_3d ( real(rp), dimension(:,:,:), intent(inout)  var,
integer, intent(in)  gIA,
integer, intent(in)  gJA,
integer, intent(in)  gKA 
)

Broadcast data for whole process value in 3D field.

Parameters
[in,out]varbroadcast buffer(gIA,gJA,gKA)
[in]giadimension size of x
[in]gjadimension size of y
[in]gkadimension size of z

Definition at line 856 of file scale_comm.F90.

References comm_datatype, comm_world, scale_process::prc_masterrank, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

856  use scale_process, only: &
858  implicit none
859 
860  real(RP), intent(inout) :: var(:,:,:)
861  integer, intent(in) :: gIA
862  integer, intent(in) :: gJA
863  integer, intent(in) :: gKA
864 
865  integer :: counts
866  integer :: ierr
867  !---------------------------------------------------------------------------
868 
869  call prof_rapstart('COMM_Bcast', 2)
870 
871  counts = gia * gja * gka
872 
873  call mpi_bcast( var(:,:,:), &
874  counts, &
875  comm_datatype, &
876  prc_masterrank, &
877  comm_world, &
878  ierr )
879 
880  call prof_rapend('COMM_Bcast', 2)
881 
882  return
module PROCESS
integer, parameter, public prc_masterrank
master process in each communicator
Here is the call graph for this function:

◆ comm_bcast_4d()

subroutine scale_comm::comm_bcast_4d ( real(rp), dimension(:,:,:,:), intent(inout)  var,
integer, intent(in)  gIA,
integer, intent(in)  gJA,
integer, intent(in)  gKA,
integer, intent(in)  gTime 
)

Broadcast data for whole process value in 4D field.

Parameters
[in,out]varbroadcast buffer(gIA,gJA,gKA,gTime)
[in]giadimension size of x
[in]gjadimension size of y
[in]gkadimension size of z
[in]gtimedimension size of time

Definition at line 888 of file scale_comm.F90.

References comm_datatype, comm_world, scale_process::prc_masterrank, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

888  use scale_process, only: &
890  implicit none
891 
892  real(RP), intent(inout) :: var(:,:,:,:)
893  integer, intent(in) :: gIA
894  integer, intent(in) :: gJA
895  integer, intent(in) :: gKA
896  integer, intent(in) :: gTime
897 
898  integer :: counts
899  integer :: ierr
900  !---------------------------------------------------------------------------
901 
902  call prof_rapstart('COMM_Bcast', 2)
903 
904  counts = gia * gja * gka * gtime
905  if ( gia>0 .AND. gja>0 .AND. gka>0 .AND. gtime>0 .AND. &
906  counts < 0 ) then
907  write(*,*) 'xxx counts overflow'
908  call prc_mpistop
909  end if
910 
911  call mpi_bcast( var(:,:,:,:), &
912  counts, &
913  comm_datatype, &
914  prc_masterrank, &
915  comm_world, &
916  ierr )
917 
918  call prof_rapend('COMM_Bcast', 2)
919 
920  return
module PROCESS
integer, parameter, public prc_masterrank
master process in each communicator
Here is the call graph for this function:

◆ comm_bcast_int_scr()

subroutine scale_comm::comm_bcast_int_scr ( integer, intent(inout)  var)

Broadcast data for whole process value in scalar (integer)

Parameters
[in,out]varbroadcast buffer (gIA)

Definition at line 926 of file scale_comm.F90.

References comm_world, scale_process::prc_masterrank, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

926  use scale_process, only: &
928  implicit none
929 
930  integer, intent(inout) :: var
931 
932  integer :: counts
933  integer :: ierr
934  !---------------------------------------------------------------------------
935 
936  call prof_rapstart('COMM_Bcast', 2)
937 
938  counts = 1
939 
940  call mpi_bcast( var, &
941  counts, &
942  mpi_integer, &
943  prc_masterrank, &
944  comm_world, &
945  ierr )
946 
947  call prof_rapend('COMM_Bcast', 2)
948 
949  return
module PROCESS
integer, parameter, public prc_masterrank
master process in each communicator
Here is the call graph for this function:

◆ comm_bcast_int_1d()

subroutine scale_comm::comm_bcast_int_1d ( integer, dimension(:), intent(inout)  var,
integer, intent(in)  gIA 
)

Broadcast data for whole process value in 1D field (integer)

Parameters
[in,out]varbroadcast buffer (gIA)
[in]giadimension size of x

Definition at line 955 of file scale_comm.F90.

References comm_world, scale_process::prc_masterrank, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

955  use scale_process, only: &
957  implicit none
958 
959  integer, intent(inout) :: var(:)
960  integer, intent(in) :: gIA
961 
962  integer :: counts
963  integer :: ierr
964  !---------------------------------------------------------------------------
965 
966  call prof_rapstart('COMM_Bcast', 2)
967 
968  counts = gia
969 
970  call mpi_bcast( var(:), &
971  counts, &
972  mpi_integer, &
973  prc_masterrank, &
974  comm_world, &
975  ierr )
976 
977  call prof_rapend('COMM_Bcast', 2)
978 
979  return
module PROCESS
integer, parameter, public prc_masterrank
master process in each communicator
Here is the call graph for this function:

◆ comm_bcast_int_2d()

subroutine scale_comm::comm_bcast_int_2d ( integer, dimension(:,:), intent(inout)  var,
integer, intent(in)  gIA,
integer, intent(in)  gJA 
)

Broadcast data for whole process value in 2D field (integer)

Parameters
[in,out]varbroadcast buffer (gIA,gJA)
[in]giadimension size of x
[in]gjadimension size of y

Definition at line 985 of file scale_comm.F90.

References comm_world, scale_process::prc_masterrank, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

985  use scale_process, only: &
987  implicit none
988 
989  integer, intent(inout) :: var(:,:)
990  integer, intent(in) :: gIA
991  integer, intent(in) :: gJA
992 
993  integer :: counts
994  integer :: ierr
995  !---------------------------------------------------------------------------
996 
997  call prof_rapstart('COMM_Bcast', 2)
998 
999  counts = gia * gja
1000 
1001  call mpi_bcast( var(:,:), &
1002  counts, &
1003  mpi_integer, &
1004  prc_masterrank, &
1005  comm_world, &
1006  ierr )
1007 
1008  call prof_rapend('COMM_Bcast', 2)
1009 
1010  return
module PROCESS
integer, parameter, public prc_masterrank
master process in each communicator
Here is the call graph for this function:

◆ comm_bcast_logical_scr()

subroutine scale_comm::comm_bcast_logical_scr ( logical, intent(inout)  var)

Broadcast data for whole process value in scalar (logical)

Parameters
[in,out]varbroadcast buffer

Definition at line 1016 of file scale_comm.F90.

References comm_world, scale_process::prc_masterrank, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

1016  use scale_process, only: &
1018  implicit none
1019 
1020  logical, intent(inout) :: var
1021 
1022  integer :: counts
1023  integer :: ierr
1024  !---------------------------------------------------------------------------
1025 
1026  call prof_rapstart('COMM_Bcast', 2)
1027 
1028  counts = 1
1029 
1030  call mpi_bcast( var, &
1031  counts, &
1032  mpi_logical, &
1033  prc_masterrank, &
1034  comm_world, &
1035  ierr )
1036 
1037  call prof_rapend('COMM_Bcast', 2)
1038 
1039  return
module PROCESS
integer, parameter, public prc_masterrank
master process in each communicator
Here is the call graph for this function:

◆ vars_init_mpi_pc()

subroutine scale_comm::vars_init_mpi_pc ( real(rp), dimension(:,:,:), intent(inout)  var,
integer, intent(in)  vid,
integer, intent(in)  seqid 
)

Definition at line 1046 of file scale_comm.F90.

References comm_datatype, comm_world, scale_grid_index::ie, scale_grid_index::ihalo, scale_grid_index::is, scale_grid_index::je, scale_grid_index::jhalo, scale_grid_index::js, scale_rm_process::prc_e, scale_rm_process::prc_has_e, scale_rm_process::prc_has_n, scale_rm_process::prc_has_s, scale_rm_process::prc_has_w, scale_process::prc_mpistop(), scale_rm_process::prc_n, scale_rm_process::prc_ne, scale_rm_process::prc_next, scale_rm_process::prc_nw, scale_rm_process::prc_s, scale_rm_process::prc_se, scale_rm_process::prc_sw, and scale_rm_process::prc_w.

Referenced by comm_vars_init().

1046  implicit none
1047 
1048  real(RP), intent(inout) :: var(:,:,:)
1049  integer, intent(in) :: vid
1050  integer, intent(in) :: seqid
1051 
1052  integer :: ireq, tag, ierr
1053  logical :: flag
1054 
1055  integer :: kd
1056  integer :: i
1057 
1058  tag = vid * 100
1059  ireq = 1
1060 
1061  kd = size(var, 1)
1062 
1063  ! register whole array to inner table of MPI and/or lower library
1064  ! otherwise a lot of sub small segments would be registered
1065  call mpi_send_init( var(:,:,:), size(var), comm_datatype, &
1066  mpi_proc_null, tag+comm_nreq_max+1, comm_world, &
1067  preq_list(comm_nreq_max+1,vid), ierr )
1068 
1069  !--- From 4-Direction HALO communicate
1070  ! From S
1071  call mpi_recv_init( var(:,:,js-jhalo:js-1), comm_size2d_ns4*kd, comm_datatype, &
1072  prc_next(prc_s), tag+1, comm_world, preq_list(ireq,vid), ierr )
1073  ireq = ireq + 1
1074  ! From N
1075  call mpi_recv_init( var(:,:,je+1:je+jhalo), comm_size2d_ns4*kd, comm_datatype, &
1076  prc_next(prc_n), tag+2, comm_world, preq_list(ireq,vid), ierr )
1077  ireq = ireq + 1
1078  ! From E
1079  call mpi_recv_init( recvpack_e2p(:,seqid), comm_size2d_we*kd, comm_datatype, &
1080  prc_next(prc_e), tag+3, comm_world, preq_list(ireq,vid), ierr )
1081  ireq = ireq + 1
1082  ! From W
1083  call mpi_recv_init( recvpack_w2p(:,seqid), comm_size2d_we*kd, comm_datatype, &
1084  prc_next(prc_w), tag+4, comm_world, preq_list(ireq,vid), ierr )
1085  ireq = ireq + 1
1086 
1087  !--- To 4-Direction HALO communicate
1088  ! To W HALO
1089  call mpi_send_init( sendpack_p2w(:,seqid), comm_size2d_we*kd, comm_datatype, &
1090  prc_next(prc_w), tag+3, comm_world, preq_list(ireq,vid), ierr )
1091  ireq = ireq + 1
1092  ! To E HALO
1093  call mpi_send_init( sendpack_p2e(:,seqid), comm_size2d_we*kd, comm_datatype, &
1094  prc_next(prc_e), tag+4, comm_world, preq_list(ireq,vid), ierr )
1095  ireq = ireq + 1
1096  ! To N HALO
1097  call mpi_send_init( var(:,:,je-jhalo+1:je), comm_size2d_ns4*kd, comm_datatype, &
1098  prc_next(prc_n), tag+1, comm_world, preq_list(ireq,vid), ierr )
1099  ireq = ireq + 1
1100  ! To S HALO
1101  call mpi_send_init( var(:,:,js:js+jhalo-1), comm_size2d_ns4*kd, comm_datatype, &
1102  prc_next(prc_s), tag+2, comm_world, preq_list(ireq,vid), ierr )
1103  ireq = ireq + 1
1104 
1105  preq_cnt(vid) = ireq - 1
1106  pseqid(vid) = seqid
1107 
1108  ! to finish initial processes of MPIa
1109  do i = 1, 32
1110  call mpi_testall( preq_cnt(vid), preq_list(1:preq_cnt(vid),vid), &
1111  flag, mpi_statuses_ignore, ierr )
1112  enddo
1113 
1114  return
integer, public je
end point of inner domain: y, local
integer, public jhalo
of halo cells: y
integer, public js
start point of inner domain: y, local
Here is the call graph for this function:
Here is the caller graph for this function:

◆ vars8_3d_mpi()

subroutine scale_comm::vars8_3d_mpi ( real(rp), dimension(:,:,:), intent(inout)  var,
integer, intent(in)  vid 
)

Definition at line 1693 of file scale_comm.F90.

References comm_datatype, comm_world, scale_grid_index::ie, scale_grid_index::ihalo, scale_grid_index::is, scale_grid_index::je, scale_grid_index::jhalo, scale_grid_index::js, scale_rm_process::prc_e, scale_rm_process::prc_has_e, scale_rm_process::prc_has_n, scale_rm_process::prc_has_s, scale_rm_process::prc_has_w, scale_process::prc_mpistop(), scale_rm_process::prc_n, scale_rm_process::prc_ne, scale_rm_process::prc_next, scale_rm_process::prc_nw, scale_rm_process::prc_s, scale_rm_process::prc_se, scale_rm_process::prc_sw, and scale_rm_process::prc_w.

Referenced by comm_vars8_init().

1693  use scale_process, only: &
1694  prc_mpistop
1695  implicit none
1696 
1697  real(RP), intent(inout) :: var(:,:,:)
1698  integer, intent(in) :: vid
1699 
1700  integer :: ireq, tag, tagc
1701 
1702  integer :: kd
1703 
1704  integer :: ierr
1705  integer :: j
1706  !---------------------------------------------------------------------------
1707 
1708  tag = vid * 100
1709  ireq = 1
1710 
1711  kd = size(var, 1)
1712 
1713 #ifdef DEBUG
1714  if ( use_packbuf(vid) ) then
1715  write(*,*) 'packing buffer is already used', vid
1716  call prc_mpistop
1717  end if
1718  use_packbuf(vid) = .true.
1719 #endif
1720 
1721  if ( comm_isallperiodic ) then ! periodic condition
1722 
1723  !--- From 8-Direction HALO communicate
1724  ! From SE
1725  tagc = 0
1726  do j = js-jhalo, js-1
1727  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1728  prc_next(prc_se), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1729  ireq = ireq + 1
1730  tagc = tagc + 1
1731  enddo
1732  ! From SW
1733  tagc = 10
1734  do j = js-jhalo, js-1
1735  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1736  prc_next(prc_sw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1737  ireq = ireq + 1
1738  tagc = tagc + 1
1739  enddo
1740  ! From NE
1741  tagc = 20
1742  do j = je+1, je+jhalo
1743  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1744  prc_next(prc_ne), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1745  ireq = ireq + 1
1746  tagc = tagc + 1
1747  enddo
1748  ! From NW
1749  tagc = 30
1750  do j = je+1, je+jhalo
1751  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1752  prc_next(prc_nw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1753  ireq = ireq + 1
1754  tagc = tagc + 1
1755  enddo
1756  ! From S
1757  tagc = 40
1758  do j = js-jhalo, js-1
1759  call mpi_irecv( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1760  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1761  ireq = ireq + 1
1762  tagc = tagc + 1
1763  enddo
1764  ! From N
1765  tagc = 50
1766  do j = je+1, je+jhalo
1767  call mpi_irecv( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1768  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1769  ireq = ireq + 1
1770  tagc = tagc + 1
1771  enddo
1772  ! From E
1773  tagc = 60
1774  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we*kd, comm_datatype, &
1775  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1776  ireq = ireq + 1
1777  ! From W
1778  tagc = 70
1779  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we*kd, comm_datatype, &
1780  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1781  ireq = ireq + 1
1782 
1783  call pack_3d(var, vid)
1784 
1785 
1786  !--- To 8-Direction HALO communicate
1787  ! To W HALO
1788  tagc = 60
1789  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we*kd, comm_datatype, &
1790  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1791  ireq = ireq + 1
1792  ! To E HALO
1793  tagc = 70
1794  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we*kd, comm_datatype, &
1795  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1796  ireq = ireq + 1
1797  ! To N HALO
1798  tagc = 40
1799  do j = je-jhalo+1, je
1800  call mpi_isend( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1801  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1802  ireq = ireq + 1
1803  tagc = tagc + 1
1804  enddo
1805  ! To S HALO
1806  tagc = 50
1807  do j = js, js+jhalo-1
1808  call mpi_isend( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1809  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1810  ireq = ireq + 1
1811  tagc = tagc + 1
1812  enddo
1813  ! To NW HALO
1814  tagc = 0
1815  do j = je-jhalo+1, je
1816  call mpi_isend( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
1817  prc_next(prc_nw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1818  ireq = ireq + 1
1819  tagc = tagc + 1
1820  enddo
1821  ! To NE HALO
1822  tagc = 10
1823  do j = je-jhalo+1, je
1824  call mpi_isend( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
1825  prc_next(prc_ne), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1826  ireq = ireq + 1
1827  tagc = tagc + 1
1828  enddo
1829  ! To SW HALO
1830  tagc = 20
1831  do j = js, js+jhalo-1
1832  call mpi_isend( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
1833  prc_next(prc_sw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1834  ireq = ireq + 1
1835  tagc = tagc + 1
1836  enddo
1837  ! To SE HALO
1838  tagc = 30
1839  do j = js, js+jhalo-1
1840  call mpi_isend( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
1841  prc_next(prc_se), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1842  ireq = ireq + 1
1843  tagc = tagc + 1
1844  enddo
1845 
1846  else ! non-periodic condition
1847 
1848  !--- From 8-Direction HALO communicate
1849  ! From SE
1850  if ( prc_has_s .AND. prc_has_e ) then
1851  tagc = 0
1852  do j = js-jhalo, js-1
1853  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1854  prc_next(prc_se), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1855  ireq = ireq + 1
1856  tagc = tagc + 1
1857  enddo
1858  else if ( prc_has_s ) then
1859  tagc = 0
1860  do j = js-jhalo, js-1
1861  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1862  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1863  ireq = ireq + 1
1864  tagc = tagc + 1
1865  enddo
1866  else if ( prc_has_e ) then
1867  tagc = 0
1868  do j = js-jhalo, js-1
1869  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1870  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1871  ireq = ireq + 1
1872  tagc = tagc + 1
1873  enddo
1874  endif
1875  ! From SW
1876  if ( prc_has_s .AND. prc_has_w ) then
1877  tagc = 10
1878  do j = js-jhalo, js-1
1879  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1880  prc_next(prc_sw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1881  ireq = ireq + 1
1882  tagc = tagc + 1
1883  enddo
1884  else if ( prc_has_s ) then
1885  tagc = 10
1886  do j = js-jhalo, js-1
1887  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1888  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1889  ireq = ireq + 1
1890  tagc = tagc + 1
1891  enddo
1892  else if ( prc_has_w ) then
1893  tagc = 10
1894  do j = js-jhalo, js-1
1895  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1896  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1897  ireq = ireq + 1
1898  tagc = tagc + 1
1899  enddo
1900  endif
1901  ! From NE
1902  if ( prc_has_n .AND. prc_has_e ) then
1903  tagc = 20
1904  do j = je+1, je+jhalo
1905  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1906  prc_next(prc_ne), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1907  ireq = ireq + 1
1908  tagc = tagc + 1
1909  enddo
1910  else if ( prc_has_n ) then
1911  tagc = 20
1912  do j = je+1, je+jhalo
1913  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1914  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1915  ireq = ireq + 1
1916  tagc = tagc + 1
1917  enddo
1918  else if ( prc_has_e ) then
1919  tagc = 20
1920  do j = je+1, je+jhalo
1921  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1922  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1923  ireq = ireq + 1
1924  tagc = tagc + 1
1925  enddo
1926  endif
1927  ! From NW
1928  if ( prc_has_n .AND. prc_has_w ) then
1929  tagc = 30
1930  do j = je+1, je+jhalo
1931  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1932  prc_next(prc_nw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1933  ireq = ireq + 1
1934  tagc = tagc + 1
1935  enddo
1936  else if ( prc_has_n ) then
1937  tagc = 30
1938  do j = je+1, je+jhalo
1939  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1940  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1941  ireq = ireq + 1
1942  tagc = tagc + 1
1943  enddo
1944  else if ( prc_has_w ) then
1945  tagc = 30
1946  do j = je+1, je+jhalo
1947  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1948  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1949  ireq = ireq + 1
1950  tagc = tagc + 1
1951  enddo
1952  endif
1953  ! From S
1954  if ( prc_has_s ) then
1955  tagc = 40
1956  do j = js-jhalo, js-1
1957  call mpi_irecv( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1958  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1959  ireq = ireq + 1
1960  tagc = tagc + 1
1961  enddo
1962  endif
1963  ! From N
1964  if ( prc_has_n ) then
1965  tagc = 50
1966  do j = je+1, je+jhalo
1967  call mpi_irecv( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1968  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1969  ireq = ireq + 1
1970  tagc = tagc + 1
1971  enddo
1972  endif
1973  ! From E
1974  if ( prc_has_e ) then
1975  tagc = 60
1976  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we*kd, comm_datatype, &
1977  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1978  ireq = ireq + 1
1979  endif
1980  ! From W
1981  if ( prc_has_w ) then
1982  tagc = 70
1983  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we*kd, comm_datatype, &
1984  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1985  ireq = ireq + 1
1986  endif
1987 
1988  call pack_3d(var, vid)
1989 
1990  !--- To 8-Direction HALO communicate
1991  ! To W HALO
1992  if ( prc_has_w ) then
1993  tagc = 60
1994  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we*kd, comm_datatype, &
1995  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1996  ireq = ireq + 1
1997  endif
1998  ! To E HALO
1999  if ( prc_has_e ) then
2000  tagc = 70
2001  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we*kd, comm_datatype, &
2002  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2003  ireq = ireq + 1
2004  endif
2005  ! To N HALO
2006  if ( prc_has_n ) then
2007  tagc = 40
2008  do j = je-jhalo+1, je
2009  call mpi_isend( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
2010  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2011  ireq = ireq + 1
2012  tagc = tagc + 1
2013  enddo
2014  endif
2015  ! To S HALO
2016  if ( prc_has_s ) then
2017  tagc = 50
2018  do j = js, js+jhalo-1
2019  call mpi_isend( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
2020  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2021  ireq = ireq + 1
2022  tagc = tagc + 1
2023  enddo
2024  endif
2025  ! To NW HALO
2026  if ( prc_has_n .AND. prc_has_w ) then
2027  tagc = 0
2028  do j = je-jhalo+1, je
2029  call mpi_isend( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
2030  prc_next(prc_nw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2031  ireq = ireq + 1
2032  tagc = tagc + 1
2033  enddo
2034  else if ( prc_has_n ) then
2035  tagc = 10
2036  do j = je-jhalo+1, je
2037  call mpi_isend( var(1,1,j), comm_size2d_4c*kd, comm_datatype, &
2038  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2039  ireq = ireq + 1
2040  tagc = tagc + 1
2041  enddo
2042  else if ( prc_has_w ) then
2043  tagc = 20
2044  do j = je+1, je+jhalo
2045  call mpi_isend( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
2046  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2047  ireq = ireq + 1
2048  tagc = tagc + 1
2049  enddo
2050  endif
2051  ! To NE HALO
2052  if ( prc_has_n .AND. prc_has_e ) then
2053  tagc = 10
2054  do j = je-jhalo+1, je
2055  call mpi_isend( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
2056  prc_next(prc_ne), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2057  ireq = ireq + 1
2058  tagc = tagc + 1
2059  enddo
2060  else if ( prc_has_n ) then
2061  tagc = 0
2062  do j = je-jhalo+1, je
2063  call mpi_isend( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
2064  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2065  ireq = ireq + 1
2066  tagc = tagc + 1
2067  enddo
2068  else if ( prc_has_e ) then
2069  tagc = 30
2070  do j = je+1, je+jhalo
2071  call mpi_isend( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
2072  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2073  ireq = ireq + 1
2074  tagc = tagc + 1
2075  enddo
2076  endif
2077  ! To SW HALO
2078  if ( prc_has_s .AND. prc_has_w ) then
2079  tagc = 20
2080  do j = js, js+jhalo-1
2081  call mpi_isend( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
2082  prc_next(prc_sw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2083  ireq = ireq + 1
2084  tagc = tagc + 1
2085  enddo
2086  else if ( prc_has_s ) then
2087  tagc = 30
2088  do j = js, js+jhalo-1
2089  call mpi_isend( var(1,1,j), comm_size2d_4c*kd, comm_datatype, &
2090  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2091  ireq = ireq + 1
2092  tagc = tagc + 1
2093  enddo
2094  else if ( prc_has_w ) then
2095  tagc = 0
2096  do j = js-jhalo, js-1
2097  call mpi_isend( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
2098  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2099  ireq = ireq + 1
2100  tagc = tagc + 1
2101  enddo
2102  endif
2103  ! To SE HALO
2104  if ( prc_has_s .AND. prc_has_e ) then
2105  tagc = 30
2106  do j = js, js+jhalo-1
2107  call mpi_isend( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
2108  prc_next(prc_se), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2109  ireq = ireq + 1
2110  tagc = tagc + 1
2111  enddo
2112  else if ( prc_has_s ) then
2113  tagc = 20
2114  do j = js, js+jhalo-1
2115  call mpi_isend( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
2116  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2117  ireq = ireq + 1
2118  tagc = tagc + 1
2119  enddo
2120  else if ( prc_has_e ) then
2121  tagc = 10
2122  do j = js-jhalo, js-1
2123  call mpi_isend( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
2124  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2125  ireq = ireq + 1
2126  tagc = tagc + 1
2127  enddo
2128  endif
2129 
2130  endif
2131 
2132  req_cnt(vid) = ireq - 1
2133 
2134  return
integer, public is
start point of inner domain: x, local
integer, public je
end point of inner domain: y, local
logical, public prc_has_n
subroutine, public prc_mpistop
Abort MPI.
logical, public prc_has_e
logical, public prc_has_s
integer, public jhalo
of halo cells: y
integer, public js
start point of inner domain: y, local
module PROCESS
integer, public ie
end point of inner domain: x, local
logical, public prc_has_w
integer, public ihalo
of halo cells: x
Here is the call graph for this function:
Here is the caller graph for this function:

◆ vars_2d_mpi()

subroutine scale_comm::vars_2d_mpi ( real(rp), dimension(:,:), intent(inout)  var,
integer, intent(in)  vid 
)

Definition at line 2138 of file scale_comm.F90.

References comm_datatype, comm_world, scale_grid_index::je, scale_grid_index::jhalo, scale_grid_index::js, scale_rm_process::prc_e, scale_rm_process::prc_has_e, scale_rm_process::prc_has_n, scale_rm_process::prc_has_s, scale_rm_process::prc_has_w, scale_process::prc_mpistop(), scale_rm_process::prc_n, scale_rm_process::prc_next, scale_rm_process::prc_s, and scale_rm_process::prc_w.

Referenced by comm_vars8_init().

2138  use scale_process, only: &
2139  prc_mpistop
2140  implicit none
2141 
2142  real(RP), intent(inout) :: var(:,:)
2143  integer, intent(in) :: vid
2144 
2145  integer :: ireq, tag
2146  integer :: ierr
2147  !---------------------------------------------------------------------------
2148 
2149  tag = vid * 100
2150  ireq = 1
2151 
2152 #ifdef DEBUG
2153  if ( use_packbuf(vid) ) then
2154  write(*,*) 'packing buffer is already used', vid
2155  call prc_mpistop
2156  end if
2157  use_packbuf(vid) = .true.
2158 #endif
2159 
2160  if ( comm_isallperiodic ) then
2161  !--- periodic condition
2162  !--- From 4-Direction HALO communicate
2163  ! From S
2164  call mpi_irecv( var(:,js-jhalo:js-1), comm_size2d_ns4, &
2165  comm_datatype, prc_next(prc_s), tag+1, &
2166  comm_world, req_list(ireq,vid), ierr )
2167  ireq = ireq + 1
2168 
2169  ! From N
2170  call mpi_irecv( var(:,je+1:je+jhalo), comm_size2d_ns4, &
2171  comm_datatype, prc_next(prc_n), tag+2, &
2172  comm_world, req_list(ireq,vid), ierr )
2173  ireq = ireq + 1
2174 
2175  ! From E
2176  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we, &
2177  comm_datatype, prc_next(prc_e), tag+3, &
2178  comm_world, req_list(ireq,vid), ierr )
2179  ireq = ireq + 1
2180 
2181  ! From W
2182  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we, &
2183  comm_datatype, prc_next(prc_w), tag+4, &
2184  comm_world, req_list(ireq,vid), ierr )
2185  ireq = ireq + 1
2186 
2187  call pack_2d(var, vid)
2188 
2189  ! To W HALO communicate
2190  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we, &
2191  comm_datatype, prc_next(prc_w), tag+3, &
2192  comm_world, req_list(ireq,vid), ierr )
2193  ireq = ireq + 1
2194 
2195  ! To E HALO communicate
2196  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we, &
2197  comm_datatype, prc_next(prc_e), tag+4, &
2198  comm_world, req_list(ireq,vid), ierr )
2199  ireq = ireq + 1
2200 
2201  ! To N HALO communicate
2202  call mpi_isend( var(:,je-jhalo+1:je), comm_size2d_ns4, &
2203  comm_datatype, prc_next(prc_n), tag+1, &
2204  comm_world, req_list(ireq,vid), ierr )
2205  ireq = ireq + 1
2206 
2207  ! To S HALO communicate
2208  call mpi_isend( var(:,js:js+jhalo-1), comm_size2d_ns4, &
2209  comm_datatype, prc_next(prc_s), tag+2, &
2210  comm_world, req_list(ireq,vid), ierr )
2211  ireq = ireq + 1
2212 
2213  else
2214  !--- non-periodic condition
2215  !--- From 4-Direction HALO communicate
2216  ! From S
2217  if ( prc_has_s ) then
2218  call mpi_irecv( var(:,js-jhalo:js-1), comm_size2d_ns4, &
2219  comm_datatype, prc_next(prc_s), tag+1, &
2220  comm_world, req_list(ireq,vid), ierr )
2221  ireq = ireq + 1
2222  endif
2223 
2224  ! From N
2225  if ( prc_has_n ) then
2226  call mpi_irecv( var(:,je+1:je+jhalo), comm_size2d_ns4, &
2227  comm_datatype, prc_next(prc_n), tag+2, &
2228  comm_world, req_list(ireq,vid), ierr )
2229  ireq = ireq + 1
2230  endif
2231 
2232  ! From E
2233  if ( prc_has_e ) then
2234  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we, &
2235  comm_datatype, prc_next(prc_e), tag+3, &
2236  comm_world, req_list(ireq,vid), ierr )
2237  ireq = ireq + 1
2238  endif
2239 
2240  ! From W
2241  if ( prc_has_w ) then
2242  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we, &
2243  comm_datatype, prc_next(prc_w), tag+4, &
2244  comm_world, req_list(ireq,vid), ierr )
2245  ireq = ireq + 1
2246  endif
2247 
2248  call pack_2d(var, vid)
2249 
2250  ! To W HALO communicate
2251  if ( prc_has_w ) then
2252  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we, &
2253  comm_datatype, prc_next(prc_w), tag+3, &
2254  comm_world, req_list(ireq,vid), ierr )
2255  ireq = ireq + 1
2256  endif
2257 
2258  ! To E HALO communicate
2259  if ( prc_has_e ) then
2260  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we, &
2261  comm_datatype, prc_next(prc_e), tag+4, &
2262  comm_world, req_list(ireq,vid), ierr )
2263  ireq = ireq + 1
2264  endif
2265 
2266  ! To N HALO communicate
2267  if ( prc_has_n ) then
2268  call mpi_isend( var(:,je-jhalo+1:je), comm_size2d_ns4, &
2269  comm_datatype, prc_next(prc_n), tag+1, &
2270  comm_world, req_list(ireq,vid), ierr )
2271  ireq = ireq + 1
2272  endif
2273 
2274  ! To S HALO communicate
2275  if ( prc_has_s ) then
2276  call mpi_isend( var(:,js:js+jhalo-1), comm_size2d_ns4, &
2277  comm_datatype, prc_next(prc_s), tag+2, &
2278  comm_world, req_list(ireq,vid), ierr )
2279  ireq = ireq + 1
2280  endif
2281 
2282  endif
2283 
2284  req_cnt(vid) = ireq - 1
2285 
2286  return
integer, public je
end point of inner domain: y, local
logical, public prc_has_n
subroutine, public prc_mpistop
Abort MPI.
logical, public prc_has_e
logical, public prc_has_s
integer, public jhalo
of halo cells: y
integer, public js
start point of inner domain: y, local
module PROCESS
logical, public prc_has_w
Here is the call graph for this function:
Here is the caller graph for this function:

◆ vars8_2d_mpi()

subroutine scale_comm::vars8_2d_mpi ( real(rp), dimension(:,:), intent(inout)  var,
integer, intent(in)  vid 
)

Definition at line 2290 of file scale_comm.F90.

References comm_datatype, comm_world, scale_grid_index::ie, scale_grid_index::ihalo, scale_grid_index::is, scale_grid_index::je, scale_grid_index::jhalo, scale_grid_index::js, scale_rm_process::prc_e, scale_rm_process::prc_has_e, scale_rm_process::prc_has_n, scale_rm_process::prc_has_s, scale_rm_process::prc_has_w, scale_process::prc_mpistop(), scale_rm_process::prc_n, scale_rm_process::prc_ne, scale_rm_process::prc_next, scale_rm_process::prc_nw, scale_rm_process::prc_s, scale_rm_process::prc_se, scale_rm_process::prc_sw, and scale_rm_process::prc_w.

Referenced by comm_vars8_init().

2290  use scale_process, only: &
2291  prc_mpistop
2292  implicit none
2293 
2294  real(RP), intent(inout) :: var(:,:)
2295  integer, intent(in) :: vid
2296 
2297  integer :: ireq, tag, tagc
2298 
2299  integer :: ierr
2300  integer :: j
2301  !---------------------------------------------------------------------------
2302 
2303  tag = vid * 100
2304  ireq = 1
2305 
2306 #ifdef DEBUG
2307  if ( use_packbuf(vid) ) then
2308  write(*,*) 'packing buffer is already used', vid
2309  call prc_mpistop
2310  end if
2311  use_packbuf(vid) = .true.
2312 #endif
2313 
2314  if ( comm_isallperiodic ) then
2315  !--- periodic condition
2316  !--- From 8-Direction HALO communicate
2317  ! From SE
2318  tagc = 0
2319  do j = js-jhalo, js-1
2320  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2321  comm_datatype, prc_next(prc_se), tag+tagc, &
2322  comm_world, req_list(ireq,vid), ierr )
2323  ireq = ireq + 1
2324  tagc = tagc + 1
2325  enddo
2326  ! From SW
2327  tagc = 10
2328  do j = js-jhalo, js-1
2329  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2330  comm_datatype, prc_next(prc_sw), tag+tagc, &
2331  comm_world, req_list(ireq,vid), ierr )
2332  ireq = ireq + 1
2333  tagc = tagc + 1
2334  enddo
2335  ! From NE
2336  tagc = 20
2337  do j = je+1, je+jhalo
2338  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2339  comm_datatype, prc_next(prc_ne), tag+tagc, &
2340  comm_world, req_list(ireq,vid), ierr )
2341  ireq = ireq + 1
2342  tagc = tagc + 1
2343  enddo
2344  ! From NW
2345  tagc = 30
2346  do j = je+1, je+jhalo
2347  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2348  comm_datatype, prc_next(prc_nw), tag+tagc, &
2349  comm_world, req_list(ireq,vid), ierr )
2350  ireq = ireq + 1
2351  tagc = tagc + 1
2352  enddo
2353  ! From S
2354  tagc = 40
2355  do j = js-jhalo, js-1
2356  call mpi_irecv( var(is,j), comm_size2d_ns8, &
2357  comm_datatype, prc_next(prc_s), tag+tagc, &
2358  comm_world, req_list(ireq,vid), ierr )
2359  ireq = ireq + 1
2360  tagc = tagc + 1
2361  enddo
2362  ! From N
2363  tagc = 50
2364  do j = je+1, je+jhalo
2365  call mpi_irecv( var(is,j), comm_size2d_ns8, &
2366  comm_datatype, prc_next(prc_n), tag+tagc, &
2367  comm_world, req_list(ireq,vid), ierr )
2368  ireq = ireq + 1
2369  tagc = tagc + 1
2370  enddo
2371  ! From E
2372  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we, &
2373  comm_datatype, prc_next(prc_e), tag+60, &
2374  comm_world, req_list(ireq,vid), ierr )
2375  ireq = ireq + 1
2376  ! From W
2377  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we, &
2378  comm_datatype, prc_next(prc_w), tag+70, &
2379  comm_world, req_list(ireq,vid), ierr )
2380  ireq = ireq + 1
2381 
2382  call pack_2d(var, vid)
2383 
2384  ! To W HALO communicate
2385  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we, &
2386  comm_datatype, prc_next(prc_w), tag+60, &
2387  comm_world, req_list(ireq,vid), ierr )
2388  ireq = ireq + 1
2389 
2390  ! To E HALO communicate
2391  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we, &
2392  comm_datatype, prc_next(prc_e), tag+70, &
2393  comm_world, req_list(ireq,vid), ierr )
2394  ireq = ireq + 1
2395 
2396  ! To N HALO communicate
2397  tagc = 40
2398  do j = je-jhalo+1, je
2399  call mpi_isend( var(is,j), comm_size2d_ns8, &
2400  comm_datatype, prc_next(prc_n), tag+tagc, &
2401  comm_world, req_list(ireq,vid), ierr )
2402  ireq = ireq + 1
2403  tagc = tagc + 1
2404  enddo
2405 
2406  ! To S HALO communicate
2407  tagc = 50
2408  do j = js, js+jhalo-1
2409  call mpi_isend( var(is,j), comm_size2d_ns8, &
2410  comm_datatype, prc_next(prc_s), tag+tagc, &
2411  comm_world, req_list(ireq,vid), ierr )
2412  ireq = ireq + 1
2413  tagc = tagc + 1
2414  enddo
2415 
2416  ! To NW HALO communicate
2417  tagc = 0
2418  do j = je-jhalo+1, je
2419  call mpi_isend( var(is,j), comm_size2d_4c, &
2420  comm_datatype, prc_next(prc_nw), tag+tagc, &
2421  comm_world, req_list(ireq,vid), ierr )
2422  ireq = ireq + 1
2423  tagc = tagc + 1
2424  enddo
2425 
2426  ! To NE HALO communicate
2427  tagc = 10
2428  do j = je-jhalo+1, je
2429  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2430  comm_datatype, prc_next(prc_ne), tag+tagc, &
2431  comm_world, req_list(ireq,vid), ierr )
2432  ireq = ireq + 1
2433  tagc = tagc + 1
2434  enddo
2435 
2436  ! To SW HALO communicate
2437  tagc = 20
2438  do j = js, js+jhalo-1
2439  call mpi_isend( var(is,j), comm_size2d_4c, &
2440  comm_datatype, prc_next(prc_sw), tag+tagc, &
2441  comm_world, req_list(ireq,vid), ierr )
2442  ireq = ireq + 1
2443  tagc = tagc + 1
2444  enddo
2445 
2446  ! To SE HALO communicate
2447  tagc = 30
2448  do j = js, js+jhalo-1
2449  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2450  comm_datatype, prc_next(prc_se), tag+tagc, &
2451  comm_world, req_list(ireq,vid), ierr )
2452  ireq = ireq + 1
2453  tagc = tagc + 1
2454  enddo
2455  else
2456  !--- non-periodic condition
2457  !--- From 8-Direction HALO communicate
2458  ! From SE
2459  if ( prc_has_s .AND. prc_has_e ) then
2460  tagc = 0
2461  do j = js-jhalo, js-1
2462  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2463  comm_datatype, prc_next(prc_se), tag+tagc, &
2464  comm_world, req_list(ireq,vid), ierr )
2465  ireq = ireq + 1
2466  tagc = tagc + 1
2467  enddo
2468  else if ( prc_has_s ) then
2469  tagc = 0
2470  do j = js-jhalo, js-1
2471  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2472  comm_datatype, prc_next(prc_s), tag+tagc, &
2473  comm_world, req_list(ireq,vid), ierr )
2474  ireq = ireq + 1
2475  tagc = tagc + 1
2476  enddo
2477  else if ( prc_has_e ) then
2478  tagc = 0
2479  do j = js-jhalo, js-1
2480  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2481  comm_datatype, prc_next(prc_e), tag+tagc, &
2482  comm_world, req_list(ireq,vid), ierr )
2483  ireq = ireq + 1
2484  tagc = tagc + 1
2485  enddo
2486  endif
2487 
2488  ! From SW
2489  if ( prc_has_s .AND. prc_has_w ) then
2490  tagc = 10
2491  do j = js-jhalo, js-1
2492  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2493  comm_datatype, prc_next(prc_sw), tag+tagc, &
2494  comm_world, req_list(ireq,vid), ierr )
2495  ireq = ireq + 1
2496  tagc = tagc + 1
2497  enddo
2498  else if ( prc_has_s ) then
2499  tagc = 10
2500  do j = js-jhalo, js-1
2501  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2502  comm_datatype, prc_next(prc_s), tag+tagc, &
2503  comm_world, req_list(ireq,vid), ierr )
2504  ireq = ireq + 1
2505  tagc = tagc + 1
2506  enddo
2507  else if ( prc_has_w ) then
2508  tagc = 10
2509  do j = js-jhalo, js-1
2510  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2511  comm_datatype, prc_next(prc_w), tag+tagc, &
2512  comm_world, req_list(ireq,vid), ierr )
2513  ireq = ireq + 1
2514  tagc = tagc + 1
2515  enddo
2516  endif
2517 
2518  ! From NE
2519  if ( prc_has_n .AND. prc_has_e ) then
2520  tagc = 20
2521  do j = je+1, je+jhalo
2522  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2523  comm_datatype, prc_next(prc_ne), tag+tagc, &
2524  comm_world, req_list(ireq,vid), ierr )
2525  ireq = ireq + 1
2526  tagc = tagc + 1
2527  enddo
2528  else if ( prc_has_n ) then
2529  tagc = 20
2530  do j = je+1, je+jhalo
2531  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2532  comm_datatype, prc_next(prc_n), tag+tagc, &
2533  comm_world, req_list(ireq,vid), ierr )
2534  ireq = ireq + 1
2535  tagc = tagc + 1
2536  enddo
2537  else if ( prc_has_e ) then
2538  tagc = 20
2539  do j = je+1, je+jhalo
2540  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2541  comm_datatype, prc_next(prc_e), tag+tagc, &
2542  comm_world, req_list(ireq,vid), ierr )
2543  ireq = ireq + 1
2544  tagc = tagc + 1
2545  enddo
2546  endif
2547 
2548  ! From NW
2549  if ( prc_has_n .AND. prc_has_w ) then
2550  tagc = 30
2551  do j = je+1, je+jhalo
2552  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2553  comm_datatype, prc_next(prc_nw), tag+tagc, &
2554  comm_world, req_list(ireq,vid), ierr )
2555  ireq = ireq + 1
2556  tagc = tagc + 1
2557  enddo
2558  else if ( prc_has_n ) then
2559  tagc = 30
2560  do j = je+1, je+jhalo
2561  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2562  comm_datatype, prc_next(prc_n), tag+tagc, &
2563  comm_world, req_list(ireq,vid), ierr )
2564  ireq = ireq + 1
2565  tagc = tagc + 1
2566  enddo
2567  else if ( prc_has_w ) then
2568  tagc = 30
2569  do j = je+1, je+jhalo
2570  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2571  comm_datatype, prc_next(prc_w), tag+tagc, &
2572  comm_world, req_list(ireq,vid), ierr )
2573  ireq = ireq + 1
2574  tagc = tagc + 1
2575  enddo
2576  endif
2577 
2578  ! From S
2579  if ( prc_has_s ) then
2580  tagc = 40
2581  do j = js-jhalo, js-1
2582  call mpi_irecv( var(is,j), comm_size2d_ns8, &
2583  comm_datatype, prc_next(prc_s), tag+tagc, &
2584  comm_world, req_list(ireq,vid), ierr )
2585  ireq = ireq + 1
2586  tagc = tagc + 1
2587  enddo
2588  endif
2589 
2590  ! From N
2591  if ( prc_has_n ) then
2592  tagc = 50
2593  do j = je+1, je+jhalo
2594  call mpi_irecv( var(is,j), comm_size2d_ns8, &
2595  comm_datatype, prc_next(prc_n), tag+tagc, &
2596  comm_world, req_list(ireq,vid), ierr )
2597  ireq = ireq + 1
2598  tagc = tagc + 1
2599  enddo
2600  endif
2601 
2602  ! From E
2603  if ( prc_has_e ) then
2604  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we, &
2605  comm_datatype, prc_next(prc_e), tag+60, &
2606  comm_world, req_list(ireq,vid), ierr )
2607  ireq = ireq + 1
2608  endif
2609 
2610  ! From W
2611  if ( prc_has_w ) then
2612  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we, &
2613  comm_datatype, prc_next(prc_w), tag+70, &
2614  comm_world, req_list(ireq,vid), ierr )
2615  ireq = ireq + 1
2616  endif
2617 
2618  call pack_2d(var, vid)
2619 
2620  ! To W HALO communicate
2621  if ( prc_has_w ) then
2622  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we, &
2623  comm_datatype, prc_next(prc_w), tag+60, &
2624  comm_world, req_list(ireq,vid), ierr )
2625  ireq = ireq + 1
2626  endif
2627 
2628  ! To E HALO communicate
2629  if ( prc_has_e ) then
2630  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we, &
2631  comm_datatype, prc_next(prc_e), tag+70, &
2632  comm_world, req_list(ireq,vid), ierr )
2633  ireq = ireq + 1
2634  endif
2635 
2636  ! To N HALO communicate
2637  if ( prc_has_n ) then
2638  tagc = 40
2639  do j = je-jhalo+1, je
2640  call mpi_isend( var(is,j), comm_size2d_ns8, &
2641  comm_datatype, prc_next(prc_n), tag+tagc, &
2642  comm_world, req_list(ireq,vid), ierr )
2643  ireq = ireq + 1
2644  tagc = tagc + 1
2645  enddo
2646  endif
2647 
2648  ! To S HALO communicate
2649  if ( prc_has_s ) then
2650  tagc = 50
2651  do j = js, js+jhalo-1
2652  call mpi_isend( var(is,j), comm_size2d_ns8, &
2653  comm_datatype, prc_next(prc_s), tag+tagc, &
2654  comm_world, req_list(ireq,vid), ierr )
2655  ireq = ireq + 1
2656  tagc = tagc + 1
2657  enddo
2658  endif
2659 
2660  ! To NW HALO communicate
2661  if ( prc_has_n .AND. prc_has_w ) then
2662  tagc = 0
2663  do j = je-jhalo+1, je
2664  call mpi_isend( var(is,j), comm_size2d_4c, &
2665  comm_datatype, prc_next(prc_nw), tag+tagc, &
2666  comm_world, req_list(ireq,vid), ierr )
2667  ireq = ireq + 1
2668  tagc = tagc + 1
2669  enddo
2670  else if ( prc_has_n ) then
2671  tagc = 10
2672  do j = je-jhalo+1, je
2673  call mpi_isend( var(is,j), comm_size2d_4c, &
2674  comm_datatype, prc_next(prc_n), tag+tagc, &
2675  comm_world, req_list(ireq,vid), ierr )
2676  ireq = ireq + 1
2677  tagc = tagc + 1
2678  enddo
2679  else if ( prc_has_w ) then
2680  tagc = 20
2681  do j = je-jhalo+1, je
2682  call mpi_isend( var(is,j), comm_size2d_4c, &
2683  comm_datatype, prc_next(prc_w), tag+tagc, &
2684  comm_world, req_list(ireq,vid), ierr )
2685  ireq = ireq + 1
2686  tagc = tagc + 1
2687  enddo
2688  endif
2689 
2690  ! To NE HALO communicate
2691  if ( prc_has_n .AND. prc_has_e ) then
2692  tagc = 10
2693  do j = je-jhalo+1, je
2694  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2695  comm_datatype, prc_next(prc_ne), tag+tagc, &
2696  comm_world, req_list(ireq,vid), ierr )
2697  ireq = ireq + 1
2698  tagc = tagc + 1
2699  enddo
2700  else if ( prc_has_n ) then
2701  tagc = 0
2702  do j = je-jhalo+1, je
2703  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2704  comm_datatype, prc_next(prc_n), tag+tagc, &
2705  comm_world, req_list(ireq,vid), ierr )
2706  ireq = ireq + 1
2707  tagc = tagc + 1
2708  enddo
2709  else if ( prc_has_e ) then
2710  tagc = 30
2711  do j = je-jhalo+1, je
2712  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2713  comm_datatype, prc_next(prc_e), tag+tagc, &
2714  comm_world, req_list(ireq,vid), ierr )
2715  ireq = ireq + 1
2716  tagc = tagc + 1
2717  enddo
2718  endif
2719 
2720  ! To SW HALO communicate
2721  if ( prc_has_s .AND. prc_has_w ) then
2722  tagc = 20
2723  do j = js, js+jhalo-1
2724  call mpi_isend( var(is,j), comm_size2d_4c, &
2725  comm_datatype, prc_next(prc_sw), tag+tagc, &
2726  comm_world, req_list(ireq,vid), ierr )
2727  ireq = ireq + 1
2728  tagc = tagc + 1
2729  enddo
2730  else if ( prc_has_s ) then
2731  tagc = 30
2732  do j = js, js+jhalo-1
2733  call mpi_isend( var(is,j), comm_size2d_4c, &
2734  comm_datatype, prc_next(prc_s), tag+tagc, &
2735  comm_world, req_list(ireq,vid), ierr )
2736  ireq = ireq + 1
2737  tagc = tagc + 1
2738  enddo
2739  else if ( prc_has_w ) then
2740  tagc = 0
2741  do j = js, js+jhalo-1
2742  call mpi_isend( var(is,j), comm_size2d_4c, &
2743  comm_datatype, prc_next(prc_w), tag+tagc, &
2744  comm_world, req_list(ireq,vid), ierr )
2745  ireq = ireq + 1
2746  tagc = tagc + 1
2747  enddo
2748  endif
2749 
2750  ! To SE HALO communicate
2751  if ( prc_has_s .AND. prc_has_e ) then
2752  tagc = 30
2753  do j = js, js+jhalo-1
2754  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2755  comm_datatype, prc_next(prc_se), tag+tagc, &
2756  comm_world, req_list(ireq,vid), ierr )
2757  ireq = ireq + 1
2758  tagc = tagc + 1
2759  enddo
2760  else if ( prc_has_s ) then
2761  tagc = 20
2762  do j = js, js+jhalo-1
2763  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2764  comm_datatype, prc_next(prc_s), tag+tagc, &
2765  comm_world, req_list(ireq,vid), ierr )
2766  ireq = ireq + 1
2767  tagc = tagc + 1
2768  enddo
2769  else if ( prc_has_e ) then
2770  tagc = 10
2771  do j = js, js+jhalo-1
2772  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2773  comm_datatype, prc_next(prc_e), tag+tagc, &
2774  comm_world, req_list(ireq,vid), ierr )
2775  ireq = ireq + 1
2776  tagc = tagc + 1
2777  enddo
2778  endif
2779 
2780  endif
2781 
2782  req_cnt(vid) = ireq - 1
2783 
2784  return
integer, public is
start point of inner domain: x, local
integer, public je
end point of inner domain: y, local
logical, public prc_has_n
subroutine, public prc_mpistop
Abort MPI.
logical, public prc_has_e
logical, public prc_has_s
integer, public jhalo
of halo cells: y
integer, public js
start point of inner domain: y, local
module PROCESS
integer, public ie
end point of inner domain: x, local
logical, public prc_has_w
integer, public ihalo
of halo cells: x
Here is the call graph for this function:
Here is the caller graph for this function:

◆ vars_3d_mpi_pc()

subroutine scale_comm::vars_3d_mpi_pc ( real(rp), dimension(:,:,:), intent(inout)  var,
integer, intent(in)  vid 
)

Definition at line 2788 of file scale_comm.F90.

References scale_process::prc_mpistop().

Referenced by comm_vars8_init().

2788  use scale_process, only: &
2789  prc_mpistop
2790  implicit none
2791 
2792  real(RP), intent(inout) :: var(:,:,:)
2793  integer, intent(in) :: vid
2794  integer :: ierr
2795  !---------------------------------------------------------------------------
2796 
2797 #ifdef DEBUG
2798  if ( use_packbuf(pseqid(vid)) ) then
2799  write(*,*) 'packing buffer is already used', vid, pseqid(vid)
2800  call prc_mpistop
2801  end if
2802  use_packbuf(pseqid(vid)) = .true.
2803 #endif
2804 
2805  call pack_3d(var, pseqid(vid))
2806 
2807  call mpi_startall(preq_cnt(vid), preq_list(1:preq_cnt(vid),vid), ierr)
2808 
2809  return
subroutine, public prc_mpistop
Abort MPI.
module PROCESS
Here is the call graph for this function:
Here is the caller graph for this function:

◆ wait_3d_mpi()

subroutine scale_comm::wait_3d_mpi ( real(rp), dimension(:,:,:), intent(inout)  var,
integer, intent(in)  vid 
)

Definition at line 2813 of file scale_comm.F90.

References scale_grid_index::ie, scale_grid_index::ihalo, scale_grid_index::is, scale_grid_index::je, scale_grid_index::jhalo, scale_grid_index::js, scale_rm_process::prc_has_e, scale_rm_process::prc_has_n, scale_rm_process::prc_has_s, scale_rm_process::prc_has_w, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Referenced by comm_vars8_init().

2813  implicit none
2814  real(RP), intent(inout) :: var(:,:,:)
2815  integer, intent(in) :: vid
2816 
2817  integer :: ierr
2818  !---------------------------------------------------------------------------
2819 
2820  !--- wait packets
2821  call mpi_waitall( req_cnt(vid), &
2822  req_list(1:req_cnt(vid),vid), &
2823  mpi_statuses_ignore, &
2824  ierr )
2825  call unpack_3d(var, vid)
2826 
2827 #ifdef DEBUG
2828  use_packbuf(vid) = .false.
2829 #endif
2830 
2831  return
Here is the call graph for this function:
Here is the caller graph for this function:

◆ comm_cleanup()

subroutine, public scale_comm::comm_cleanup ( )

Definition at line 3465 of file scale_comm.F90.

Referenced by mod_rm_driver::scalerm().

3465  use mpi
3466  implicit none
3467 
3468  namelist / param_comm / &
3469  comm_vsize_max_pc, &
3470  comm_use_mpi_pc
3471 
3472  integer :: i, j, ierr
3473  !---------------------------------------------------------------------------
3474 
3475  deallocate( recvpack_w2p )
3476  deallocate( recvpack_e2p )
3477  deallocate( sendpack_p2w )
3478  deallocate( sendpack_p2e )
3479 #ifdef DEBUG
3480  deallocate( use_packbuf )
3481 #endif
3482 
3483  deallocate( req_cnt )
3484  deallocate( req_list )
3485 
3486  if ( comm_use_mpi_pc ) then
3487  do j=1, comm_vsize_max_pc
3488  do i=1, comm_nreq_max+1
3489  if (preq_list(i,j) .NE. mpi_request_null) &
3490  call mpi_request_free(preq_list(i,j), ierr)
3491  enddo
3492  enddo
3493  deallocate( preq_cnt )
3494  deallocate( preq_list )
3495  deallocate( pseqid )
3496  end if
Here is the caller graph for this function:

Variable Documentation

◆ comm_datatype

integer, public scale_comm::comm_datatype

◆ comm_world

integer, public scale_comm::comm_world

◆ comm_fill_bnd

logical, public scale_comm::comm_fill_bnd = .true.

switch whether fill boundary data

Definition at line 119 of file scale_comm.F90.

Referenced by scale_atmos_boundary::atmos_boundary_setup().

119  logical, public :: COMM_FILL_BND = .true.