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 (var, vid)
 Register variables. More...
 
subroutine, public comm_vars8_init (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::ie, scale_grid_index::ihalo, scale_grid_index::imax, scale_stdio::io_fid_conf, scale_grid_index::is, scale_grid_index::ja, scale_grid_index::je, scale_grid_index::jhalo, scale_grid_index::jmax, scale_grid_index::js, scale_grid_index::ka, 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_local_comm_world, scale_rm_process::prc_n, scale_rm_process::prc_next, scale_rm_process::prc_s, scale_rm_process::prc_w, scale_tracer::qa, and scale_precision::rp.

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

165  use scale_stdio, only: &
166  io_fid_conf
167  use scale_process, only: &
168  prc_local_comm_world
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_lnml ) write(io_fid_log,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 #ifdef _USE_RDMA
254  call rdma_setup( comm_vsize_max_pc, &
255  ia, &
256  ja, &
257  ka, &
258  ihalo, &
259  jhalo, &
260  is, &
261  ie, &
262  js, &
263  je, &
264  prc_next(prc_w), &
265  prc_next(prc_n), &
266  prc_next(prc_e), &
267  prc_next(prc_s) )
268 #endif
269 
270  if( io_l ) write(io_fid_log,*)
271  if( io_l ) write(io_fid_log,*) '*** Maximum number of vars for one communication: ', &
272  comm_vsize_max
273  if( io_l ) write(io_fid_log,*) '*** Data size of var (3D,including halo) [byte] : ', &
274  rp*ka*ia*ja
275  if( io_l ) write(io_fid_log,*) '*** Data size of halo [byte] : ', &
276  rp*ka*(2*ia*jhalo+2*jmax*ihalo)
277  if( io_l ) write(io_fid_log,*) '*** Ratio of halo against the whole 3D grid : ', &
278  real(2*IA*JHALO+2*JMAX*IHALO) / real(ia*ja)
279  if( io_l ) write(io_fid_log,*)
280  if( io_l ) write(io_fid_log,*) '*** All side is periodic?: ', comm_isallperiodic
281 
282  return
scale_grid_index::imax
integer, public imax
of computational cells: x
Definition: scale_grid_index.F90:44
scale_grid_index::is
integer, public is
start point of inner domain: x, local
Definition: scale_grid_index.F90:60
scale_grid_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_grid_index.F90:63
scale_rm_process::prc_has_n
logical, public prc_has_n
Definition: scale_rm_process.F90:50
scale_process::prc_local_comm_world
integer, public prc_local_comm_world
local communicator
Definition: scale_process.F90:76
scale_rm_process::prc_has_e
logical, public prc_has_e
Definition: scale_rm_process.F90:51
scale_stdio
module STDIO
Definition: scale_stdio.F90:12
scale_tracer::qa
integer, public qa
Definition: scale_tracer.F90:44
scale_rm_process::prc_has_s
logical, public prc_has_s
Definition: scale_rm_process.F90:52
scale_grid_index::ia
integer, public ia
of x whole cells (local, with HALO)
Definition: scale_grid_index.F90:55
scale_grid_index::ka
integer, public ka
of z whole cells (local, with HALO)
Definition: scale_grid_index.F90:54
scale_grid_index::jhalo
integer, public jhalo
of halo cells: y
Definition: scale_grid_index.F90:52
scale_grid_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_grid_index.F90:62
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_grid_index::ie
integer, public ie
end point of inner domain: x, local
Definition: scale_grid_index.F90:61
scale_stdio::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_stdio.F90:55
scale_rm_process::prc_has_w
logical, public prc_has_w
Definition: scale_rm_process.F90:49
scale_precision::rp
integer, parameter, public rp
Definition: scale_precision.F90:38
scale_grid_index::jmax
integer, public jmax
of computational cells: y
Definition: scale_grid_index.F90:45
scale_grid_index::ihalo
integer, public ihalo
of halo cells: x
Definition: scale_grid_index.F90:51
scale_grid_index::ja
integer, public ja
of y whole cells (local, with HALO)
Definition: scale_grid_index.F90:56
Here is the caller graph for this function:

◆ comm_vars_init()

subroutine, public scale_comm::comm_vars_init ( real(rp), dimension(:,:,:), intent(inout)  var,
integer, intent(inout)  vid 
)

Register variables.

Parameters
[in,out]varvariable for register
[in,out]vidvariable ID

Definition at line 288 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().

288  implicit none
289 
290  real(RP), intent(inout) :: var(:,:,:)
291  integer, intent(inout) :: vid
292  !---------------------------------------------------------------------------
293 
294  if ( vid > comm_vsize_max ) then
295  write(*,*) 'xxx vid exceeds max', vid, comm_vsize_max
296  call prc_mpistop
297  end if
298 
299  if ( comm_use_mpi_pc ) then
300 
301  comm_vars_id = comm_vars_id + 1
302  if ( comm_vars_id > comm_vsize_max_pc ) then
303  write(*,*) 'xxx number of variable for MPI PC exceeds max', comm_vars_id, comm_vsize_max_pc
304  call prc_mpistop
305  end if
306 
307 #ifdef _USE_RDMA
308  call prof_rapstart('COMM_init_RDMA', 2)
309  call set_rdma_variable(var, comm_vars_id-1)
310  call prof_rapend ('COMM_init_RDMA', 2)
311 #else
312  call prof_rapstart('COMM_init_pers', 2)
313  call vars_init_mpi_pc(var, comm_vars_id, vid)
314  call prof_rapend ('COMM_init_pers', 2)
315 #endif
316 
317  vid = comm_vars_id + comm_vsize_max
318  if( io_l ) write(io_fid_log,*) '*** COMM: set variable ID:', vid
319 
320  end if
321 
322  return
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:132
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
Definition: scale_prof.F90:178
Here is the call graph for this function:

◆ comm_vars8_init()

subroutine, public scale_comm::comm_vars8_init ( real(rp), dimension(:,:,:), intent(inout)  var,
integer, intent(inout)  vid 
)

Register variables.

Parameters
[in,out]varvariable for register
[in,out]vidvariable ID

Definition at line 328 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_large_rk3::atmos_dyn_tinteg_large_rk3_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_euler::atmos_dyn_tinteg_tracer_euler_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().

328  implicit none
329 
330  real(RP), intent(inout) :: var(:,:,:)
331  integer, intent(inout) :: vid
332  !---------------------------------------------------------------------------
333 
334  if ( vid > comm_vsize_max ) then
335  write(*,*) 'xxx vid exceeds max', vid, comm_vsize_max
336  call prc_mpistop
337  end if
338 
339  if ( comm_use_mpi_pc ) then
340 
341  comm_vars_id = comm_vars_id + 1
342  if ( comm_vars_id > comm_vsize_max_pc ) then
343  write(*,*) 'xxx number of variable for MPI PC exceeds max', comm_vars_id, comm_vsize_max_pc
344  call prc_mpistop
345  end if
346 
347 #ifdef _USE_RDMA
348  call prof_rapstart('COMM_init_RDMA', 2)
349  call set_rdma_variable(var, comm_vars_id-1)
350  call prof_rapend ('COMM_init_RDMA', 2)
351 #else
352  call prof_rapstart('COMM_init_pers', 2)
353  call vars8_init_mpi_pc(var, comm_vars_id, vid)
354  call prof_rapend ('COMM_init_pers', 2)
355 #endif
356 
357  vid = comm_vars_id + comm_vsize_max
358  if( io_l ) write(io_fid_log,*) '*** COMM: set variable ID:', vid
359 
360  end if
361 
362  return
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:132
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
Definition: scale_prof.F90:178
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 516 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().

516  use scale_const, only: &
517  const_undef
518  implicit none
519 
520  real(RP), intent(out) :: varmean(ka)
521  real(RP), intent(in) :: var (ka,ia,ja)
522 
523  real(RP) :: statval (ka)
524  real(RP) :: statcnt (ka)
525  real(RP) :: allstatval(ka)
526  real(RP) :: allstatcnt(ka)
527  real(RP) :: zerosw
528 
529  integer :: ierr
530  integer :: k, i, j
531  !---------------------------------------------------------------------------
532 
533  statval(:) = 0.0_rp
534  statcnt(:) = 0.0_rp
535  do j = js, je
536  do i = is, ie
537  do k = 1, ka
538  if ( abs(var(k,i,j)) < abs(const_undef) ) then
539  statval(k) = statval(k) + var(k,i,j)
540  statcnt(k) = statcnt(k) + 1.d0
541  endif
542  enddo
543  enddo
544  enddo
545 
546  ! [NOTE] always communicate globally
547  call prof_rapstart('COMM_Allreduce', 2)
548  ! All reduce
549  call mpi_allreduce( statval(1), &
550  allstatval(1), &
551  ka, &
552  comm_datatype, &
553  mpi_sum, &
554  comm_world, &
555  ierr )
556  ! All reduce
557  call mpi_allreduce( statcnt(1), &
558  allstatcnt(1), &
559  ka, &
560  comm_datatype, &
561  mpi_sum, &
562  comm_world, &
563  ierr )
564 
565  call prof_rapend ('COMM_Allreduce', 2)
566 
567  do k = 1, ka
568  zerosw = 0.5_rp - sign(0.5_rp, allstatcnt(k) - 1.e-12_rp )
569  varmean(k) = allstatval(k) / ( allstatcnt(k) + zerosw ) * ( 1.0_rp - zerosw )
570  !if( IO_L ) write(IO_FID_LOG,*) k, varmean(k), allstatval(k), allstatcnt(k)
571  enddo
572 
573  return
scale_grid_index::is
integer, public is
start point of inner domain: x, local
Definition: scale_grid_index.F90:60
scale_grid_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_grid_index.F90:63
scale_const::const_undef
real(rp), public const_undef
Definition: scale_const.F90:43
scale_grid_index::ia
integer, public ia
of x whole cells (local, with HALO)
Definition: scale_grid_index.F90:55
scale_grid_index::ka
integer, public ka
of z whole cells (local, with HALO)
Definition: scale_grid_index.F90:54
scale_grid_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_grid_index.F90:62
scale_const
module CONSTANT
Definition: scale_const.F90:14
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:132
scale_grid_index::ie
integer, public ie
end point of inner domain: x, local
Definition: scale_grid_index.F90:61
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
Definition: scale_prof.F90:178
scale_grid_index::ja
integer, public ja
of y whole cells (local, with HALO)
Definition: scale_grid_index.F90:56
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 579 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::ka, scale_grid_index::ke, scale_grid_index::ks, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

579  implicit none
580 
581  real(RP), intent(out) :: varmax
582  real(RP), intent(in) :: var(ia,ja)
583 
584  real(RP) :: statval
585  real(RP) :: allstatval
586 
587  integer :: ierr
588  !---------------------------------------------------------------------------
589 
590  statval = maxval(var(is:ie,js:je))
591 
592  ! [NOTE] always communicate globally
593  call prof_rapstart('COMM_Allreduce', 2)
594  ! All reduce
595  call mpi_allreduce( statval, &
596  allstatval, &
597  1, &
598  comm_datatype, &
599  mpi_max, &
600  comm_world, &
601  ierr )
602 
603  call prof_rapend ('COMM_Allreduce', 2)
604 
605  varmax = allstatval
606 
607  return
scale_grid_index::is
integer, public is
start point of inner domain: x, local
Definition: scale_grid_index.F90:60
scale_grid_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_grid_index.F90:63
scale_grid_index::ia
integer, public ia
of x whole cells (local, with HALO)
Definition: scale_grid_index.F90:55
scale_grid_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_grid_index.F90:62
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:132
scale_grid_index::ie
integer, public ie
end point of inner domain: x, local
Definition: scale_grid_index.F90:61
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
Definition: scale_prof.F90:178
scale_grid_index::ja
integer, public ja
of y whole cells (local, with HALO)
Definition: scale_grid_index.F90:56
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 657 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::ka, scale_grid_index::ke, scale_grid_index::ks, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

657  implicit none
658 
659  real(RP), intent(out) :: varmin
660  real(RP), intent(in) :: var(ia,ja)
661 
662  real(RP) :: statval
663  real(RP) :: allstatval
664 
665  integer :: ierr
666  !---------------------------------------------------------------------------
667 
668  statval = minval(var(is:ie,js:je))
669 
670  ! [NOTE] always communicate globally
671  call prof_rapstart('COMM_Allreduce', 2)
672  ! All reduce
673  call mpi_allreduce( statval, &
674  allstatval, &
675  1, &
676  comm_datatype, &
677  mpi_min, &
678  comm_world, &
679  ierr )
680 
681  call prof_rapend ('COMM_Allreduce', 2)
682 
683  varmin = allstatval
684 
685  return
scale_grid_index::is
integer, public is
start point of inner domain: x, local
Definition: scale_grid_index.F90:60
scale_grid_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_grid_index.F90:63
scale_grid_index::ia
integer, public ia
of x whole cells (local, with HALO)
Definition: scale_grid_index.F90:55
scale_grid_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_grid_index.F90:62
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:132
scale_grid_index::ie
integer, public ie
end point of inner domain: x, local
Definition: scale_grid_index.F90:61
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
Definition: scale_prof.F90:178
scale_grid_index::ja
integer, public ja
of y whole cells (local, with HALO)
Definition: scale_grid_index.F90:56
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 735 of file scale_comm.F90.

References comm_datatype, comm_world, and scale_process::prc_masterrank.

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

◆ 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 767 of file scale_comm.F90.

References comm_datatype, comm_world, and scale_process::prc_masterrank.

767  use scale_process, only: &
768  prc_masterrank
769  implicit none
770 
771  real(RP), intent(out) :: recv(:,:,:)
772  real(RP), intent(in) :: send(:,:,:)
773  integer, intent(in) :: gia
774  integer, intent(in) :: gja
775  integer, intent(in) :: gka
776 
777  integer :: sendcounts, recvcounts
778  integer :: ierr
779  !---------------------------------------------------------------------------
780 
781  sendcounts = gia * gja * gka
782  recvcounts = gia * gja * gka
783 
784  call mpi_gather( send(:,:,:), &
785  sendcounts, &
786  comm_datatype, &
787  recv(:,:,:), &
788  recvcounts, &
789  comm_datatype, &
790  prc_masterrank, &
791  comm_world, &
792  ierr )
793 
794  return
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_process::prc_masterrank
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_process.F90:56

◆ 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 800 of file scale_comm.F90.

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

800  use scale_process, only: &
801  prc_masterrank
802  implicit none
803 
804  real(RP), intent(inout) :: var
805 
806  integer :: counts
807  integer :: ierr
808  !---------------------------------------------------------------------------
809 
810  call prof_rapstart('COMM_Bcast', 2)
811 
812  counts = 1
813 
814  call mpi_bcast( var, &
815  counts, &
816  comm_datatype, &
817  prc_masterrank, &
818  comm_world, &
819  ierr )
820 
821  call prof_rapend('COMM_Bcast', 2)
822 
823  return
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_process::prc_masterrank
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_process.F90:56
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:132
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
Definition: scale_prof.F90:178
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 829 of file scale_comm.F90.

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

829  use scale_process, only: &
830  prc_masterrank
831  implicit none
832 
833  real(RP), intent(inout) :: var(:)
834  integer, intent(in) :: gia
835 
836  integer :: counts
837  integer :: ierr
838  !---------------------------------------------------------------------------
839 
840  call prof_rapstart('COMM_Bcast', 2)
841 
842  counts = gia
843 
844  call mpi_bcast( var(:), &
845  counts, &
846  comm_datatype, &
847  prc_masterrank, &
848  comm_world, &
849  ierr )
850 
851  call prof_rapend('COMM_Bcast', 2)
852 
853  return
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_process::prc_masterrank
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_process.F90:56
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:132
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
Definition: scale_prof.F90:178
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 859 of file scale_comm.F90.

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

859  use scale_process, only: &
860  prc_masterrank
861  implicit none
862 
863  real(RP), intent(inout) :: var(:,:)
864  integer, intent(in) :: gia
865  integer, intent(in) :: gja
866 
867  integer :: counts
868  integer :: ierr
869  !---------------------------------------------------------------------------
870 
871  call prof_rapstart('COMM_Bcast', 2)
872 
873  counts = gia * gja
874 
875  call mpi_bcast( var(:,:), &
876  counts, &
877  comm_datatype, &
878  prc_masterrank, &
879  comm_world, &
880  ierr )
881 
882  call prof_rapend('COMM_Bcast', 2)
883 
884  return
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_process::prc_masterrank
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_process.F90:56
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:132
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
Definition: scale_prof.F90:178
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 890 of file scale_comm.F90.

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

890  use scale_process, only: &
891  prc_masterrank
892  implicit none
893 
894  real(RP), intent(inout) :: var(:,:,:)
895  integer, intent(in) :: gia
896  integer, intent(in) :: gja
897  integer, intent(in) :: gka
898 
899  integer :: counts
900  integer :: ierr
901  !---------------------------------------------------------------------------
902 
903  call prof_rapstart('COMM_Bcast', 2)
904 
905  counts = gia * gja * gka
906 
907  call mpi_bcast( var(:,:,:), &
908  counts, &
909  comm_datatype, &
910  prc_masterrank, &
911  comm_world, &
912  ierr )
913 
914  call prof_rapend('COMM_Bcast', 2)
915 
916  return
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_process::prc_masterrank
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_process.F90:56
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:132
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
Definition: scale_prof.F90:178
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 922 of file scale_comm.F90.

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

922  use scale_process, only: &
923  prc_masterrank
924  implicit none
925 
926  real(RP), intent(inout) :: var(:,:,:,:)
927  integer, intent(in) :: gia
928  integer, intent(in) :: gja
929  integer, intent(in) :: gka
930  integer, intent(in) :: gtime
931 
932  integer :: counts
933  integer :: ierr
934  !---------------------------------------------------------------------------
935 
936  call prof_rapstart('COMM_Bcast', 2)
937 
938  counts = gia * gja * gka * gtime
939  if ( gia>0 .AND. gja>0 .AND. gka>0 .AND. gtime>0 .AND. &
940  counts < 0 ) then
941  write(*,*) 'xxx counts overflow'
942  call prc_mpistop
943  end if
944 
945  call mpi_bcast( var(:,:,:,:), &
946  counts, &
947  comm_datatype, &
948  prc_masterrank, &
949  comm_world, &
950  ierr )
951 
952  call prof_rapend('COMM_Bcast', 2)
953 
954  return
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_process::prc_masterrank
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_process.F90:56
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:132
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
Definition: scale_prof.F90:178
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 960 of file scale_comm.F90.

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

960  use scale_process, only: &
961  prc_masterrank
962  implicit none
963 
964  integer, intent(inout) :: var
965 
966  integer :: counts
967  integer :: ierr
968  !---------------------------------------------------------------------------
969 
970  call prof_rapstart('COMM_Bcast', 2)
971 
972  counts = 1
973 
974  call mpi_bcast( var, &
975  counts, &
976  mpi_integer, &
977  prc_masterrank, &
978  comm_world, &
979  ierr )
980 
981  call prof_rapend('COMM_Bcast', 2)
982 
983  return
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_process::prc_masterrank
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_process.F90:56
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:132
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
Definition: scale_prof.F90:178
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 989 of file scale_comm.F90.

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

989  use scale_process, only: &
990  prc_masterrank
991  implicit none
992 
993  integer, intent(inout) :: var(:)
994  integer, intent(in) :: gia
995 
996  integer :: counts
997  integer :: ierr
998  !---------------------------------------------------------------------------
999 
1000  call prof_rapstart('COMM_Bcast', 2)
1001 
1002  counts = gia
1003 
1004  call mpi_bcast( var(:), &
1005  counts, &
1006  mpi_integer, &
1007  prc_masterrank, &
1008  comm_world, &
1009  ierr )
1010 
1011  call prof_rapend('COMM_Bcast', 2)
1012 
1013  return
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_process::prc_masterrank
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_process.F90:56
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:132
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
Definition: scale_prof.F90:178
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 1019 of file scale_comm.F90.

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

1019  use scale_process, only: &
1020  prc_masterrank
1021  implicit none
1022 
1023  integer, intent(inout) :: var(:,:)
1024  integer, intent(in) :: gia
1025  integer, intent(in) :: gja
1026 
1027  integer :: counts
1028  integer :: ierr
1029  !---------------------------------------------------------------------------
1030 
1031  call prof_rapstart('COMM_Bcast', 2)
1032 
1033  counts = gia * gja
1034 
1035  call mpi_bcast( var(:,:), &
1036  counts, &
1037  mpi_integer, &
1038  prc_masterrank, &
1039  comm_world, &
1040  ierr )
1041 
1042  call prof_rapend('COMM_Bcast', 2)
1043 
1044  return
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_process::prc_masterrank
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_process.F90:56
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:132
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
Definition: scale_prof.F90:178
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 1050 of file scale_comm.F90.

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

1050  use scale_process, only: &
1051  prc_masterrank
1052  implicit none
1053 
1054  logical, intent(inout) :: var
1055 
1056  integer :: counts
1057  integer :: ierr
1058  !---------------------------------------------------------------------------
1059 
1060  call prof_rapstart('COMM_Bcast', 2)
1061 
1062  counts = 1
1063 
1064  call mpi_bcast( var, &
1065  counts, &
1066  mpi_logical, &
1067  prc_masterrank, &
1068  comm_world, &
1069  ierr )
1070 
1071  call prof_rapend('COMM_Bcast', 2)
1072 
1073  return
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_process::prc_masterrank
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_process.F90:56
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:132
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
Definition: scale_prof.F90:178
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 1080 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().

1080  implicit none
1081 
1082  real(RP), intent(inout) :: var(:,:,:)
1083  integer, intent(in) :: vid
1084  integer, intent(in) :: seqid
1085 
1086  integer :: ireq, tag, ierr
1087  logical :: flag
1088 
1089  integer :: kd
1090  integer :: i
1091 
1092  tag = vid * 100
1093  ireq = 1
1094 
1095  kd = size(var, 1)
1096 
1097  ! register whole array to inner table of MPI and/or lower library
1098  ! otherwise a lot of sub small segments would be registered
1099  call mpi_send_init( var(:,:,:), size(var), comm_datatype, &
1100  mpi_proc_null, tag+comm_nreq_max+1, comm_world, &
1101  preq_list(comm_nreq_max+1,vid), ierr )
1102 
1103  !--- From 4-Direction HALO communicate
1104  ! From S
1105  call mpi_recv_init( var(:,:,js-jhalo:js-1), comm_size2d_ns4*kd, comm_datatype, &
1106  prc_next(prc_s), tag+1, comm_world, preq_list(ireq,vid), ierr )
1107  ireq = ireq + 1
1108  ! From N
1109  call mpi_recv_init( var(:,:,je+1:je+jhalo), comm_size2d_ns4*kd, comm_datatype, &
1110  prc_next(prc_n), tag+2, comm_world, preq_list(ireq,vid), ierr )
1111  ireq = ireq + 1
1112  ! From E
1113  call mpi_recv_init( recvpack_e2p(:,seqid), comm_size2d_we*kd, comm_datatype, &
1114  prc_next(prc_e), tag+3, comm_world, preq_list(ireq,vid), ierr )
1115  ireq = ireq + 1
1116  ! From W
1117  call mpi_recv_init( recvpack_w2p(:,seqid), comm_size2d_we*kd, comm_datatype, &
1118  prc_next(prc_w), tag+4, comm_world, preq_list(ireq,vid), ierr )
1119  ireq = ireq + 1
1120 
1121  !--- To 4-Direction HALO communicate
1122  ! To W HALO
1123  call mpi_send_init( sendpack_p2w(:,seqid), comm_size2d_we*kd, comm_datatype, &
1124  prc_next(prc_w), tag+3, comm_world, preq_list(ireq,vid), ierr )
1125  ireq = ireq + 1
1126  ! To E HALO
1127  call mpi_send_init( sendpack_p2e(:,seqid), comm_size2d_we*kd, comm_datatype, &
1128  prc_next(prc_e), tag+4, comm_world, preq_list(ireq,vid), ierr )
1129  ireq = ireq + 1
1130  ! To N HALO
1131  call mpi_send_init( var(:,:,je-jhalo+1:je), comm_size2d_ns4*kd, comm_datatype, &
1132  prc_next(prc_n), tag+1, comm_world, preq_list(ireq,vid), ierr )
1133  ireq = ireq + 1
1134  ! To S HALO
1135  call mpi_send_init( var(:,:,js:js+jhalo-1), comm_size2d_ns4*kd, comm_datatype, &
1136  prc_next(prc_s), tag+2, comm_world, preq_list(ireq,vid), ierr )
1137  ireq = ireq + 1
1138 
1139  preq_cnt(vid) = ireq - 1
1140  pseqid(vid) = seqid
1141 
1142  ! to finish initial processes of MPIa
1143  do i = 1, 32
1144  call mpi_testall( preq_cnt(vid), preq_list(1:preq_cnt(vid),vid), &
1145  flag, mpi_statuses_ignore, ierr )
1146  enddo
1147 
1148  return
scale_grid_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_grid_index.F90:63
scale_grid_index::jhalo
integer, public jhalo
of halo cells: y
Definition: scale_grid_index.F90:52
scale_grid_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_grid_index.F90:62
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 1727 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().

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

2172  use scale_process, only: &
2173  prc_mpistop
2174  implicit none
2175 
2176  real(RP), intent(inout) :: var(:,:)
2177  integer, intent(in) :: vid
2178 
2179  integer :: ireq, tag
2180  integer :: ierr
2181  !---------------------------------------------------------------------------
2182 
2183  tag = vid * 100
2184  ireq = 1
2185 
2186 #ifdef DEBUG
2187  if ( use_packbuf(vid) ) then
2188  write(*,*) 'packing buffer is already used', vid
2189  call prc_mpistop
2190  end if
2191  use_packbuf(vid) = .true.
2192 #endif
2193 
2194  if ( comm_isallperiodic ) then
2195  !--- periodic condition
2196  !--- From 4-Direction HALO communicate
2197  ! From S
2198  call mpi_irecv( var(:,js-jhalo:js-1), comm_size2d_ns4, &
2199  comm_datatype, prc_next(prc_s), tag+1, &
2200  comm_world, req_list(ireq,vid), ierr )
2201  ireq = ireq + 1
2202 
2203  ! From N
2204  call mpi_irecv( var(:,je+1:je+jhalo), comm_size2d_ns4, &
2205  comm_datatype, prc_next(prc_n), tag+2, &
2206  comm_world, req_list(ireq,vid), ierr )
2207  ireq = ireq + 1
2208 
2209  ! From E
2210  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we, &
2211  comm_datatype, prc_next(prc_e), tag+3, &
2212  comm_world, req_list(ireq,vid), ierr )
2213  ireq = ireq + 1
2214 
2215  ! From W
2216  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we, &
2217  comm_datatype, prc_next(prc_w), tag+4, &
2218  comm_world, req_list(ireq,vid), ierr )
2219  ireq = ireq + 1
2220 
2221  call pack_2d(var, vid)
2222 
2223  ! To W HALO communicate
2224  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we, &
2225  comm_datatype, prc_next(prc_w), tag+3, &
2226  comm_world, req_list(ireq,vid), ierr )
2227  ireq = ireq + 1
2228 
2229  ! To E HALO communicate
2230  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we, &
2231  comm_datatype, prc_next(prc_e), tag+4, &
2232  comm_world, req_list(ireq,vid), ierr )
2233  ireq = ireq + 1
2234 
2235  ! To N HALO communicate
2236  call mpi_isend( var(:,je-jhalo+1:je), comm_size2d_ns4, &
2237  comm_datatype, prc_next(prc_n), tag+1, &
2238  comm_world, req_list(ireq,vid), ierr )
2239  ireq = ireq + 1
2240 
2241  ! To S HALO communicate
2242  call mpi_isend( var(:,js:js+jhalo-1), comm_size2d_ns4, &
2243  comm_datatype, prc_next(prc_s), tag+2, &
2244  comm_world, req_list(ireq,vid), ierr )
2245  ireq = ireq + 1
2246 
2247  else
2248  !--- non-periodic condition
2249  !--- From 4-Direction HALO communicate
2250  ! From S
2251  if ( prc_has_s ) then
2252  call mpi_irecv( var(:,js-jhalo:js-1), comm_size2d_ns4, &
2253  comm_datatype, prc_next(prc_s), tag+1, &
2254  comm_world, req_list(ireq,vid), ierr )
2255  ireq = ireq + 1
2256  endif
2257 
2258  ! From N
2259  if ( prc_has_n ) then
2260  call mpi_irecv( var(:,je+1:je+jhalo), comm_size2d_ns4, &
2261  comm_datatype, prc_next(prc_n), tag+2, &
2262  comm_world, req_list(ireq,vid), ierr )
2263  ireq = ireq + 1
2264  endif
2265 
2266  ! From E
2267  if ( prc_has_e ) then
2268  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we, &
2269  comm_datatype, prc_next(prc_e), tag+3, &
2270  comm_world, req_list(ireq,vid), ierr )
2271  ireq = ireq + 1
2272  endif
2273 
2274  ! From W
2275  if ( prc_has_w ) then
2276  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we, &
2277  comm_datatype, prc_next(prc_w), tag+4, &
2278  comm_world, req_list(ireq,vid), ierr )
2279  ireq = ireq + 1
2280  endif
2281 
2282  call pack_2d(var, vid)
2283 
2284  ! To W HALO communicate
2285  if ( prc_has_w ) then
2286  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we, &
2287  comm_datatype, prc_next(prc_w), tag+3, &
2288  comm_world, req_list(ireq,vid), ierr )
2289  ireq = ireq + 1
2290  endif
2291 
2292  ! To E HALO communicate
2293  if ( prc_has_e ) then
2294  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we, &
2295  comm_datatype, prc_next(prc_e), tag+4, &
2296  comm_world, req_list(ireq,vid), ierr )
2297  ireq = ireq + 1
2298  endif
2299 
2300  ! To N HALO communicate
2301  if ( prc_has_n ) then
2302  call mpi_isend( var(:,je-jhalo+1:je), comm_size2d_ns4, &
2303  comm_datatype, prc_next(prc_n), tag+1, &
2304  comm_world, req_list(ireq,vid), ierr )
2305  ireq = ireq + 1
2306  endif
2307 
2308  ! To S HALO communicate
2309  if ( prc_has_s ) then
2310  call mpi_isend( var(:,js:js+jhalo-1), comm_size2d_ns4, &
2311  comm_datatype, prc_next(prc_s), tag+2, &
2312  comm_world, req_list(ireq,vid), ierr )
2313  ireq = ireq + 1
2314  endif
2315 
2316  endif
2317 
2318  req_cnt(vid) = ireq - 1
2319 
2320  return
scale_grid_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_grid_index.F90:63
scale_rm_process::prc_has_n
logical, public prc_has_n
Definition: scale_rm_process.F90:50
scale_process::prc_mpistop
subroutine, public prc_mpistop
Abort MPI.
Definition: scale_process.F90:234
scale_rm_process::prc_has_e
logical, public prc_has_e
Definition: scale_rm_process.F90:51
scale_rm_process::prc_has_s
logical, public prc_has_s
Definition: scale_rm_process.F90:52
scale_grid_index::jhalo
integer, public jhalo
of halo cells: y
Definition: scale_grid_index.F90:52
scale_grid_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_grid_index.F90:62
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_rm_process::prc_has_w
logical, public prc_has_w
Definition: scale_rm_process.F90:49
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 2324 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().

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

References scale_process::prc_mpistop().

Referenced by comm_vars8_init().

2822  use scale_process, only: &
2823  prc_mpistop
2824  implicit none
2825 
2826  real(RP), intent(inout) :: var(:,:,:)
2827  integer, intent(in) :: vid
2828  integer :: ierr
2829  !---------------------------------------------------------------------------
2830 
2831 #ifdef DEBUG
2832  if ( use_packbuf(pseqid(vid)) ) then
2833  write(*,*) 'packing buffer is already used', vid, pseqid(vid)
2834  call prc_mpistop
2835  end if
2836  use_packbuf(pseqid(vid)) = .true.
2837 #endif
2838 
2839  call pack_3d(var, pseqid(vid))
2840 
2841  call mpi_startall(preq_cnt(vid), preq_list(1:preq_cnt(vid),vid), ierr)
2842 
2843  return
scale_process::prc_mpistop
subroutine, public prc_mpistop
Abort MPI.
Definition: scale_process.F90:234
scale_process
module PROCESS
Definition: scale_process.F90:14
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 2847 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().

2847  implicit none
2848  real(RP), intent(inout) :: var(:,:,:)
2849  integer, intent(in) :: vid
2850 
2851  integer :: ierr
2852  !---------------------------------------------------------------------------
2853 
2854  !--- wait packets
2855  call mpi_waitall( req_cnt(vid), &
2856  req_list(1:req_cnt(vid),vid), &
2857  mpi_statuses_ignore, &
2858  ierr )
2859  call unpack_3d(var, vid)
2860 
2861 #ifdef DEBUG
2862  use_packbuf(vid) = .false.
2863 #endif
2864 
2865  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 3495 of file scale_comm.F90.

Referenced by mod_rm_driver::scalerm().

3495  use mpi
3496  implicit none
3497 
3498  namelist / param_comm / &
3499  comm_vsize_max_pc, &
3500  comm_use_mpi_pc
3501 
3502  integer :: i, j, ierr
3503  !---------------------------------------------------------------------------
3504 
3505  deallocate( recvpack_w2p )
3506  deallocate( recvpack_e2p )
3507  deallocate( sendpack_p2w )
3508  deallocate( sendpack_p2e )
3509 #ifdef DEBUG
3510  deallocate( use_packbuf )
3511 #endif
3512 
3513  deallocate( req_cnt )
3514  deallocate( req_list )
3515 
3516  if ( comm_use_mpi_pc ) then
3517  do j=1, comm_vsize_max_pc
3518  do i=1, comm_nreq_max+1
3519  if (preq_list(i,j) .NE. mpi_request_null) &
3520  call mpi_request_free(preq_list(i,j), ierr)
3521  enddo
3522  enddo
3523  deallocate( preq_cnt )
3524  deallocate( preq_list )
3525  deallocate( pseqid )
3526  end if
Here is the caller graph for this function:

Variable Documentation

◆ comm_datatype

integer, public scale_comm::comm_datatype

datatype of variable

Definition at line 117 of file scale_comm.F90.

Referenced by scale_atmos_dyn::atmos_dyn(), scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_setup(), scale_atmos_dyn_tstep_large_fvm_heve::check_mass(), comm_bcast_1d(), comm_bcast_2d(), comm_bcast_3d(), comm_bcast_4d(), comm_bcast_scr(), comm_gather_2d(), comm_gather_3d(), comm_horizontal_max_2d(), comm_horizontal_mean(), comm_horizontal_min_2d(), comm_setup(), scale_grid_nest::nest_comm_intercomm_nestdown_3d(), scale_grid_nest::nest_comm_issuer_of_receive_3d(), scale_grid_nest::nest_domain_shape(), scale_rm_statistics::stat_detail(), scale_rm_statistics::stat_total_2d(), scale_rm_statistics::stat_total_3d(), vars8_2d_mpi(), vars8_3d_mpi(), vars_2d_mpi(), and vars_init_mpi_pc().

117  integer, public :: comm_datatype

◆ comm_world

integer, public scale_comm::comm_world

communication world ID

Definition at line 118 of file scale_comm.F90.

Referenced by scale_atmos_dyn::atmos_dyn(), scale_atmos_phy_mp_suzuki10::atmos_phy_mp_suzuki10_setup(), scale_atmos_dyn_tstep_large_fvm_heve::check_mass(), comm_bcast_1d(), comm_bcast_2d(), comm_bcast_3d(), comm_bcast_4d(), comm_bcast_int_1d(), comm_bcast_int_2d(), comm_bcast_int_scr(), comm_bcast_logical_scr(), comm_bcast_scr(), comm_gather_2d(), comm_gather_3d(), comm_horizontal_max_2d(), comm_horizontal_mean(), comm_horizontal_min_2d(), comm_setup(), scale_grid_nest::nest_domain_shape(), scale_grid_nest::nest_setup(), scale_atmos_dyn_tstep_short_fvm_hivi::solve_bicgstab(), vars8_2d_mpi(), vars8_3d_mpi(), vars_2d_mpi(), and vars_init_mpi_pc().

118  integer, public :: 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.
Generated by   doxygen 1.8.13