SCALE-RM
Data Types | Functions/Subroutines | Variables
scale_comm_cartesc 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 comm_horizontal_mean_3d (varmean, var)
 calculate horizontal mean (global total with communication) 3D 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_sp (var)
 Broadcast data for whole process value in scalar field. More...
 
subroutine comm_bcast_scr_dp (var)
 
subroutine comm_bcast_1d_sp (var, gIA)
 Broadcast data for whole process value in 1D field. More...
 
subroutine comm_bcast_1d_dp (var, gIA)
 
subroutine comm_bcast_2d_sp (var, gIA, gJA)
 Broadcast data for whole process value in 2D field. More...
 
subroutine comm_bcast_2d_dp (var, gIA, gJA)
 
subroutine comm_bcast_3d_sp (var, gIA, gJA, gKA)
 Broadcast data for whole process value in 3D field. More...
 
subroutine comm_bcast_3d_dp (var, gIA, gJA, gKA)
 
subroutine comm_bcast_4d_sp (var, gIA, gJA, gKA, gTime)
 Broadcast data for whole process value in 4D field. More...
 
subroutine comm_bcast_4d_dp (var, gIA, gJA, gKA, gTime)
 
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 comm_bcast_character (var)
 Broadcast data for whole process value in character. More...
 
subroutine vars_init_mpi_pc (var, vid, seqid)
 
subroutine vars8_init_mpi_pc (var, vid, seqid)
 
subroutine vars_3d_mpi (var, vid)
 
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 wait_2d_mpi (var, vid)
 
subroutine wait_3d_mpi_pc (var, vid)
 
subroutine pack_3d (var, vid)
 
subroutine copy_boundary_2d (var)
 
subroutine, public comm_cleanup
 

Variables

integer, public comm_datatype
 datatype of variable More...
 
integer, public comm_world
 communication world ID More...
 

Detailed Description

module COMMUNICATION

Description
MPI Communication module for Cartesian C-grid
Author
Team SCALE
NAMELIST
  • PARAM_COMM_CARTESC
    nametypedefault valuecomment
    COMM_VSIZE_MAX integer # limit of communication variables at once
    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_cartesc::comm_setup

Setup.

Definition at line 145 of file scale_comm_cartesC.F90.

145  use scale_prc, only: &
146  prc_local_comm_world
147  implicit none
148 
149  namelist / param_comm_cartesc / &
150  comm_vsize_max, &
151  comm_vsize_max_pc, &
152  comm_use_mpi_pc
153 
154  integer :: nreq_NS, nreq_WE, nreq_4C
155 
156  logical, save :: initialized = .false.
157 
158  integer :: ierr
159  !---------------------------------------------------------------------------
160 
161  if ( initialized ) return
162 
163  log_newline
164  log_info("COMM_setup",*) 'Setup'
165 
166  comm_vsize_max = max( 10 + qa*2, 25 )
167  comm_vsize_max_pc = 50 + qa*2
168 
169  !--- read namelist
170  rewind(io_fid_conf)
171  read(io_fid_conf,nml=param_comm_cartesc,iostat=ierr)
172  if( ierr < 0 ) then !--- missing
173  log_info("COMM_setup",*) 'Not found namelist. Default used.'
174  elseif( ierr > 0 ) then !--- fatal error
175  log_error("COMM_setup",*) 'Not appropriate names in namelist PARAM_COMM_CARTESC. Check!'
176  call prc_abort
177  endif
178  log_nml(param_comm_cartesc)
179 
180  nreq_ns = 2 * jhalo !--- send x JHALO, recv x JHALO
181  nreq_we = 2 !--- send x 1 , recv x 1
182  nreq_4c = 2 * jhalo !--- send x JHALO, recv x JHALO
183 
184  if ( comm_use_mpi_pc ) then
185  comm_nreq_max = 2 * nreq_ns + 2 * nreq_we + 4 * nreq_4c + 1
186  else
187  comm_nreq_max = 2 * nreq_ns + 2 * nreq_we + 4 * nreq_4c
188  end if
189 
190  comm_size2d_ns4 = ia * jhalo
191  comm_size2d_ns8 = imax
192  comm_size2d_we = jmax * ihalo
193  comm_size2d_4c = ihalo
194 
195  allocate( recvpack_w2p(comm_size2d_we*ka,comm_vsize_max) )
196  allocate( recvpack_e2p(comm_size2d_we*ka,comm_vsize_max) )
197  allocate( sendpack_p2w(comm_size2d_we*ka,comm_vsize_max) )
198  allocate( sendpack_p2e(comm_size2d_we*ka,comm_vsize_max) )
199 #ifdef DEBUG
200  allocate( use_packbuf(comm_vsize_max) )
201  use_packbuf(:) = .false.
202 #endif
203 
204  allocate( req_cnt( comm_vsize_max) )
205  allocate( req_list(comm_nreq_max,comm_vsize_max) )
206  req_cnt(:) = -1
207  req_list(:,:) = mpi_request_null
208 
209  if ( comm_use_mpi_pc ) then
210  allocate( preq_cnt( comm_vsize_max_pc) )
211  allocate( preq_list(comm_nreq_max+1,comm_vsize_max_pc) )
212  preq_cnt(:) = -1
213  preq_list(:,:) = mpi_request_null
214 
215  allocate( pseqid(comm_vsize_max_pc) )
216  end if
217 
218  if ( prc_has_n .AND. prc_has_s .AND. prc_has_w .AND. prc_has_e ) then
219  comm_isallperiodic = .true.
220  else
221  comm_isallperiodic = .false.
222  endif
223 
224  if ( rp == kind(0.d0) ) then
225  comm_datatype = mpi_double_precision
226  elseif( rp == kind(0.0) ) then
227  comm_datatype = mpi_real
228  else
229  log_error("COMM_setup",*) 'precision is not supportd'
230  call prc_abort
231  endif
232 
233  comm_world = prc_local_comm_world
234 
235  log_newline
236  log_info("COMM_setup",*) 'Communication information'
237  log_info_cont(*) 'Maximum number of vars for one communication: ', comm_vsize_max
238  log_info_cont(*) 'Data size of var (3D,including halo) [byte] : ', rp*ka*ia*ja
239  log_info_cont(*) 'Data size of halo [byte] : ', rp*ka*(2*ia*jhalo+2*jmax*ihalo)
240  log_info_cont(*) 'Ratio of halo against the whole 3D grid : ', real(2*ia*jhalo+2*jmax*ihalo) / real(ia*ja)
241  log_info_cont(*) 'All side is periodic? : ', comm_isallperiodic
242 
243  initialized = .true.
244 
245  return

References comm_datatype, comm_world, scale_atmos_grid_cartesc_index::ia, scale_atmos_grid_cartesc_index::ihalo, scale_atmos_grid_cartesc_index::imax, scale_io::io_fid_conf, scale_atmos_grid_cartesc_index::ja, scale_atmos_grid_cartesc_index::jhalo, scale_atmos_grid_cartesc_index::jmax, scale_atmos_grid_cartesc_index::ka, scale_prc_cartesc::prc_has_e, scale_prc_cartesc::prc_has_n, scale_prc_cartesc::prc_has_s, scale_prc_cartesc::prc_has_w, scale_prc::prc_local_comm_world, scale_tracer::qa, and scale_precision::rp.

Referenced by mod_rm_driver::rm_driver(), mod_rm_prep::rm_prep(), and scale_statistics::statistics_setup().

Here is the caller graph for this function:

◆ comm_vars_init()

subroutine, public scale_comm_cartesc::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 254 of file scale_comm_cartesC.F90.

254  implicit none
255 
256  character(len=*), intent(in) :: varname
257  real(RP), intent(inout) :: var(:,:,:)
258  integer, intent(inout) :: vid
259  !---------------------------------------------------------------------------
260 
261  if ( vid > comm_vsize_max ) then
262  log_error("COMM_vars_init",*) 'vid exceeds max', vid, comm_vsize_max
263  call prc_abort
264  end if
265 
266  if ( comm_use_mpi_pc ) then
267 
268  comm_vars_id = comm_vars_id + 1
269  if ( comm_vars_id > comm_vsize_max_pc ) then
270  log_error("COMM_vars_init",*) 'number of variable for MPI PC exceeds max', comm_vars_id, comm_vsize_max_pc
271  call prc_abort
272  end if
273 
274  call prof_rapstart('COMM_init_pers', 2)
275  call vars_init_mpi_pc(var, comm_vars_id, vid)
276  call prof_rapend ('COMM_init_pers', 2)
277 
278  vid = comm_vars_id + comm_vsize_max
279 
280  log_info("COMM_vars_init",'(1x,A,I3.3,2A)') 'Initialize variable : ID = ', vid, &
281  ', name = ', trim(varname)
282 
283  end if
284 
285  return

References scale_prc::prc_abort(), scale_prof::prof_rapend(), scale_prof::prof_rapstart(), and vars_init_mpi_pc().

Here is the call graph for this function:

◆ comm_vars8_init()

subroutine, public scale_comm_cartesc::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 294 of file scale_comm_cartesC.F90.

294  implicit none
295 
296  character(len=*), intent(in) :: varname
297  real(RP), intent(inout) :: var(:,:,:)
298  integer, intent(inout) :: vid
299  !---------------------------------------------------------------------------
300 
301  if ( vid > comm_vsize_max ) then
302  log_error("COMM_vars8_init",*) 'vid exceeds max', vid, comm_vsize_max
303  call prc_abort
304  end if
305 
306  if ( comm_use_mpi_pc ) then
307 
308  comm_vars_id = comm_vars_id + 1
309  if ( comm_vars_id > comm_vsize_max_pc ) then
310  log_error("COMM_vars8_init",*) 'number of variable for MPI PC exceeds max', comm_vars_id, comm_vsize_max_pc
311  call prc_abort
312  end if
313 
314  call prof_rapstart('COMM_init_pers', 2)
315  call vars8_init_mpi_pc(var, comm_vars_id, vid)
316  call prof_rapend ('COMM_init_pers', 2)
317 
318  vid = comm_vars_id + comm_vsize_max
319 
320  log_info("COMM_vars8_init",'(1x,A,I3.3,2A)') 'Initialize variable : ID = ', vid, &
321  ', name = ', trim(varname)
322 
323  end if
324 
325  return

References comm_datatype, comm_world, scale_const::const_undef, copy_boundary_2d(), scale_atmos_grid_cartesc_index::ie, scale_atmos_grid_cartesc_index::is, scale_atmos_grid_cartesc_index::je, scale_atmos_grid_cartesc_index::js, scale_prc::prc_abort(), scale_prof::prof_rapend(), scale_prof::prof_rapstart(), vars8_2d_mpi(), vars8_3d_mpi(), vars8_init_mpi_pc(), vars_2d_mpi(), vars_3d_mpi(), vars_3d_mpi_pc(), wait_2d_mpi(), wait_3d_mpi(), and wait_3d_mpi_pc().

Referenced by scale_atmos_dyn_fvm_numfilter::atmos_dyn_fvm_numfilter_setup(), scale_atmos_dyn::atmos_dyn_setup(), scale_atmos_dyn_tinteg_rkcommon::atmos_dyn_tinteg_rkcommon_setup(), scale_atmos_dyn_tinteg_short_rk11s8o::atmos_dyn_tinteg_short_rk11s8o_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_short_rk7s6o::atmos_dyn_tinteg_short_rk7s6o_setup(), scale_atmos_dyn_tinteg_tracer_linrk::atmos_dyn_tinteg_tracer_linrk_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().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ comm_horizontal_mean_3d()

subroutine scale_comm_cartesc::comm_horizontal_mean_3d ( real(rp), dimension(ka), intent(out)  varmean,
real(rp), dimension (ka,ia,ja), intent(in)  var 
)

calculate horizontal mean (global total with communication) 3D

Parameters
[out]varmeanhorizontal mean
[in]var3D value

Definition at line 522 of file scale_comm_cartesC.F90.

522  use scale_const, only: &
523  const_undef
524  implicit none
525 
526  real(RP), intent(out) :: varmean(KA)
527  real(RP), intent(in) :: var (KA,IA,JA)
528 
529  real(RP) :: statval (KA)
530  real(RP) :: statcnt (KA)
531  real(RP) :: allstatval(KA)
532  real(RP) :: allstatcnt(KA)
533  real(RP) :: zerosw
534 
535  integer :: ierr
536  integer :: k, i, j
537  !---------------------------------------------------------------------------
538 
539  statval(:) = 0.0_rp
540  statcnt(:) = 0.0_rp
541  do j = js, je
542  do i = is, ie
543  do k = 1, ka
544  if ( abs(var(k,i,j)) < abs(const_undef) ) then
545  statval(k) = statval(k) + var(k,i,j)
546  statcnt(k) = statcnt(k) + 1.0_rp
547  endif
548  enddo
549  enddo
550  enddo
551 
552  ! [NOTE] always communicate globally
553  call prof_rapstart('COMM_Allreduce', 2)
554  ! All reduce
555  call mpi_allreduce( statval(1), &
556  allstatval(1), &
557  ka, &
558  comm_datatype, &
559  mpi_sum, &
560  comm_world, &
561  ierr )
562  ! All reduce
563  call mpi_allreduce( statcnt(1), &
564  allstatcnt(1), &
565  ka, &
566  comm_datatype, &
567  mpi_sum, &
568  comm_world, &
569  ierr )
570 
571  call prof_rapend ('COMM_Allreduce', 2)
572 
573  do k = 1, ka
574  zerosw = 0.5_rp - sign(0.5_rp, allstatcnt(k) - 1.e-12_rp )
575  varmean(k) = allstatval(k) / ( allstatcnt(k) + zerosw ) * ( 1.0_rp - zerosw )
576  !LOG_INFO("COMM_horizontal_mean_3D",*) k, varmean(k), allstatval(k), allstatcnt(k)
577  enddo
578 
579  return

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

Here is the call graph for this function:

◆ comm_gather_2d()

subroutine scale_comm_cartesc::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,nprcs)
[in]sendsend buffer (gIA,gJA)
[in]giadimension size of x
[in]gjadimension size of y

Definition at line 585 of file scale_comm_cartesC.F90.

585  use scale_prc, only: &
586  prc_masterrank
587  implicit none
588 
589  real(RP), intent(out) :: recv(:,:,:)
590  real(RP), intent(in) :: send(:,:)
591  integer, intent(in) :: gIA
592  integer, intent(in) :: gJA
593 
594  integer :: sendcounts, recvcounts
595  integer :: ierr
596  !---------------------------------------------------------------------------
597 
598  sendcounts = gia * gja
599  recvcounts = gia * gja
600 
601  call mpi_gather( send(:,:), &
602  sendcounts, &
603  comm_datatype, &
604  recv(:,:,:), &
605  recvcounts, &
606  comm_datatype, &
607  prc_masterrank, &
608  comm_world, &
609  ierr )
610 
611  return

References comm_datatype, comm_world, and scale_prc::prc_masterrank.

◆ comm_gather_3d()

subroutine scale_comm_cartesc::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,nprcs)
[in]sendsend buffer (gIA,gJA,gKA)
[in]giadimension size of x
[in]gjadimension size of y
[in]gkadimension size of z

Definition at line 617 of file scale_comm_cartesC.F90.

617  use scale_prc, only: &
618  prc_masterrank
619  implicit none
620 
621  real(RP), intent(out) :: recv(:,:,:,:)
622  real(RP), intent(in) :: send(:,:,:)
623  integer, intent(in) :: gIA
624  integer, intent(in) :: gJA
625  integer, intent(in) :: gKA
626 
627  integer :: sendcounts, recvcounts
628  integer :: ierr
629  !---------------------------------------------------------------------------
630 
631  sendcounts = gia * gja * gka
632  recvcounts = gia * gja * gka
633 
634  call mpi_gather( send(:,:,:), &
635  sendcounts, &
636  comm_datatype, &
637  recv(:,:,:,:), &
638  recvcounts, &
639  comm_datatype, &
640  prc_masterrank, &
641  comm_world, &
642  ierr )
643 
644  return

References comm_datatype, comm_world, and scale_prc::prc_masterrank.

◆ comm_bcast_scr_sp()

subroutine scale_comm_cartesc::comm_bcast_scr_sp ( real(sp), intent(inout)  var)

Broadcast data for whole process value in scalar field.

Parameters
[in,out]varbroadcast buffer (gIA)

Definition at line 650 of file scale_comm_cartesC.F90.

650  use scale_prc, only: &
651  prc_masterrank
652  implicit none
653 
654  real(SP), intent(inout) :: var
655 
656  integer :: counts
657  integer :: ierr
658  !---------------------------------------------------------------------------
659 
660  call prof_rapstart('COMM_Bcast', 2)
661 
662  counts = 1
663 
664  call mpi_bcast( var, &
665  counts, &
666  comm_datatype, &
667  prc_masterrank, &
668  comm_world, &
669  ierr )
670 
671  call prof_rapend('COMM_Bcast', 2)
672 
673  return

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

Here is the call graph for this function:

◆ comm_bcast_scr_dp()

subroutine scale_comm_cartesc::comm_bcast_scr_dp ( real(dp), intent(inout)  var)
Parameters
[in,out]varbroadcast buffer (gIA)

Definition at line 676 of file scale_comm_cartesC.F90.

676  use scale_prc, only: &
677  prc_masterrank
678  implicit none
679 
680  real(DP), intent(inout) :: var
681 
682  integer :: counts
683  integer :: ierr
684  !---------------------------------------------------------------------------
685 
686  call prof_rapstart('COMM_Bcast', 2)
687 
688  counts = 1
689 
690  call mpi_bcast( var, &
691  counts, &
692  comm_datatype, &
693  prc_masterrank, &
694  comm_world, &
695  ierr )
696 
697  call prof_rapend('COMM_Bcast', 2)
698 
699  return

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

Here is the call graph for this function:

◆ comm_bcast_1d_sp()

subroutine scale_comm_cartesc::comm_bcast_1d_sp ( real(sp), 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 705 of file scale_comm_cartesC.F90.

705  use scale_prc, only: &
706  prc_masterrank
707  implicit none
708 
709  real(SP), intent(inout) :: var(:)
710  integer, intent(in) :: gIA
711 
712  integer :: counts
713  integer :: ierr
714  !---------------------------------------------------------------------------
715 
716  call prof_rapstart('COMM_Bcast', 2)
717 
718  counts = gia
719 
720  call mpi_bcast( var(:), &
721  counts, &
722  comm_datatype, &
723  prc_masterrank, &
724  comm_world, &
725  ierr )
726 
727  call prof_rapend('COMM_Bcast', 2)
728 
729  return

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

Here is the call graph for this function:

◆ comm_bcast_1d_dp()

subroutine scale_comm_cartesc::comm_bcast_1d_dp ( real(dp), dimension(:), intent(inout)  var,
integer, intent(in)  gIA 
)
Parameters
[in,out]varbroadcast buffer (gIA)
[in]giadimension size of x

Definition at line 732 of file scale_comm_cartesC.F90.

732  use scale_prc, only: &
733  prc_masterrank
734  implicit none
735 
736  real(DP), intent(inout) :: var(:)
737  integer, intent(in) :: gIA
738 
739  integer :: counts
740  integer :: ierr
741  !---------------------------------------------------------------------------
742 
743  call prof_rapstart('COMM_Bcast', 2)
744 
745  counts = gia
746 
747  call mpi_bcast( var(:), &
748  counts, &
749  comm_datatype, &
750  prc_masterrank, &
751  comm_world, &
752  ierr )
753 
754  call prof_rapend('COMM_Bcast', 2)
755 
756  return

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

Here is the call graph for this function:

◆ comm_bcast_2d_sp()

subroutine scale_comm_cartesc::comm_bcast_2d_sp ( real(sp), 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 762 of file scale_comm_cartesC.F90.

762  use scale_prc, only: &
763  prc_masterrank
764  implicit none
765 
766  real(SP), intent(inout) :: var(:,:)
767  integer, intent(in) :: gIA
768  integer, intent(in) :: gJA
769 
770  integer :: counts
771  integer :: ierr
772  !---------------------------------------------------------------------------
773 
774  call prof_rapstart('COMM_Bcast', 2)
775 
776  counts = gia * gja
777 
778  call mpi_bcast( var(:,:), &
779  counts, &
780  comm_datatype, &
781  prc_masterrank, &
782  comm_world, &
783  ierr )
784 
785  call prof_rapend('COMM_Bcast', 2)
786 
787  return

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

Here is the call graph for this function:

◆ comm_bcast_2d_dp()

subroutine scale_comm_cartesc::comm_bcast_2d_dp ( real(dp), dimension(:,:), intent(inout)  var,
integer, intent(in)  gIA,
integer, intent(in)  gJA 
)
Parameters
[in,out]varbroadcast buffer (gIA,gJA)
[in]giadimension size of x
[in]gjadimension size of y

Definition at line 790 of file scale_comm_cartesC.F90.

790  use scale_prc, only: &
791  prc_masterrank
792  implicit none
793 
794  real(DP), intent(inout) :: var(:,:)
795  integer, intent(in) :: gIA
796  integer, intent(in) :: gJA
797 
798  integer :: counts
799  integer :: ierr
800  !---------------------------------------------------------------------------
801 
802  call prof_rapstart('COMM_Bcast', 2)
803 
804  counts = gia * gja
805 
806  call mpi_bcast( var(:,:), &
807  counts, &
808  comm_datatype, &
809  prc_masterrank, &
810  comm_world, &
811  ierr )
812 
813  call prof_rapend('COMM_Bcast', 2)
814 
815  return

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

Here is the call graph for this function:

◆ comm_bcast_3d_sp()

subroutine scale_comm_cartesc::comm_bcast_3d_sp ( real(sp), 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 821 of file scale_comm_cartesC.F90.

821  use scale_prc, only: &
822  prc_masterrank
823  implicit none
824 
825  real(SP), intent(inout) :: var(:,:,:)
826  integer, intent(in) :: gIA
827  integer, intent(in) :: gJA
828  integer, intent(in) :: gKA
829 
830  integer :: counts
831  integer :: ierr
832  !---------------------------------------------------------------------------
833 
834  call prof_rapstart('COMM_Bcast', 2)
835 
836  counts = gia * gja * gka
837 
838  call mpi_bcast( var(:,:,:), &
839  counts, &
840  comm_datatype, &
841  prc_masterrank, &
842  comm_world, &
843  ierr )
844 
845  call prof_rapend('COMM_Bcast', 2)
846 
847  return

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

Here is the call graph for this function:

◆ comm_bcast_3d_dp()

subroutine scale_comm_cartesc::comm_bcast_3d_dp ( real(dp), dimension(:,:,:), intent(inout)  var,
integer, intent(in)  gIA,
integer, intent(in)  gJA,
integer, intent(in)  gKA 
)
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 850 of file scale_comm_cartesC.F90.

850  use scale_prc, only: &
851  prc_masterrank
852  implicit none
853 
854  real(DP), intent(inout) :: var(:,:,:)
855  integer, intent(in) :: gIA
856  integer, intent(in) :: gJA
857  integer, intent(in) :: gKA
858 
859  integer :: counts
860  integer :: ierr
861  !---------------------------------------------------------------------------
862 
863  call prof_rapstart('COMM_Bcast', 2)
864 
865  counts = gia * gja * gka
866 
867  call mpi_bcast( var(:,:,:), &
868  counts, &
869  comm_datatype, &
870  prc_masterrank, &
871  comm_world, &
872  ierr )
873 
874  call prof_rapend('COMM_Bcast', 2)
875 
876  return

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

Here is the call graph for this function:

◆ comm_bcast_4d_sp()

subroutine scale_comm_cartesc::comm_bcast_4d_sp ( real(sp), 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 882 of file scale_comm_cartesC.F90.

882  use scale_prc, only: &
883  prc_masterrank
884  implicit none
885 
886  real(SP), intent(inout) :: var(:,:,:,:)
887  integer, intent(in) :: gIA
888  integer, intent(in) :: gJA
889  integer, intent(in) :: gKA
890  integer, intent(in) :: gTime
891 
892  integer :: counts
893  integer :: ierr
894  !---------------------------------------------------------------------------
895 
896  call prof_rapstart('COMM_Bcast', 2)
897 
898  counts = gia * gja * gka * gtime
899  if ( gia>0 .AND. gja>0 .AND. gka>0 .AND. gtime>0 .AND. &
900  counts < 0 ) then
901  log_error("COMM_bcast_4D",*) 'counts overflow'
902  call prc_abort
903  end if
904 
905  call mpi_bcast( var(:,:,:,:), &
906  counts, &
907  comm_datatype, &
908  prc_masterrank, &
909  comm_world, &
910  ierr )
911 
912  call prof_rapend('COMM_Bcast', 2)
913 
914  return

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

Here is the call graph for this function:

◆ comm_bcast_4d_dp()

subroutine scale_comm_cartesc::comm_bcast_4d_dp ( real(dp), dimension(:,:,:,:), intent(inout)  var,
integer, intent(in)  gIA,
integer, intent(in)  gJA,
integer, intent(in)  gKA,
integer, intent(in)  gTime 
)
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 917 of file scale_comm_cartesC.F90.

917  use scale_prc, only: &
918  prc_masterrank
919  implicit none
920 
921  real(DP), intent(inout) :: var(:,:,:,:)
922  integer, intent(in) :: gIA
923  integer, intent(in) :: gJA
924  integer, intent(in) :: gKA
925  integer, intent(in) :: gTime
926 
927  integer :: counts
928  integer :: ierr
929  !---------------------------------------------------------------------------
930 
931  call prof_rapstart('COMM_Bcast', 2)
932 
933  counts = gia * gja * gka * gtime
934  if ( gia>0 .AND. gja>0 .AND. gka>0 .AND. gtime>0 .AND. &
935  counts < 0 ) then
936  log_error("COMM_bcast_4D",*) 'counts overflow'
937  call prc_abort
938  end if
939 
940  call mpi_bcast( var(:,:,:,:), &
941  counts, &
942  comm_datatype, &
943  prc_masterrank, &
944  comm_world, &
945  ierr )
946 
947  call prof_rapend('COMM_Bcast', 2)
948 
949  return

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

Here is the call graph for this function:

◆ comm_bcast_int_scr()

subroutine scale_comm_cartesc::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 955 of file scale_comm_cartesC.F90.

955  use scale_prc, only: &
956  prc_masterrank
957  implicit none
958 
959  integer, intent(inout) :: var
960 
961  integer :: counts
962  integer :: ierr
963  !---------------------------------------------------------------------------
964 
965  call prof_rapstart('COMM_Bcast', 2)
966 
967  counts = 1
968 
969  call mpi_bcast( var, &
970  counts, &
971  mpi_integer, &
972  prc_masterrank, &
973  comm_world, &
974  ierr )
975 
976  call prof_rapend('COMM_Bcast', 2)
977 
978  return

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

Here is the call graph for this function:

◆ comm_bcast_int_1d()

subroutine scale_comm_cartesc::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 984 of file scale_comm_cartesC.F90.

984  use scale_prc, only: &
985  prc_masterrank
986  implicit none
987 
988  integer, intent(inout) :: var(:)
989  integer, intent(in) :: gIA
990 
991  integer :: counts
992  integer :: ierr
993  !---------------------------------------------------------------------------
994 
995  call prof_rapstart('COMM_Bcast', 2)
996 
997  counts = gia
998 
999  call mpi_bcast( var(:), &
1000  counts, &
1001  mpi_integer, &
1002  prc_masterrank, &
1003  comm_world, &
1004  ierr )
1005 
1006  call prof_rapend('COMM_Bcast', 2)
1007 
1008  return

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

Here is the call graph for this function:

◆ comm_bcast_int_2d()

subroutine scale_comm_cartesc::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 1014 of file scale_comm_cartesC.F90.

1014  use scale_prc, only: &
1015  prc_masterrank
1016  implicit none
1017 
1018  integer, intent(inout) :: var(:,:)
1019  integer, intent(in) :: gIA
1020  integer, intent(in) :: gJA
1021 
1022  integer :: counts
1023  integer :: ierr
1024  !---------------------------------------------------------------------------
1025 
1026  call prof_rapstart('COMM_Bcast', 2)
1027 
1028  counts = gia * gja
1029 
1030  call mpi_bcast( var(:,:), &
1031  counts, &
1032  mpi_integer, &
1033  prc_masterrank, &
1034  comm_world, &
1035  ierr )
1036 
1037  call prof_rapend('COMM_Bcast', 2)
1038 
1039  return

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

Here is the call graph for this function:

◆ comm_bcast_logical_scr()

subroutine scale_comm_cartesc::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 1045 of file scale_comm_cartesC.F90.

1045  use scale_prc, only: &
1046  prc_masterrank
1047  implicit none
1048 
1049  logical, intent(inout) :: var
1050 
1051  integer :: counts
1052  integer :: ierr
1053  !---------------------------------------------------------------------------
1054 
1055  call prof_rapstart('COMM_Bcast', 2)
1056 
1057  counts = 1
1058 
1059  call mpi_bcast( var, &
1060  counts, &
1061  mpi_logical, &
1062  prc_masterrank, &
1063  comm_world, &
1064  ierr )
1065 
1066  call prof_rapend('COMM_Bcast', 2)
1067 
1068  return

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

Here is the call graph for this function:

◆ comm_bcast_character()

subroutine scale_comm_cartesc::comm_bcast_character ( character(len=*), intent(inout)  var)

Broadcast data for whole process value in character.

Parameters
[in,out]varbroadcast buffer

Definition at line 1074 of file scale_comm_cartesC.F90.

1074  use scale_prc, only: &
1075  prc_masterrank
1076  implicit none
1077 
1078  character(len=*), intent(inout) :: var
1079 
1080  integer :: counts
1081  integer :: ierr
1082  !---------------------------------------------------------------------------
1083 
1084  call prof_rapstart('COMM_Bcast', 2)
1085 
1086  counts = len(var)
1087 
1088  call mpi_bcast( var, &
1089  counts, &
1090  mpi_character, &
1091  prc_masterrank, &
1092  comm_world, &
1093  ierr )
1094 
1095  call prof_rapend('COMM_Bcast', 2)
1096 
1097  return

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

Here is the call graph for this function:

◆ vars_init_mpi_pc()

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

Definition at line 1104 of file scale_comm_cartesC.F90.

1104  use scale_prc_cartesc, only: &
1105  prc_twod
1106  implicit none
1107 
1108  real(RP), intent(inout) :: var(:,:,:)
1109  integer, intent(in) :: vid
1110  integer, intent(in) :: seqid
1111 
1112  integer :: ireq, tag, ierr
1113  logical :: flag
1114 
1115  integer :: kd
1116  integer :: i
1117 
1118  tag = vid * 100
1119  ireq = 1
1120 
1121  kd = size(var, 1)
1122 
1123  ! register whole array to inner table of MPI and/or lower library
1124  ! otherwise a lot of sub small segments would be registered
1125  call mpi_send_init( var(:,:,:), size(var), comm_datatype, &
1126  mpi_proc_null, tag+comm_nreq_max+1, comm_world, &
1127  preq_list(comm_nreq_max+1,vid), ierr )
1128 
1129  !--- From 4-Direction HALO communicate
1130  ! From S
1131  call mpi_recv_init( var(:,:,js-jhalo:js-1), comm_size2d_ns4*kd, comm_datatype, &
1132  prc_next(prc_s), tag+1, comm_world, preq_list(ireq,vid), ierr )
1133  ireq = ireq + 1
1134  ! From N
1135  call mpi_recv_init( var(:,:,je+1:je+jhalo), comm_size2d_ns4*kd, comm_datatype, &
1136  prc_next(prc_n), tag+2, comm_world, preq_list(ireq,vid), ierr )
1137  ireq = ireq + 1
1138  if ( .not. prc_twod ) then
1139  ! From E
1140  call mpi_recv_init( recvpack_e2p(:,seqid), comm_size2d_we*kd, comm_datatype, &
1141  prc_next(prc_e), tag+3, comm_world, preq_list(ireq,vid), ierr )
1142  ireq = ireq + 1
1143  ! From W
1144  call mpi_recv_init( recvpack_w2p(:,seqid), comm_size2d_we*kd, comm_datatype, &
1145  prc_next(prc_w), tag+4, comm_world, preq_list(ireq,vid), ierr )
1146  ireq = ireq + 1
1147  end if
1148 
1149  !--- To 4-Direction HALO communicate
1150  if ( .not. prc_twod ) then
1151  ! To W HALO
1152  call mpi_send_init( sendpack_p2w(:,seqid), comm_size2d_we*kd, comm_datatype, &
1153  prc_next(prc_w), tag+3, comm_world, preq_list(ireq,vid), ierr )
1154  ireq = ireq + 1
1155  ! To E HALO
1156  call mpi_send_init( sendpack_p2e(:,seqid), comm_size2d_we*kd, comm_datatype, &
1157  prc_next(prc_e), tag+4, comm_world, preq_list(ireq,vid), ierr )
1158  ireq = ireq + 1
1159  end if
1160  ! To N HALO
1161  call mpi_send_init( var(:,:,je-jhalo+1:je), comm_size2d_ns4*kd, comm_datatype, &
1162  prc_next(prc_n), tag+1, comm_world, preq_list(ireq,vid), ierr )
1163  ireq = ireq + 1
1164  ! To S HALO
1165  call mpi_send_init( var(:,:,js:js+jhalo-1), comm_size2d_ns4*kd, comm_datatype, &
1166  prc_next(prc_s), tag+2, comm_world, preq_list(ireq,vid), ierr )
1167  ireq = ireq + 1
1168 
1169  preq_cnt(vid) = ireq - 1
1170  pseqid(vid) = seqid
1171 
1172  ! to finish initial processes of MPIa
1173  do i = 1, 32
1174  call mpi_testall( preq_cnt(vid), preq_list(1:preq_cnt(vid),vid), &
1175  flag, mpi_statuses_ignore, ierr )
1176  enddo
1177 
1178  return

References comm_datatype, comm_world, scale_atmos_grid_cartesc_index::je, scale_atmos_grid_cartesc_index::jhalo, scale_atmos_grid_cartesc_index::js, and scale_prc_cartesc::prc_twod.

Referenced by comm_vars_init().

Here is the caller graph for this function:

◆ vars8_init_mpi_pc()

subroutine scale_comm_cartesc::vars8_init_mpi_pc ( real(rp), dimension(:,:,:), intent(inout)  var,
integer, intent(in)  vid,
integer, intent(in)  seqid 
)

Definition at line 1182 of file scale_comm_cartesC.F90.

1182  use scale_prc_cartesc, only: &
1183  prc_twod
1184  implicit none
1185 
1186  real(RP), intent(inout) :: var(:,:,:)
1187  integer, intent(in) :: vid
1188  integer, intent(in) :: seqid
1189 
1190  integer :: ireq, tag, tagc
1191  integer :: ierr
1192  integer :: kd
1193  logical :: flag
1194 
1195  integer :: i, j
1196 
1197  kd = size(var, 1)
1198 
1199  tag = vid * 100
1200  ireq = 1
1201 
1202  ! register whole array to inner table of MPI and/or lower library
1203  ! otherwise a lot of sub small segments would be registered
1204  call mpi_send_init( var(:,:,:), size(var), comm_datatype, &
1205  mpi_proc_null, tag+comm_nreq_max+1, comm_world, &
1206  preq_list(comm_nreq_max+1,vid), ierr )
1207 
1208 
1209  if ( comm_isallperiodic ) then ! periodic condition
1210 
1211  !--- From 8-Direction HALO communicate
1212  if ( .not. prc_twod ) then
1213  ! From SE
1214  tagc = 0
1215  do j = js-jhalo, js-1
1216  call mpi_recv_init( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1217  prc_next(prc_se), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1218  ireq = ireq + 1
1219  tagc = tagc + 1
1220  enddo
1221  ! From SW
1222  tagc = 10
1223  do j = js-jhalo, js-1
1224  call mpi_recv_init( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1225  prc_next(prc_sw), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1226  ireq = ireq + 1
1227  tagc = tagc + 1
1228  enddo
1229  ! From NE
1230  tagc = 20
1231  do j = je+1, je+jhalo
1232  call mpi_recv_init( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1233  prc_next(prc_ne), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1234  ireq = ireq + 1
1235  tagc = tagc + 1
1236  enddo
1237  ! From NW
1238  tagc = 30
1239  do j = je+1, je+jhalo
1240  call mpi_recv_init( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1241  prc_next(prc_nw), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1242  ireq = ireq + 1
1243  tagc = tagc + 1
1244  enddo
1245  ! From E
1246  tagc = 60
1247  call mpi_recv_init( recvpack_e2p(:,seqid), comm_size2d_we*kd, comm_datatype, &
1248  prc_next(prc_e), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1249  ireq = ireq + 1
1250  ! From W
1251  tagc = 70
1252  call mpi_recv_init( recvpack_w2p(:,seqid), comm_size2d_we*kd, comm_datatype, &
1253  prc_next(prc_w), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1254  ireq = ireq + 1
1255  end if
1256  ! From S
1257  tagc = 40
1258  do j = js-jhalo, js-1
1259  call mpi_recv_init( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1260  prc_next(prc_s), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1261  ireq = ireq + 1
1262  tagc = tagc + 1
1263  enddo
1264  ! From N
1265  tagc = 50
1266  do j = je+1, je+jhalo
1267  call mpi_recv_init( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1268  prc_next(prc_n), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1269  ireq = ireq + 1
1270  tagc = tagc + 1
1271  enddo
1272 
1273  !--- To 8-Direction HALO communicate
1274  ! To N HALO
1275  tagc = 40
1276  do j = je-jhalo+1, je
1277  call mpi_send_init( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1278  prc_next(prc_n), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1279  ireq = ireq + 1
1280  tagc = tagc + 1
1281  enddo
1282  ! To S HALO
1283  tagc = 50
1284  do j = js, js+jhalo-1
1285  call mpi_send_init( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1286  prc_next(prc_s), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1287  ireq = ireq + 1
1288  tagc = tagc + 1
1289  enddo
1290  if ( .not. prc_twod ) then
1291  ! To W HALO
1292  tagc = 60
1293  call mpi_send_init( sendpack_p2w(:,seqid), comm_size2d_we*kd, comm_datatype, &
1294  prc_next(prc_w), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1295  ireq = ireq + 1
1296  ! To E HALO
1297  tagc = 70
1298  call mpi_send_init( sendpack_p2e(:,seqid), comm_size2d_we*kd, comm_datatype, &
1299  prc_next(prc_e), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1300  ireq = ireq + 1
1301  ! To NW HALO
1302  tagc = 0
1303  do j = je-jhalo+1, je
1304  call mpi_send_init( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
1305  prc_next(prc_nw), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1306  ireq = ireq + 1
1307  tagc = tagc + 1
1308  enddo
1309  ! To NE HALO
1310  tagc = 10
1311  do j = je-jhalo+1, je
1312  call mpi_send_init( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
1313  prc_next(prc_ne), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1314  ireq = ireq + 1
1315  tagc = tagc + 1
1316  enddo
1317  ! To SW HALO
1318  tagc = 20
1319  do j = js, js+jhalo-1
1320  call mpi_send_init( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
1321  prc_next(prc_sw), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1322  ireq = ireq + 1
1323  tagc = tagc + 1
1324  enddo
1325  ! To SE HALO
1326  tagc = 30
1327  do j = js, js+jhalo-1
1328  call mpi_send_init( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
1329  prc_next(prc_se), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1330  ireq = ireq + 1
1331  tagc = tagc + 1
1332  enddo
1333  end if
1334 
1335  else ! non-periodic condition
1336 
1337  !--- From 8-Direction HALO communicate
1338  if ( .not. prc_twod ) then
1339  ! From SE
1340  if ( prc_has_s .AND. prc_has_e ) then
1341  tagc = 0
1342  do j = js-jhalo, js-1
1343  call mpi_recv_init( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1344  prc_next(prc_se), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1345  ireq = ireq + 1
1346  tagc = tagc + 1
1347  enddo
1348  else if ( prc_has_s ) then
1349  tagc = 0
1350  do j = js-jhalo, js-1
1351  call mpi_recv_init( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1352  prc_next(prc_s), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1353  ireq = ireq + 1
1354  tagc = tagc + 1
1355  enddo
1356  else if ( prc_has_e ) then
1357  tagc = 0
1358  do j = js-jhalo, js-1
1359  call mpi_recv_init( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1360  prc_next(prc_e), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1361  ireq = ireq + 1
1362  tagc = tagc + 1
1363  enddo
1364  endif
1365  ! From SW
1366  if ( prc_has_s .AND. prc_has_w ) then
1367  tagc = 10
1368  do j = js-jhalo, js-1
1369  call mpi_recv_init( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1370  prc_next(prc_sw), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1371  ireq = ireq + 1
1372  tagc = tagc + 1
1373  enddo
1374  else if ( prc_has_s ) then
1375  tagc = 10
1376  do j = js-jhalo, js-1
1377  call mpi_recv_init( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1378  prc_next(prc_s), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1379  ireq = ireq + 1
1380  tagc = tagc + 1
1381  enddo
1382  else if ( prc_has_w ) then
1383  tagc = 10
1384  do j = js-jhalo, js-1
1385  call mpi_recv_init( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1386  prc_next(prc_w), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1387  ireq = ireq + 1
1388  tagc = tagc + 1
1389  enddo
1390  endif
1391  ! From NE
1392  if ( prc_has_n .AND. prc_has_e ) then
1393  tagc = 20
1394  do j = je+1, je+jhalo
1395  call mpi_recv_init( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1396  prc_next(prc_ne), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1397  ireq = ireq + 1
1398  tagc = tagc + 1
1399  enddo
1400  else if ( prc_has_n ) then
1401  tagc = 20
1402  do j = je+1, je+jhalo
1403  call mpi_recv_init( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1404  prc_next(prc_n), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1405  ireq = ireq + 1
1406  tagc = tagc + 1
1407  enddo
1408  else if ( prc_has_e ) then
1409  tagc = 20
1410  do j = je+1, je+jhalo
1411  call mpi_recv_init( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1412  prc_next(prc_e), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1413  ireq = ireq + 1
1414  tagc = tagc + 1
1415  enddo
1416  endif
1417  ! From NW
1418  if ( prc_has_n .AND. prc_has_w ) then
1419  tagc = 30
1420  do j = je+1, je+jhalo
1421  call mpi_recv_init( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1422  prc_next(prc_nw), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1423  ireq = ireq + 1
1424  tagc = tagc + 1
1425  enddo
1426  else if ( prc_has_n ) then
1427  tagc = 30
1428  do j = je+1, je+jhalo
1429  call mpi_recv_init( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1430  prc_next(prc_n), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1431  ireq = ireq + 1
1432  tagc = tagc + 1
1433  enddo
1434  else if ( prc_has_w ) then
1435  tagc = 30
1436  do j = je+1, je+jhalo
1437  call mpi_recv_init( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1438  prc_next(prc_w), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1439  ireq = ireq + 1
1440  tagc = tagc + 1
1441  enddo
1442  endif
1443  ! From E
1444  if ( prc_has_e ) then
1445  tagc = 60
1446  call mpi_recv_init( recvpack_e2p(:,seqid), comm_size2d_we*kd, comm_datatype, &
1447  prc_next(prc_e), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1448  ireq = ireq + 1
1449  endif
1450  ! From W
1451  if ( prc_has_w ) then
1452  tagc = 70
1453  call mpi_recv_init( recvpack_w2p(:,seqid), comm_size2d_we*kd, comm_datatype, &
1454  prc_next(prc_w), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1455  ireq = ireq + 1
1456  endif
1457  end if
1458  ! From S
1459  if ( prc_has_s ) then
1460  tagc = 40
1461  do j = js-jhalo, js-1
1462  call mpi_recv_init( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1463  prc_next(prc_s), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1464  ireq = ireq + 1
1465  tagc = tagc + 1
1466  enddo
1467  endif
1468  ! From N
1469  if ( prc_has_n ) then
1470  tagc = 50
1471  do j = je+1, je+jhalo
1472  call mpi_recv_init( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1473  prc_next(prc_n), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1474  ireq = ireq + 1
1475  tagc = tagc + 1
1476  enddo
1477  endif
1478 
1479  !--- To 8-Direction HALO communicate
1480  ! To N HALO
1481  if ( prc_has_n ) then
1482  tagc = 40
1483  do j = je-jhalo+1, je
1484  call mpi_send_init( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1485  prc_next(prc_n), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1486  ireq = ireq + 1
1487  tagc = tagc + 1
1488  enddo
1489  endif
1490  ! To S HALO
1491  if ( prc_has_s ) then
1492  tagc = 50
1493  do j = js, js+jhalo-1
1494  call mpi_send_init( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1495  prc_next(prc_s), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1496  ireq = ireq + 1
1497  tagc = tagc + 1
1498  enddo
1499  endif
1500  if ( .not. prc_twod ) then
1501  ! To W HALO
1502  if ( prc_has_w ) then
1503  tagc = 60
1504  call mpi_send_init( sendpack_p2w(:,seqid), comm_size2d_we*kd, comm_datatype, &
1505  prc_next(prc_w), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1506  ireq = ireq + 1
1507  endif
1508  ! To E HALO
1509  if ( prc_has_e ) then
1510  tagc = 70
1511  call mpi_send_init( sendpack_p2e(:,seqid), comm_size2d_we*kd, comm_datatype, &
1512  prc_next(prc_e), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1513  ireq = ireq + 1
1514  endif
1515  ! To NW HALO
1516  if ( prc_has_n .AND. prc_has_w ) then
1517  tagc = 0
1518  do j = je-jhalo+1, je
1519  call mpi_send_init( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
1520  prc_next(prc_nw), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1521  ireq = ireq + 1
1522  tagc = tagc + 1
1523  enddo
1524  else if ( prc_has_n ) then
1525  tagc = 10
1526  do j = je-jhalo+1, je
1527  call mpi_send_init( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1528  prc_next(prc_n), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1529  ireq = ireq + 1
1530  tagc = tagc + 1
1531  enddo
1532  else if ( prc_has_w ) then
1533  tagc = 20
1534  do j = je+1, je+jhalo
1535  call mpi_send_init( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
1536  prc_next(prc_w), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1537  ireq = ireq + 1
1538  tagc = tagc + 1
1539  enddo
1540  endif
1541  ! To NE HALO
1542  if ( prc_has_n .AND. prc_has_e ) then
1543  tagc = 10
1544  do j = je-jhalo+1, je
1545  call mpi_send_init( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
1546  prc_next(prc_ne), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1547  ireq = ireq + 1
1548  tagc = tagc + 1
1549  enddo
1550  else if ( prc_has_n ) then
1551  tagc = 0
1552  do j = je-jhalo+1, je
1553  call mpi_send_init( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1554  prc_next(prc_n), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1555  ireq = ireq + 1
1556  tagc = tagc + 1
1557  enddo
1558  else if ( prc_has_e ) then
1559  tagc = 30
1560  do j = je+1, je+jhalo
1561  call mpi_send_init( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
1562  prc_next(prc_e), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1563  ireq = ireq + 1
1564  tagc = tagc + 1
1565  enddo
1566  endif
1567  ! To SW HALO
1568  if ( prc_has_s .AND. prc_has_w ) then
1569  tagc = 20
1570  do j = js, js+jhalo-1
1571  call mpi_send_init( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
1572  prc_next(prc_sw), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1573  ireq = ireq + 1
1574  tagc = tagc + 1
1575  enddo
1576  else if ( prc_has_s ) then
1577  tagc = 30
1578  do j = js, js+jhalo-1
1579  call mpi_send_init( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1580  prc_next(prc_s), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1581  ireq = ireq + 1
1582  tagc = tagc + 1
1583  enddo
1584  else if ( prc_has_w ) then
1585  tagc = 0
1586  do j = js-jhalo, js-1
1587  call mpi_send_init( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
1588  prc_next(prc_w), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1589  ireq = ireq + 1
1590  tagc = tagc + 1
1591  enddo
1592  endif
1593  ! To SE HALO
1594  if ( prc_has_s .AND. prc_has_e ) then
1595  tagc = 30
1596  do j = js, js+jhalo-1
1597  call mpi_send_init( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
1598  prc_next(prc_se), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1599  ireq = ireq + 1
1600  tagc = tagc + 1
1601  enddo
1602  else if ( prc_has_s ) then
1603  tagc = 20
1604  do j = js, js+jhalo-1
1605  call mpi_send_init( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1606  prc_next(prc_s), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1607  ireq = ireq + 1
1608  tagc = tagc + 1
1609  enddo
1610  else if ( prc_has_e ) then
1611  tagc = 10
1612  do j = js-jhalo, js-1
1613  call mpi_send_init( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
1614  prc_next(prc_e), tag+tagc, comm_world, preq_list(ireq,vid), ierr )
1615  ireq = ireq + 1
1616  tagc = tagc + 1
1617  enddo
1618  endif
1619  end if
1620 
1621  endif
1622 
1623  preq_cnt(vid) = ireq - 1
1624  pseqid(vid) = seqid
1625 
1626  ! to finish initial processes of MPIa
1627  do i = 1, 32
1628  call mpi_testall( preq_cnt(vid), preq_list(1:preq_cnt(vid),vid), &
1629  flag, mpi_statuses_ignore, ierr )
1630  enddo
1631 
1632  return

References comm_datatype, comm_world, scale_atmos_grid_cartesc_index::ie, scale_atmos_grid_cartesc_index::ihalo, scale_atmos_grid_cartesc_index::is, scale_atmos_grid_cartesc_index::je, scale_atmos_grid_cartesc_index::jhalo, scale_atmos_grid_cartesc_index::js, and scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the caller graph for this function:

◆ vars_3d_mpi()

subroutine scale_comm_cartesc::vars_3d_mpi ( real(rp), dimension(:,:,:), intent(inout)  var,
integer, intent(in)  vid 
)
Parameters
[in,out]varatmospheric 3D variable to communication
[in]vidrequest ID

Definition at line 1636 of file scale_comm_cartesC.F90.

1636  use scale_prc, only: &
1637  prc_abort
1638  use scale_prc_cartesc, only: &
1639  prc_twod
1640  implicit none
1641 
1642  real(RP), intent(inout) :: var(:,:,:)
1643  integer, intent(in) :: vid
1644 
1645 
1646  integer :: ireq, tag
1647 
1648  integer :: kd
1649  integer :: ierr
1650  !---------------------------------------------------------------------------
1651 
1652  tag = vid * 100
1653  ireq = 1
1654 
1655  kd = size(var, 1)
1656 
1657 #ifdef DEBUG
1658  if ( use_packbuf(vid) ) then
1659  log_error("vars_3D_mpi",*) 'packing buffer is already used', vid
1660  call prc_abort
1661  end if
1662  use_packbuf(vid) = .true.
1663 #endif
1664 
1665  if ( comm_isallperiodic ) then ! periodic condition
1666 
1667  !--- From 4-Direction HALO communicate
1668  ! From S
1669  call mpi_irecv( var(:,:,js-jhalo:js-1), comm_size2d_ns4*kd, comm_datatype, &
1670  prc_next(prc_s), tag+1, comm_world, req_list(ireq,vid), ierr )
1671  ireq = ireq + 1
1672  ! From N
1673  call mpi_irecv( var(:,:,je+1:je+jhalo), comm_size2d_ns4*kd, comm_datatype, &
1674  prc_next(prc_n), tag+2, comm_world, req_list(ireq,vid), ierr )
1675  ireq = ireq + 1
1676  if ( .not. prc_twod ) then
1677  ! From E
1678  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we*kd, comm_datatype, &
1679  prc_next(prc_e), tag+3, comm_world, req_list(ireq,vid), ierr )
1680  ireq = ireq + 1
1681  ! From W
1682  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we*kd, comm_datatype, &
1683  prc_next(prc_w), tag+4, comm_world, req_list(ireq,vid), ierr )
1684  ireq = ireq + 1
1685  end if
1686 
1687  !--- To 4-Direction HALO communicate
1688  if ( .not. prc_twod ) then
1689  call pack_3d(var, vid)
1690 
1691  ! To W HALO
1692  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we*kd, comm_datatype, &
1693  prc_next(prc_w), tag+3, comm_world, req_list(ireq,vid), ierr )
1694  ireq = ireq + 1
1695  ! To E HALO
1696  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we*kd, comm_datatype, &
1697  prc_next(prc_e), tag+4, comm_world, req_list(ireq,vid), ierr )
1698  ireq = ireq + 1
1699  end if
1700  ! To N HALO
1701  call mpi_isend( var(:,:,je-jhalo+1:je), comm_size2d_ns4*kd, comm_datatype, &
1702  prc_next(prc_n), tag+1, comm_world, req_list(ireq,vid), ierr )
1703  ireq = ireq + 1
1704  ! To S HALO
1705  call mpi_isend( var(:,:,js:js+jhalo-1), comm_size2d_ns4*kd, comm_datatype, &
1706  prc_next(prc_s), tag+2, comm_world, req_list(ireq,vid), ierr )
1707  ireq = ireq + 1
1708 
1709  else ! non-periodic condition
1710 
1711  !--- From 4-Direction HALO communicate
1712  ! From S
1713  if ( prc_has_s ) then
1714  call mpi_irecv( var(:,:,js-jhalo:js-1), comm_size2d_ns4*kd, comm_datatype, &
1715  prc_next(prc_s), tag+1, comm_world, req_list(ireq,vid), ierr )
1716  ireq = ireq + 1
1717  endif
1718  ! From N
1719  if ( prc_has_n ) then
1720  call mpi_irecv( var(:,:,je+1:je+jhalo), comm_size2d_ns4*kd, comm_datatype, &
1721  prc_next(prc_n), tag+2, comm_world, req_list(ireq,vid), ierr )
1722  ireq = ireq + 1
1723  endif
1724  if ( .not. prc_twod ) then
1725  ! From E
1726  if ( prc_has_e ) then
1727  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we*kd, comm_datatype, &
1728  prc_next(prc_e), tag+3, comm_world, req_list(ireq,vid), ierr )
1729  ireq = ireq + 1
1730  endif
1731  ! From W
1732  if ( prc_has_w ) then
1733  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we*kd, comm_datatype, &
1734  prc_next(prc_w), tag+4, comm_world, req_list(ireq,vid), ierr )
1735  ireq = ireq + 1
1736  endif
1737  end if
1738 
1739  !--- To 4-Direction HALO communicate
1740  if ( .not. prc_twod ) then
1741 
1742  call pack_3d(var, vid)
1743 
1744  ! To W HALO
1745  if ( prc_has_w ) then
1746  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we*kd, comm_datatype, &
1747  prc_next(prc_w), tag+3, comm_world, req_list(ireq,vid), ierr )
1748  ireq = ireq + 1
1749  endif
1750  ! To E HALO
1751  if ( prc_has_e ) then
1752  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we*kd, comm_datatype, &
1753  prc_next(prc_e), tag+4, comm_world, req_list(ireq,vid), ierr )
1754  ireq = ireq + 1
1755  endif
1756  end if
1757  ! To N HALO
1758  if ( prc_has_n ) then
1759  call mpi_isend( var(:,:,je-jhalo+1:je), comm_size2d_ns4*kd, comm_datatype, &
1760  prc_next(prc_n), tag+1, comm_world, req_list(ireq,vid), ierr )
1761  ireq = ireq + 1
1762  endif
1763  ! To S HALO
1764  if ( prc_has_s ) then
1765  call mpi_isend( var(:,:,js:js+jhalo-1), comm_size2d_ns4*kd, comm_datatype, &
1766  prc_next(prc_s), tag+2, comm_world, req_list(ireq,vid), ierr )
1767  ireq = ireq + 1
1768  endif
1769 
1770  endif
1771 
1772  req_cnt(vid) = ireq - 1
1773 
1774  return

References comm_datatype, comm_world, scale_atmos_grid_cartesc_index::je, scale_atmos_grid_cartesc_index::jhalo, scale_atmos_grid_cartesc_index::js, pack_3d(), scale_prc::prc_abort(), and scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ vars8_3d_mpi()

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

Definition at line 1778 of file scale_comm_cartesC.F90.

1778  use scale_prc, only: &
1779  prc_abort
1780  use scale_prc_cartesc, only: &
1781  prc_twod
1782  implicit none
1783 
1784  real(RP), intent(inout) :: var(:,:,:)
1785  integer, intent(in) :: vid
1786 
1787  integer :: ireq, tag, tagc
1788 
1789  integer :: kd
1790 
1791  integer :: ierr
1792  integer :: j
1793  !---------------------------------------------------------------------------
1794 
1795  tag = vid * 100
1796  ireq = 1
1797 
1798  kd = size(var, 1)
1799 
1800 #ifdef DEBUG
1801  if ( use_packbuf(vid) ) then
1802  log_error("vars8_3D_mpi",*) 'packing buffer is already used', vid
1803  call prc_abort
1804  end if
1805  use_packbuf(vid) = .true.
1806 #endif
1807 
1808  if ( comm_isallperiodic ) then ! periodic condition
1809 
1810  !--- From 8-Direction HALO communicate
1811  if ( .not. prc_twod ) then
1812  ! From SE
1813  tagc = 0
1814  do j = js-jhalo, js-1
1815  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1816  prc_next(prc_se), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1817  ireq = ireq + 1
1818  tagc = tagc + 1
1819  enddo
1820  ! From SW
1821  tagc = 10
1822  do j = js-jhalo, js-1
1823  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1824  prc_next(prc_sw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1825  ireq = ireq + 1
1826  tagc = tagc + 1
1827  enddo
1828  ! From NE
1829  tagc = 20
1830  do j = je+1, je+jhalo
1831  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1832  prc_next(prc_ne), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1833  ireq = ireq + 1
1834  tagc = tagc + 1
1835  enddo
1836  ! From NW
1837  tagc = 30
1838  do j = je+1, je+jhalo
1839  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1840  prc_next(prc_nw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1841  ireq = ireq + 1
1842  tagc = tagc + 1
1843  enddo
1844  ! From E
1845  tagc = 60
1846  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we*kd, comm_datatype, &
1847  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1848  ireq = ireq + 1
1849  ! From W
1850  tagc = 70
1851  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we*kd, comm_datatype, &
1852  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1853  ireq = ireq + 1
1854  end if
1855  ! From S
1856  tagc = 40
1857  do j = js-jhalo, js-1
1858  call mpi_irecv( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1859  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1860  ireq = ireq + 1
1861  tagc = tagc + 1
1862  enddo
1863  ! From N
1864  tagc = 50
1865  do j = je+1, je+jhalo
1866  call mpi_irecv( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1867  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1868  ireq = ireq + 1
1869  tagc = tagc + 1
1870  enddo
1871 
1872  !--- To 8-Direction HALO communicate
1873  ! To N HALO
1874  tagc = 40
1875  do j = je-jhalo+1, je
1876  call mpi_isend( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1877  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1878  ireq = ireq + 1
1879  tagc = tagc + 1
1880  enddo
1881  ! To S HALO
1882  tagc = 50
1883  do j = js, js+jhalo-1
1884  call mpi_isend( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1885  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1886  ireq = ireq + 1
1887  tagc = tagc + 1
1888  enddo
1889  if ( .not. prc_twod ) then
1890 
1891  call pack_3d(var, vid)
1892 
1893  ! To W HALO
1894  tagc = 60
1895  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we*kd, comm_datatype, &
1896  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1897  ireq = ireq + 1
1898  ! To E HALO
1899  tagc = 70
1900  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we*kd, comm_datatype, &
1901  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1902  ireq = ireq + 1
1903  ! To NW HALO
1904  tagc = 0
1905  do j = je-jhalo+1, je
1906  call mpi_isend( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
1907  prc_next(prc_nw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1908  ireq = ireq + 1
1909  tagc = tagc + 1
1910  enddo
1911  ! To NE HALO
1912  tagc = 10
1913  do j = je-jhalo+1, je
1914  call mpi_isend( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
1915  prc_next(prc_ne), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1916  ireq = ireq + 1
1917  tagc = tagc + 1
1918  enddo
1919  ! To SW HALO
1920  tagc = 20
1921  do j = js, js+jhalo-1
1922  call mpi_isend( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
1923  prc_next(prc_sw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1924  ireq = ireq + 1
1925  tagc = tagc + 1
1926  enddo
1927  ! To SE HALO
1928  tagc = 30
1929  do j = js, js+jhalo-1
1930  call mpi_isend( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
1931  prc_next(prc_se), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1932  ireq = ireq + 1
1933  tagc = tagc + 1
1934  enddo
1935  end if
1936 
1937  else ! non-periodic condition
1938 
1939  !--- From 8-Direction HALO communicate
1940  if ( .not. prc_twod ) then
1941  ! From SE
1942  if ( prc_has_s .AND. prc_has_e ) then
1943  tagc = 0
1944  do j = js-jhalo, js-1
1945  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1946  prc_next(prc_se), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1947  ireq = ireq + 1
1948  tagc = tagc + 1
1949  enddo
1950  else if ( prc_has_s ) then
1951  tagc = 0
1952  do j = js-jhalo, js-1
1953  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1954  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1955  ireq = ireq + 1
1956  tagc = tagc + 1
1957  enddo
1958  else if ( prc_has_e ) then
1959  tagc = 0
1960  do j = js-jhalo, js-1
1961  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1962  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1963  ireq = ireq + 1
1964  tagc = tagc + 1
1965  enddo
1966  endif
1967  ! From SW
1968  if ( prc_has_s .AND. prc_has_w ) then
1969  tagc = 10
1970  do j = js-jhalo, js-1
1971  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1972  prc_next(prc_sw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1973  ireq = ireq + 1
1974  tagc = tagc + 1
1975  enddo
1976  else if ( prc_has_s ) then
1977  tagc = 10
1978  do j = js-jhalo, js-1
1979  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1980  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1981  ireq = ireq + 1
1982  tagc = tagc + 1
1983  enddo
1984  else if ( prc_has_w ) then
1985  tagc = 10
1986  do j = js-jhalo, js-1
1987  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1988  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1989  ireq = ireq + 1
1990  tagc = tagc + 1
1991  enddo
1992  endif
1993  ! From NE
1994  if ( prc_has_n .AND. prc_has_e ) then
1995  tagc = 20
1996  do j = je+1, je+jhalo
1997  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1998  prc_next(prc_ne), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1999  ireq = ireq + 1
2000  tagc = tagc + 1
2001  enddo
2002  else if ( prc_has_n ) then
2003  tagc = 20
2004  do j = je+1, je+jhalo
2005  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
2006  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2007  ireq = ireq + 1
2008  tagc = tagc + 1
2009  enddo
2010  else if ( prc_has_e ) then
2011  tagc = 20
2012  do j = je+1, je+jhalo
2013  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
2014  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2015  ireq = ireq + 1
2016  tagc = tagc + 1
2017  enddo
2018  endif
2019  ! From NW
2020  if ( prc_has_n .AND. prc_has_w ) then
2021  tagc = 30
2022  do j = je+1, je+jhalo
2023  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
2024  prc_next(prc_nw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2025  ireq = ireq + 1
2026  tagc = tagc + 1
2027  enddo
2028  else if ( prc_has_n ) then
2029  tagc = 30
2030  do j = je+1, je+jhalo
2031  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
2032  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2033  ireq = ireq + 1
2034  tagc = tagc + 1
2035  enddo
2036  else if ( prc_has_w ) then
2037  tagc = 30
2038  do j = je+1, je+jhalo
2039  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
2040  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2041  ireq = ireq + 1
2042  tagc = tagc + 1
2043  enddo
2044  endif
2045  ! From E
2046  if ( prc_has_e ) then
2047  tagc = 60
2048  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we*kd, comm_datatype, &
2049  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2050  ireq = ireq + 1
2051  endif
2052  ! From W
2053  if ( prc_has_w ) then
2054  tagc = 70
2055  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we*kd, comm_datatype, &
2056  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2057  ireq = ireq + 1
2058  endif
2059  end if
2060  ! From S
2061  if ( prc_has_s ) then
2062  tagc = 40
2063  do j = js-jhalo, js-1
2064  call mpi_irecv( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
2065  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2066  ireq = ireq + 1
2067  tagc = tagc + 1
2068  enddo
2069  endif
2070  ! From N
2071  if ( prc_has_n ) then
2072  tagc = 50
2073  do j = je+1, je+jhalo
2074  call mpi_irecv( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
2075  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2076  ireq = ireq + 1
2077  tagc = tagc + 1
2078  enddo
2079  endif
2080 
2081  !--- To 8-Direction HALO communicate
2082  ! To N HALO
2083  if ( prc_has_n ) then
2084  tagc = 40
2085  do j = je-jhalo+1, je
2086  call mpi_isend( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
2087  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2088  ireq = ireq + 1
2089  tagc = tagc + 1
2090  enddo
2091  endif
2092  ! To S HALO
2093  if ( prc_has_s ) then
2094  tagc = 50
2095  do j = js, js+jhalo-1
2096  call mpi_isend( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
2097  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2098  ireq = ireq + 1
2099  tagc = tagc + 1
2100  enddo
2101  endif
2102  if ( .not. prc_twod ) then
2103 
2104  call pack_3d(var, vid)
2105 
2106  ! To W HALO
2107  if ( prc_has_w ) then
2108  tagc = 60
2109  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we*kd, comm_datatype, &
2110  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2111  ireq = ireq + 1
2112  endif
2113  ! To E HALO
2114  if ( prc_has_e ) then
2115  tagc = 70
2116  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we*kd, comm_datatype, &
2117  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2118  ireq = ireq + 1
2119  endif
2120 
2121  ! To NW HALO
2122  if ( prc_has_n .AND. prc_has_w ) then
2123  tagc = 0
2124  do j = je-jhalo+1, je
2125  call mpi_isend( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
2126  prc_next(prc_nw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2127  ireq = ireq + 1
2128  tagc = tagc + 1
2129  enddo
2130  else if ( prc_has_n ) then
2131  tagc = 10
2132  do j = je-jhalo+1, je
2133  call mpi_isend( var(1,1,j), comm_size2d_4c*kd, comm_datatype, &
2134  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2135  ireq = ireq + 1
2136  tagc = tagc + 1
2137  enddo
2138  else if ( prc_has_w ) then
2139  tagc = 20
2140  do j = je+1, je+jhalo
2141  call mpi_isend( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
2142  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2143  ireq = ireq + 1
2144  tagc = tagc + 1
2145  enddo
2146  endif
2147  ! To NE HALO
2148  if ( prc_has_n .AND. prc_has_e ) then
2149  tagc = 10
2150  do j = je-jhalo+1, je
2151  call mpi_isend( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
2152  prc_next(prc_ne), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2153  ireq = ireq + 1
2154  tagc = tagc + 1
2155  enddo
2156  else if ( prc_has_n ) then
2157  tagc = 0
2158  do j = je-jhalo+1, je
2159  call mpi_isend( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
2160  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2161  ireq = ireq + 1
2162  tagc = tagc + 1
2163  enddo
2164  else if ( prc_has_e ) then
2165  tagc = 30
2166  do j = je+1, je+jhalo
2167  call mpi_isend( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
2168  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2169  ireq = ireq + 1
2170  tagc = tagc + 1
2171  enddo
2172  endif
2173  ! To SW HALO
2174  if ( prc_has_s .AND. prc_has_w ) then
2175  tagc = 20
2176  do j = js, js+jhalo-1
2177  call mpi_isend( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
2178  prc_next(prc_sw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2179  ireq = ireq + 1
2180  tagc = tagc + 1
2181  enddo
2182  else if ( prc_has_s ) then
2183  tagc = 30
2184  do j = js, js+jhalo-1
2185  call mpi_isend( var(1,1,j), comm_size2d_4c*kd, comm_datatype, &
2186  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2187  ireq = ireq + 1
2188  tagc = tagc + 1
2189  enddo
2190  else if ( prc_has_w ) then
2191  tagc = 0
2192  do j = js-jhalo, js-1
2193  call mpi_isend( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
2194  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2195  ireq = ireq + 1
2196  tagc = tagc + 1
2197  enddo
2198  endif
2199  ! To SE HALO
2200  if ( prc_has_s .AND. prc_has_e ) then
2201  tagc = 30
2202  do j = js, js+jhalo-1
2203  call mpi_isend( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
2204  prc_next(prc_se), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2205  ireq = ireq + 1
2206  tagc = tagc + 1
2207  enddo
2208  else if ( prc_has_s ) then
2209  tagc = 20
2210  do j = js, js+jhalo-1
2211  call mpi_isend( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
2212  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2213  ireq = ireq + 1
2214  tagc = tagc + 1
2215  enddo
2216  else if ( prc_has_e ) then
2217  tagc = 10
2218  do j = js-jhalo, js-1
2219  call mpi_isend( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
2220  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2221  ireq = ireq + 1
2222  tagc = tagc + 1
2223  enddo
2224  endif
2225  end if
2226 
2227  endif
2228 
2229  req_cnt(vid) = ireq - 1
2230 
2231  return

References comm_datatype, comm_world, scale_atmos_grid_cartesc_index::ie, scale_atmos_grid_cartesc_index::ihalo, scale_atmos_grid_cartesc_index::is, scale_atmos_grid_cartesc_index::je, scale_atmos_grid_cartesc_index::jhalo, scale_atmos_grid_cartesc_index::js, pack_3d(), scale_prc::prc_abort(), and scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ vars_2d_mpi()

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

Definition at line 2235 of file scale_comm_cartesC.F90.

2235  use scale_prc, only: &
2236  prc_abort
2237  use scale_prc_cartesc, only: &
2238  prc_twod
2239  implicit none
2240 
2241  real(RP), intent(inout) :: var(:,:)
2242  integer, intent(in) :: vid
2243 
2244  integer :: ireq, tag
2245  integer :: ierr
2246  !---------------------------------------------------------------------------
2247 
2248  tag = vid * 100
2249  ireq = 1
2250 
2251 #ifdef DEBUG
2252  if ( use_packbuf(vid) ) then
2253  log_error("vars_2D_mpi",*) 'packing buffer is already used', vid
2254  call prc_abort
2255  end if
2256  use_packbuf(vid) = .true.
2257 #endif
2258 
2259  if ( comm_isallperiodic ) then
2260  !--- periodic condition
2261  !--- From 4-Direction HALO communicate
2262  ! From S
2263  call mpi_irecv( var(:,js-jhalo:js-1), comm_size2d_ns4, &
2264  comm_datatype, prc_next(prc_s), tag+1, &
2265  comm_world, req_list(ireq,vid), ierr )
2266  ireq = ireq + 1
2267 
2268  ! From N
2269  call mpi_irecv( var(:,je+1:je+jhalo), comm_size2d_ns4, &
2270  comm_datatype, prc_next(prc_n), tag+2, &
2271  comm_world, req_list(ireq,vid), ierr )
2272  ireq = ireq + 1
2273 
2274  if ( .not. prc_twod ) then
2275  ! From E
2276  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we, &
2277  comm_datatype, prc_next(prc_e), tag+3, &
2278  comm_world, req_list(ireq,vid), ierr )
2279  ireq = ireq + 1
2280 
2281  ! From W
2282  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we, &
2283  comm_datatype, prc_next(prc_w), tag+4, &
2284  comm_world, req_list(ireq,vid), ierr )
2285  ireq = ireq + 1
2286  end if
2287 
2288 
2289  !--- To 4-Direction HALO communicate
2290 
2291  if ( .not. prc_twod ) then
2292 
2293  call pack_2d(var, vid)
2294 
2295  ! To W HALO communicate
2296  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we, &
2297  comm_datatype, prc_next(prc_w), tag+3, &
2298  comm_world, req_list(ireq,vid), ierr )
2299  ireq = ireq + 1
2300 
2301  ! To E HALO communicate
2302  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we, &
2303  comm_datatype, prc_next(prc_e), tag+4, &
2304  comm_world, req_list(ireq,vid), ierr )
2305  ireq = ireq + 1
2306  end if
2307 
2308  ! To N HALO communicate
2309  call mpi_isend( var(:,je-jhalo+1:je), comm_size2d_ns4, &
2310  comm_datatype, prc_next(prc_n), tag+1, &
2311  comm_world, req_list(ireq,vid), ierr )
2312  ireq = ireq + 1
2313 
2314  ! To S HALO communicate
2315  call mpi_isend( var(:,js:js+jhalo-1), comm_size2d_ns4, &
2316  comm_datatype, prc_next(prc_s), tag+2, &
2317  comm_world, req_list(ireq,vid), ierr )
2318  ireq = ireq + 1
2319 
2320  else
2321  !--- non-periodic condition
2322  !--- From 4-Direction HALO communicate
2323  ! From S
2324  if ( prc_has_s ) then
2325  call mpi_irecv( var(:,js-jhalo:js-1), comm_size2d_ns4, &
2326  comm_datatype, prc_next(prc_s), tag+1, &
2327  comm_world, req_list(ireq,vid), ierr )
2328  ireq = ireq + 1
2329  endif
2330 
2331  ! From N
2332  if ( prc_has_n ) then
2333  call mpi_irecv( var(:,je+1:je+jhalo), comm_size2d_ns4, &
2334  comm_datatype, prc_next(prc_n), tag+2, &
2335  comm_world, req_list(ireq,vid), ierr )
2336  ireq = ireq + 1
2337  endif
2338 
2339  if ( .not. prc_twod ) then
2340  ! From E
2341  if ( prc_has_e ) then
2342  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we, &
2343  comm_datatype, prc_next(prc_e), tag+3, &
2344  comm_world, req_list(ireq,vid), ierr )
2345  ireq = ireq + 1
2346  endif
2347 
2348  ! From W
2349  if ( prc_has_w ) then
2350  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we, &
2351  comm_datatype, prc_next(prc_w), tag+4, &
2352  comm_world, req_list(ireq,vid), ierr )
2353  ireq = ireq + 1
2354  endif
2355  end if
2356 
2357 
2358  !--- To 4-Direction HALO communicate
2359 
2360  if ( .not. prc_twod ) then
2361 
2362  call pack_2d(var, vid)
2363 
2364  ! To W HALO communicate
2365  if ( prc_has_w ) then
2366  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we, &
2367  comm_datatype, prc_next(prc_w), tag+3, &
2368  comm_world, req_list(ireq,vid), ierr )
2369  ireq = ireq + 1
2370  endif
2371 
2372  ! To E HALO communicate
2373  if ( prc_has_e ) then
2374  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we, &
2375  comm_datatype, prc_next(prc_e), tag+4, &
2376  comm_world, req_list(ireq,vid), ierr )
2377  ireq = ireq + 1
2378  endif
2379  end if
2380 
2381  ! To N HALO communicate
2382  if ( prc_has_n ) then
2383  call mpi_isend( var(:,je-jhalo+1:je), comm_size2d_ns4, &
2384  comm_datatype, prc_next(prc_n), tag+1, &
2385  comm_world, req_list(ireq,vid), ierr )
2386  ireq = ireq + 1
2387  endif
2388 
2389  ! To S HALO communicate
2390  if ( prc_has_s ) then
2391  call mpi_isend( var(:,js:js+jhalo-1), comm_size2d_ns4, &
2392  comm_datatype, prc_next(prc_s), tag+2, &
2393  comm_world, req_list(ireq,vid), ierr )
2394  ireq = ireq + 1
2395  endif
2396 
2397  endif
2398 
2399  req_cnt(vid) = ireq - 1
2400 
2401  return

References comm_datatype, comm_world, scale_atmos_grid_cartesc_index::je, scale_atmos_grid_cartesc_index::jhalo, scale_atmos_grid_cartesc_index::js, scale_prc::prc_abort(), and scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ vars8_2d_mpi()

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

Definition at line 2405 of file scale_comm_cartesC.F90.

2405  use scale_prc, only: &
2406  prc_abort
2407  use scale_prc_cartesc, only: &
2408  prc_twod
2409  implicit none
2410 
2411  real(RP), intent(inout) :: var(:,:)
2412  integer, intent(in) :: vid
2413 
2414  integer :: ireq, tag, tagc
2415 
2416  integer :: ierr
2417  integer :: j
2418  !---------------------------------------------------------------------------
2419 
2420  tag = vid * 100
2421  ireq = 1
2422 
2423 #ifdef DEBUG
2424  if ( use_packbuf(vid) ) then
2425  log_error("vars8_2D_mpi",*) 'packing buffer is already used', vid
2426  call prc_abort
2427  end if
2428  use_packbuf(vid) = .true.
2429 #endif
2430 
2431  if ( comm_isallperiodic ) then
2432  !--- periodic condition
2433  !--- From 8-Direction HALO communicate
2434  if ( .not. prc_twod ) then
2435  ! From SE
2436  tagc = 0
2437  do j = js-jhalo, js-1
2438  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2439  comm_datatype, prc_next(prc_se), tag+tagc, &
2440  comm_world, req_list(ireq,vid), ierr )
2441  ireq = ireq + 1
2442  tagc = tagc + 1
2443  enddo
2444  ! From SW
2445  tagc = 10
2446  do j = js-jhalo, js-1
2447  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2448  comm_datatype, prc_next(prc_sw), tag+tagc, &
2449  comm_world, req_list(ireq,vid), ierr )
2450  ireq = ireq + 1
2451  tagc = tagc + 1
2452  enddo
2453  ! From NE
2454  tagc = 20
2455  do j = je+1, je+jhalo
2456  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2457  comm_datatype, prc_next(prc_ne), tag+tagc, &
2458  comm_world, req_list(ireq,vid), ierr )
2459  ireq = ireq + 1
2460  tagc = tagc + 1
2461  enddo
2462  ! From NW
2463  tagc = 30
2464  do j = je+1, je+jhalo
2465  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2466  comm_datatype, prc_next(prc_nw), tag+tagc, &
2467  comm_world, req_list(ireq,vid), ierr )
2468  ireq = ireq + 1
2469  tagc = tagc + 1
2470  enddo
2471  ! From E
2472  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we, &
2473  comm_datatype, prc_next(prc_e), tag+60, &
2474  comm_world, req_list(ireq,vid), ierr )
2475  ireq = ireq + 1
2476  ! From W
2477  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we, &
2478  comm_datatype, prc_next(prc_w), tag+70, &
2479  comm_world, req_list(ireq,vid), ierr )
2480  ireq = ireq + 1
2481  end if
2482  ! From S
2483  tagc = 40
2484  do j = js-jhalo, js-1
2485  call mpi_irecv( var(is,j), comm_size2d_ns8, &
2486  comm_datatype, prc_next(prc_s), tag+tagc, &
2487  comm_world, req_list(ireq,vid), ierr )
2488  ireq = ireq + 1
2489  tagc = tagc + 1
2490  enddo
2491  ! From N
2492  tagc = 50
2493  do j = je+1, je+jhalo
2494  call mpi_irecv( var(is,j), comm_size2d_ns8, &
2495  comm_datatype, prc_next(prc_n), tag+tagc, &
2496  comm_world, req_list(ireq,vid), ierr )
2497  ireq = ireq + 1
2498  tagc = tagc + 1
2499  enddo
2500 
2501 
2502  !--- To 8-Direction HALO communicate
2503 
2504  ! To N HALO communicate
2505  tagc = 40
2506  do j = je-jhalo+1, je
2507  call mpi_isend( var(is,j), comm_size2d_ns8, &
2508  comm_datatype, prc_next(prc_n), tag+tagc, &
2509  comm_world, req_list(ireq,vid), ierr )
2510  ireq = ireq + 1
2511  tagc = tagc + 1
2512  enddo
2513 
2514  ! To S HALO communicate
2515  tagc = 50
2516  do j = js, js+jhalo-1
2517  call mpi_isend( var(is,j), comm_size2d_ns8, &
2518  comm_datatype, prc_next(prc_s), tag+tagc, &
2519  comm_world, req_list(ireq,vid), ierr )
2520  ireq = ireq + 1
2521  tagc = tagc + 1
2522  enddo
2523 
2524  if ( .not. prc_twod ) then
2525 
2526  call pack_2d(var, vid)
2527 
2528  ! To W HALO communicate
2529  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we, &
2530  comm_datatype, prc_next(prc_w), tag+60, &
2531  comm_world, req_list(ireq,vid), ierr )
2532  ireq = ireq + 1
2533 
2534  ! To E HALO communicate
2535  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we, &
2536  comm_datatype, prc_next(prc_e), tag+70, &
2537  comm_world, req_list(ireq,vid), ierr )
2538  ireq = ireq + 1
2539 
2540  ! To NW HALO communicate
2541  tagc = 0
2542  do j = je-jhalo+1, je
2543  call mpi_isend( var(is,j), comm_size2d_4c, &
2544  comm_datatype, prc_next(prc_nw), tag+tagc, &
2545  comm_world, req_list(ireq,vid), ierr )
2546  ireq = ireq + 1
2547  tagc = tagc + 1
2548  enddo
2549 
2550  ! To NE HALO communicate
2551  tagc = 10
2552  do j = je-jhalo+1, je
2553  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2554  comm_datatype, prc_next(prc_ne), tag+tagc, &
2555  comm_world, req_list(ireq,vid), ierr )
2556  ireq = ireq + 1
2557  tagc = tagc + 1
2558  enddo
2559 
2560  ! To SW HALO communicate
2561  tagc = 20
2562  do j = js, js+jhalo-1
2563  call mpi_isend( var(is,j), comm_size2d_4c, &
2564  comm_datatype, prc_next(prc_sw), tag+tagc, &
2565  comm_world, req_list(ireq,vid), ierr )
2566  ireq = ireq + 1
2567  tagc = tagc + 1
2568  enddo
2569 
2570  ! To SE HALO communicate
2571  tagc = 30
2572  do j = js, js+jhalo-1
2573  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2574  comm_datatype, prc_next(prc_se), tag+tagc, &
2575  comm_world, req_list(ireq,vid), ierr )
2576  ireq = ireq + 1
2577  tagc = tagc + 1
2578  enddo
2579  end if
2580  else
2581  !--- non-periodic condition
2582  !--- From 8-Direction HALO communicate
2583  if ( .not. prc_twod ) then
2584  ! From SE
2585  if ( prc_has_s .AND. prc_has_e ) then
2586  tagc = 0
2587  do j = js-jhalo, js-1
2588  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2589  comm_datatype, prc_next(prc_se), tag+tagc, &
2590  comm_world, req_list(ireq,vid), ierr )
2591  ireq = ireq + 1
2592  tagc = tagc + 1
2593  enddo
2594  else if ( prc_has_s ) then
2595  tagc = 0
2596  do j = js-jhalo, js-1
2597  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2598  comm_datatype, prc_next(prc_s), tag+tagc, &
2599  comm_world, req_list(ireq,vid), ierr )
2600  ireq = ireq + 1
2601  tagc = tagc + 1
2602  enddo
2603  else if ( prc_has_e ) then
2604  tagc = 0
2605  do j = js-jhalo, js-1
2606  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2607  comm_datatype, prc_next(prc_e), tag+tagc, &
2608  comm_world, req_list(ireq,vid), ierr )
2609  ireq = ireq + 1
2610  tagc = tagc + 1
2611  enddo
2612  endif
2613 
2614  ! From SW
2615  if ( prc_has_s .AND. prc_has_w ) then
2616  tagc = 10
2617  do j = js-jhalo, js-1
2618  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2619  comm_datatype, prc_next(prc_sw), tag+tagc, &
2620  comm_world, req_list(ireq,vid), ierr )
2621  ireq = ireq + 1
2622  tagc = tagc + 1
2623  enddo
2624  else if ( prc_has_s ) then
2625  tagc = 10
2626  do j = js-jhalo, js-1
2627  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2628  comm_datatype, prc_next(prc_s), tag+tagc, &
2629  comm_world, req_list(ireq,vid), ierr )
2630  ireq = ireq + 1
2631  tagc = tagc + 1
2632  enddo
2633  else if ( prc_has_w ) then
2634  tagc = 10
2635  do j = js-jhalo, js-1
2636  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2637  comm_datatype, prc_next(prc_w), tag+tagc, &
2638  comm_world, req_list(ireq,vid), ierr )
2639  ireq = ireq + 1
2640  tagc = tagc + 1
2641  enddo
2642  endif
2643 
2644  ! From NE
2645  if ( prc_has_n .AND. prc_has_e ) then
2646  tagc = 20
2647  do j = je+1, je+jhalo
2648  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2649  comm_datatype, prc_next(prc_ne), tag+tagc, &
2650  comm_world, req_list(ireq,vid), ierr )
2651  ireq = ireq + 1
2652  tagc = tagc + 1
2653  enddo
2654  else if ( prc_has_n ) then
2655  tagc = 20
2656  do j = je+1, je+jhalo
2657  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2658  comm_datatype, prc_next(prc_n), tag+tagc, &
2659  comm_world, req_list(ireq,vid), ierr )
2660  ireq = ireq + 1
2661  tagc = tagc + 1
2662  enddo
2663  else if ( prc_has_e ) then
2664  tagc = 20
2665  do j = je+1, je+jhalo
2666  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2667  comm_datatype, prc_next(prc_e), tag+tagc, &
2668  comm_world, req_list(ireq,vid), ierr )
2669  ireq = ireq + 1
2670  tagc = tagc + 1
2671  enddo
2672  endif
2673 
2674  ! From NW
2675  if ( prc_has_n .AND. prc_has_w ) then
2676  tagc = 30
2677  do j = je+1, je+jhalo
2678  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2679  comm_datatype, prc_next(prc_nw), tag+tagc, &
2680  comm_world, req_list(ireq,vid), ierr )
2681  ireq = ireq + 1
2682  tagc = tagc + 1
2683  enddo
2684  else if ( prc_has_n ) then
2685  tagc = 30
2686  do j = je+1, je+jhalo
2687  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2688  comm_datatype, prc_next(prc_n), tag+tagc, &
2689  comm_world, req_list(ireq,vid), ierr )
2690  ireq = ireq + 1
2691  tagc = tagc + 1
2692  enddo
2693  else if ( prc_has_w ) then
2694  tagc = 30
2695  do j = je+1, je+jhalo
2696  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2697  comm_datatype, prc_next(prc_w), tag+tagc, &
2698  comm_world, req_list(ireq,vid), ierr )
2699  ireq = ireq + 1
2700  tagc = tagc + 1
2701  enddo
2702  endif
2703 
2704  ! From E
2705  if ( prc_has_e ) then
2706  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we, &
2707  comm_datatype, prc_next(prc_e), tag+60, &
2708  comm_world, req_list(ireq,vid), ierr )
2709  ireq = ireq + 1
2710  endif
2711 
2712  ! From W
2713  if ( prc_has_w ) then
2714  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we, &
2715  comm_datatype, prc_next(prc_w), tag+70, &
2716  comm_world, req_list(ireq,vid), ierr )
2717  ireq = ireq + 1
2718  endif
2719 
2720  end if
2721 
2722  ! From S
2723  if ( prc_has_s ) then
2724  tagc = 40
2725  do j = js-jhalo, js-1
2726  call mpi_irecv( var(is,j), comm_size2d_ns8, &
2727  comm_datatype, prc_next(prc_s), tag+tagc, &
2728  comm_world, req_list(ireq,vid), ierr )
2729  ireq = ireq + 1
2730  tagc = tagc + 1
2731  enddo
2732  endif
2733 
2734  ! From N
2735  if ( prc_has_n ) then
2736  tagc = 50
2737  do j = je+1, je+jhalo
2738  call mpi_irecv( var(is,j), comm_size2d_ns8, &
2739  comm_datatype, prc_next(prc_n), tag+tagc, &
2740  comm_world, req_list(ireq,vid), ierr )
2741  ireq = ireq + 1
2742  tagc = tagc + 1
2743  enddo
2744  endif
2745 
2746 
2747  !! RECEIVE
2748 
2749  ! To N HALO communicate
2750  if ( prc_has_n ) then
2751  tagc = 40
2752  do j = je-jhalo+1, je
2753  call mpi_isend( var(is,j), comm_size2d_ns8, &
2754  comm_datatype, prc_next(prc_n), tag+tagc, &
2755  comm_world, req_list(ireq,vid), ierr )
2756  ireq = ireq + 1
2757  tagc = tagc + 1
2758  enddo
2759  endif
2760 
2761  ! To S HALO communicate
2762  if ( prc_has_s ) then
2763  tagc = 50
2764  do j = js, js+jhalo-1
2765  call mpi_isend( var(is,j), comm_size2d_ns8, &
2766  comm_datatype, prc_next(prc_s), tag+tagc, &
2767  comm_world, req_list(ireq,vid), ierr )
2768  ireq = ireq + 1
2769  tagc = tagc + 1
2770  enddo
2771  endif
2772 
2773  if ( .not. prc_twod ) then
2774 
2775  call pack_2d(var, vid)
2776 
2777  ! To W HALO communicate
2778  if ( prc_has_w ) then
2779  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we, &
2780  comm_datatype, prc_next(prc_w), tag+60, &
2781  comm_world, req_list(ireq,vid), ierr )
2782  ireq = ireq + 1
2783  endif
2784 
2785  ! To E HALO communicate
2786  if ( prc_has_e ) then
2787  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we, &
2788  comm_datatype, prc_next(prc_e), tag+70, &
2789  comm_world, req_list(ireq,vid), ierr )
2790  ireq = ireq + 1
2791  endif
2792 
2793  ! To NW HALO communicate
2794  if ( prc_has_n .AND. prc_has_w ) then
2795  tagc = 0
2796  do j = je-jhalo+1, je
2797  call mpi_isend( var(is,j), comm_size2d_4c, &
2798  comm_datatype, prc_next(prc_nw), 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_n ) then
2804  tagc = 10
2805  do j = je-jhalo+1, je
2806  call mpi_isend( var(is,j), comm_size2d_4c, &
2807  comm_datatype, prc_next(prc_n), tag+tagc, &
2808  comm_world, req_list(ireq,vid), ierr )
2809  ireq = ireq + 1
2810  tagc = tagc + 1
2811  enddo
2812  else if ( prc_has_w ) then
2813  tagc = 20
2814  do j = je-jhalo+1, je
2815  call mpi_isend( var(is,j), comm_size2d_4c, &
2816  comm_datatype, prc_next(prc_w), tag+tagc, &
2817  comm_world, req_list(ireq,vid), ierr )
2818  ireq = ireq + 1
2819  tagc = tagc + 1
2820  enddo
2821  endif
2822 
2823  ! To NE HALO communicate
2824  if ( prc_has_n .AND. prc_has_e ) then
2825  tagc = 10
2826  do j = je-jhalo+1, je
2827  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2828  comm_datatype, prc_next(prc_ne), tag+tagc, &
2829  comm_world, req_list(ireq,vid), ierr )
2830  ireq = ireq + 1
2831  tagc = tagc + 1
2832  enddo
2833  else if ( prc_has_n ) then
2834  tagc = 0
2835  do j = je-jhalo+1, je
2836  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2837  comm_datatype, prc_next(prc_n), tag+tagc, &
2838  comm_world, req_list(ireq,vid), ierr )
2839  ireq = ireq + 1
2840  tagc = tagc + 1
2841  enddo
2842  else if ( prc_has_e ) then
2843  tagc = 30
2844  do j = je-jhalo+1, je
2845  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2846  comm_datatype, prc_next(prc_e), tag+tagc, &
2847  comm_world, req_list(ireq,vid), ierr )
2848  ireq = ireq + 1
2849  tagc = tagc + 1
2850  enddo
2851  endif
2852 
2853  ! To SW HALO communicate
2854  if ( prc_has_s .AND. prc_has_w ) then
2855  tagc = 20
2856  do j = js, js+jhalo-1
2857  call mpi_isend( var(is,j), comm_size2d_4c, &
2858  comm_datatype, prc_next(prc_sw), tag+tagc, &
2859  comm_world, req_list(ireq,vid), ierr )
2860  ireq = ireq + 1
2861  tagc = tagc + 1
2862  enddo
2863  else if ( prc_has_s ) then
2864  tagc = 30
2865  do j = js, js+jhalo-1
2866  call mpi_isend( var(is,j), comm_size2d_4c, &
2867  comm_datatype, prc_next(prc_s), tag+tagc, &
2868  comm_world, req_list(ireq,vid), ierr )
2869  ireq = ireq + 1
2870  tagc = tagc + 1
2871  enddo
2872  else if ( prc_has_w ) then
2873  tagc = 0
2874  do j = js, js+jhalo-1
2875  call mpi_isend( var(is,j), comm_size2d_4c, &
2876  comm_datatype, prc_next(prc_w), tag+tagc, &
2877  comm_world, req_list(ireq,vid), ierr )
2878  ireq = ireq + 1
2879  tagc = tagc + 1
2880  enddo
2881  endif
2882 
2883  ! To SE HALO communicate
2884  if ( prc_has_s .AND. prc_has_e ) then
2885  tagc = 30
2886  do j = js, js+jhalo-1
2887  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2888  comm_datatype, prc_next(prc_se), tag+tagc, &
2889  comm_world, req_list(ireq,vid), ierr )
2890  ireq = ireq + 1
2891  tagc = tagc + 1
2892  enddo
2893  else if ( prc_has_s ) then
2894  tagc = 20
2895  do j = js, js+jhalo-1
2896  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2897  comm_datatype, prc_next(prc_s), tag+tagc, &
2898  comm_world, req_list(ireq,vid), ierr )
2899  ireq = ireq + 1
2900  tagc = tagc + 1
2901  enddo
2902  else if ( prc_has_e ) then
2903  tagc = 10
2904  do j = js, js+jhalo-1
2905  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2906  comm_datatype, prc_next(prc_e), tag+tagc, &
2907  comm_world, req_list(ireq,vid), ierr )
2908  ireq = ireq + 1
2909  tagc = tagc + 1
2910  enddo
2911  endif
2912  end if
2913 
2914  endif
2915 
2916  req_cnt(vid) = ireq - 1
2917 
2918  return

References comm_datatype, comm_world, scale_atmos_grid_cartesc_index::ie, scale_atmos_grid_cartesc_index::ihalo, scale_atmos_grid_cartesc_index::is, scale_atmos_grid_cartesc_index::je, scale_atmos_grid_cartesc_index::jhalo, scale_atmos_grid_cartesc_index::js, scale_prc::prc_abort(), and scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ vars_3d_mpi_pc()

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

Definition at line 2922 of file scale_comm_cartesC.F90.

2922  use scale_prc, only: &
2923  prc_abort
2924  use scale_prc_cartesc, only: &
2925  prc_twod
2926  implicit none
2927 
2928  real(RP), intent(inout) :: var(:,:,:)
2929  integer, intent(in) :: vid
2930  integer :: ierr
2931  !---------------------------------------------------------------------------
2932 
2933 #ifdef DEBUG
2934  if ( use_packbuf(pseqid(vid)) ) then
2935  log_error("vars_3D_mpi_pc",*) 'packing buffer is already used', vid, pseqid(vid)
2936  call prc_abort
2937  end if
2938  use_packbuf(pseqid(vid)) = .true.
2939 #endif
2940 
2941  if ( .not. prc_twod ) call pack_3d(var, pseqid(vid))
2942 
2943  call mpi_startall(preq_cnt(vid), preq_list(1:preq_cnt(vid),vid), ierr)
2944 
2945  return

References pack_3d(), scale_prc::prc_abort(), and scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ wait_3d_mpi()

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

Definition at line 2949 of file scale_comm_cartesC.F90.

2949  use scale_prc_cartesc, only: &
2950  prc_twod
2951  implicit none
2952  real(RP), intent(inout) :: var(:,:,:)
2953  integer, intent(in) :: vid
2954 
2955  integer :: ierr
2956  !---------------------------------------------------------------------------
2957 
2958  !--- wait packets
2959  call mpi_waitall( req_cnt(vid), &
2960  req_list(1:req_cnt(vid),vid), &
2961  mpi_statuses_ignore, &
2962  ierr )
2963  if ( .not. prc_twod ) call unpack_3d(var, vid)
2964 
2965 #ifdef DEBUG
2966  use_packbuf(vid) = .false.
2967 #endif
2968 
2969  return

References scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the caller graph for this function:

◆ wait_2d_mpi()

subroutine scale_comm_cartesc::wait_2d_mpi ( real(rp), dimension(:,:), intent(inout)  var,
integer, intent(in)  vid 
)

Definition at line 2973 of file scale_comm_cartesC.F90.

2973  use scale_prc_cartesc, only: &
2974  prc_twod
2975  implicit none
2976 
2977  real(RP), intent(inout) :: var(:,:)
2978  integer, intent(in) :: vid
2979 
2980  integer :: ierr
2981  !---------------------------------------------------------------------------
2982 
2983  !--- wait packets
2984  call mpi_waitall( req_cnt(vid), &
2985  req_list(1:req_cnt(vid),vid), &
2986  mpi_statuses_ignore, &
2987  ierr )
2988  if ( .not. prc_twod ) call unpack_2d(var, vid)
2989 
2990 #ifdef DEBUG
2991  use_packbuf(vid) = .false.
2992 #endif
2993 
2994  return

References scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the caller graph for this function:

◆ wait_3d_mpi_pc()

subroutine scale_comm_cartesc::wait_3d_mpi_pc ( real(rp), dimension(:,:,:), intent(inout)  var,
integer, intent(in)  vid 
)

Definition at line 2998 of file scale_comm_cartesC.F90.

2998  use scale_prc_cartesc, only: &
2999  prc_twod
3000  implicit none
3001 
3002  real(RP), intent(inout) :: var(:,:,:)
3003  integer, intent(in) :: vid
3004 
3005  integer :: ierr
3006 
3007  !--- wait packets
3008  call mpi_waitall( preq_cnt(vid), &
3009  preq_list(1:preq_cnt(vid),vid), &
3010  mpi_statuses_ignore, &
3011  ierr )
3012  if ( .not. prc_twod ) call unpack_3d(var, pseqid(vid))
3013 
3014 #ifdef DEBUG
3015  use_packbuf(pseqid(vid)) = .false.
3016 #endif
3017 
3018  return

References scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the caller graph for this function:

◆ pack_3d()

subroutine scale_comm_cartesc::pack_3d ( real(rp), dimension(:,:,:), intent(in)  var,
integer, intent(in)  vid 
)

Definition at line 3022 of file scale_comm_cartesC.F90.

3022  implicit none
3023 
3024  real(RP), intent(in) :: var(:,:,:)
3025  integer, intent(in) :: vid
3026 
3027  integer :: kd
3028  integer :: k, i, j, n
3029 
3030  kd = size(var, 1)
3031 
3032  call prof_rapstart('COMM_pack', 3)
3033 
3034  if ( comm_isallperiodic ) then ! periodic condition
3035 
3036  !--- packing packets to West
3037 !OCL NORECURRENCE(sendpack_P2W)
3038  !$omp parallel do private(i,j,k,n) OMP_SCHEDULE_ collapse(2)
3039  do j = js, je
3040  do i = is, is+ihalo-1
3041  do k = 1, kd
3042  n = (j-js) * kd * ihalo &
3043  + (i-is) * kd &
3044  + k
3045  sendpack_p2w(n,vid) = var(k,i,j)
3046  enddo
3047  enddo
3048  enddo
3049  !--- packing packets to East
3050 !OCL NORECURRENCE(sendpack_P2E)
3051  !$omp parallel do private(i,j,k,n) OMP_SCHEDULE_ collapse(2)
3052  do j = js, je
3053  do i = ie-ihalo+1, ie
3054  do k = 1, kd
3055  n = (j-js) * kd * ihalo &
3056  + (i-ie+ihalo-1) * kd &
3057  + k
3058  sendpack_p2e(n,vid) = var(k,i,j)
3059  enddo
3060  enddo
3061  enddo
3062 
3063  else
3064 
3065  if ( prc_has_w ) then
3066  !--- packing packets to West
3067 !OCL NORECURRENCE(sendpack_P2W)
3068  !$omp parallel do default(none) private(i,j,k,n) OMP_SCHEDULE_ collapse(2) &
3069  !$omp shared(JS,JE,IS,IHALO,kd,var,sendpack_P2W,vid)
3070  do j = js, je
3071  do i = is, is+ihalo-1
3072  do k = 1, kd
3073  n = (j-js) * kd * ihalo &
3074  + (i-is) * kd &
3075  + k
3076  sendpack_p2w(n,vid) = var(k,i,j)
3077  enddo
3078  enddo
3079  enddo
3080  endif
3081  if ( prc_has_e ) then
3082  !--- packing packets to East
3083 !OCL NORECURRENCE(sendpack_P2E)
3084  !$omp parallel do default(none) private(i,j,k,n) OMP_SCHEDULE_ collapse(2) &
3085  !$omp shared(JS,JE,IE,IHALO,kd,var,sendpack_P2E,vid)
3086  do j = js, je
3087  do i = ie-ihalo+1, ie
3088  do k = 1, kd
3089  n = (j-js) * kd * ihalo &
3090  + (i-ie+ihalo-1) * kd &
3091  + k
3092  sendpack_p2e(n,vid) = var(k,i,j)
3093  enddo
3094  enddo
3095  enddo
3096  endif
3097 
3098  end if
3099 
3100  call prof_rapend('COMM_pack', 3)
3101 
3102  return

References scale_atmos_grid_cartesc_index::ie, scale_atmos_grid_cartesc_index::ihalo, scale_atmos_grid_cartesc_index::is, scale_atmos_grid_cartesc_index::je, scale_atmos_grid_cartesc_index::jhalo, scale_atmos_grid_cartesc_index::js, scale_prc_cartesc::prc_has_e, scale_prc_cartesc::prc_has_w, scale_prc_cartesc::prc_twod, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Referenced by vars8_3d_mpi(), vars_3d_mpi(), and vars_3d_mpi_pc().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ copy_boundary_2d()

subroutine scale_comm_cartesc::copy_boundary_2d ( real(rp), dimension(:,:), intent(inout)  var)

Definition at line 3481 of file scale_comm_cartesC.F90.

3481  use scale_prc_cartesc, only: &
3482  prc_twod
3483  implicit none
3484 
3485  real(RP), intent(inout) :: var(:,:)
3486 
3487  integer :: i, j
3488  !---------------------------------------------------------------------------
3489 
3490  !$omp parallel
3491 
3492  !--- copy inner data to HALO(North)
3493  if( .NOT. prc_has_n ) then
3494  do j = je+1, je+jhalo
3495  !$omp do
3496  do i = is, ie
3497  var(i,j) = var(i,je)
3498  enddo
3499  !$omp end do nowait
3500  enddo
3501  endif
3502 
3503  !--- copy inner data to HALO(South)
3504  if( .NOT. prc_has_s ) then
3505  do j = js-jhalo, js-1
3506  !$omp do
3507  do i = is, ie
3508  var(i,j) = var(i,js)
3509  enddo
3510  !$omp end do nowait
3511  enddo
3512  endif
3513 
3514  if ( .not. prc_twod ) then
3515 
3516  if( .NOT. prc_has_e ) then
3517  !$omp do
3518  do j = js, je
3519  do i = ie+1, ie+ihalo
3520  var(i,j) = var(ie,j)
3521  enddo
3522  enddo
3523  !$omp end do nowait
3524  endif
3525 
3526  if( .NOT. prc_has_w ) then
3527  !$omp do
3528  do j = js, je
3529  do i = is-ihalo, is-1
3530  var(i,j) = var(is,j)
3531  enddo
3532  enddo
3533  !$omp end do nowait
3534  endif
3535 
3536  !--- copy inner data to HALO(NorthWest)
3537  if( .NOT. prc_has_n .AND. .NOT. prc_has_w ) then
3538  do j = je+1, je+jhalo
3539  do i = is-ihalo, is-1
3540  var(i,j) = var(is,je)
3541  enddo
3542  enddo
3543  elseif( .NOT. prc_has_n ) then
3544  do j = je+1, je+jhalo
3545  do i = is-ihalo, is-1
3546  var(i,j) = var(i,je)
3547  enddo
3548  enddo
3549  elseif( .NOT. prc_has_w ) then
3550  do j = je+1, je+jhalo
3551  do i = is-ihalo, is-1
3552  var(i,j) = var(is,j)
3553  enddo
3554  enddo
3555  endif
3556 
3557  !--- copy inner data to HALO(SouthWest)
3558  if( .NOT. prc_has_s .AND. .NOT. prc_has_w ) then
3559  do j = js-ihalo, js-1
3560  do i = is-ihalo, is-1
3561  var(i,j) = var(is,js)
3562  enddo
3563  enddo
3564  elseif( .NOT. prc_has_s ) then
3565  do j = js-ihalo, js-1
3566  do i = is-ihalo, is-1
3567  var(i,j) = var(i,js)
3568  enddo
3569  enddo
3570  elseif( .NOT. prc_has_w ) then
3571  do j = js-ihalo, js-1
3572  do i = is-ihalo, is-1
3573  var(i,j) = var(is,j)
3574  enddo
3575  enddo
3576  endif
3577 
3578  !--- copy inner data to HALO(NorthEast)
3579  if( .NOT. prc_has_n .AND. .NOT. prc_has_e ) then
3580  do j = je+1, je+jhalo
3581  do i = ie+1, ie+ihalo
3582  var(i,j) = var(ie,je)
3583  enddo
3584  enddo
3585  elseif( .NOT. prc_has_n ) then
3586  do j = je+1, je+jhalo
3587  do i = ie+1, ie+ihalo
3588  var(i,j) = var(i,je)
3589  enddo
3590  enddo
3591  elseif( .NOT. prc_has_e ) then
3592  do j = je+1, je+jhalo
3593  do i = ie+1, ie+ihalo
3594  var(i,j) = var(ie,j)
3595  enddo
3596  enddo
3597  endif
3598 
3599  !--- copy inner data to HALO(SouthEast)
3600  if( .NOT. prc_has_s .AND. .NOT. prc_has_e ) then
3601  do j = js-ihalo, js-1
3602  do i = ie+1, ie+ihalo
3603  var(i,j) = var(ie,js)
3604  enddo
3605  enddo
3606  elseif( .NOT. prc_has_s ) then
3607  do j = js-ihalo, js-1
3608  do i = ie+1, ie+ihalo
3609  var(i,j) = var(i,js)
3610  enddo
3611  enddo
3612  elseif( .NOT. prc_has_e ) then
3613  do j = js-ihalo, js-1
3614  do i = ie+1, ie+ihalo
3615  var(i,j) = var(ie,j)
3616  enddo
3617  enddo
3618  endif
3619 
3620  end if
3621 
3622  !$omp end parallel
3623 
3624  return

References scale_atmos_grid_cartesc_index::ie, scale_atmos_grid_cartesc_index::ihalo, scale_atmos_grid_cartesc_index::is, scale_atmos_grid_cartesc_index::je, scale_atmos_grid_cartesc_index::jhalo, scale_atmos_grid_cartesc_index::js, and scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the caller graph for this function:

◆ comm_cleanup()

subroutine, public scale_comm_cartesc::comm_cleanup

Definition at line 3628 of file scale_comm_cartesC.F90.

3628  use mpi
3629  implicit none
3630 
3631  integer :: i, j, ierr
3632  !---------------------------------------------------------------------------
3633 
3634  deallocate( recvpack_w2p )
3635  deallocate( recvpack_e2p )
3636  deallocate( sendpack_p2w )
3637  deallocate( sendpack_p2e )
3638 #ifdef DEBUG
3639  deallocate( use_packbuf )
3640 #endif
3641 
3642  deallocate( req_cnt )
3643  deallocate( req_list )
3644 
3645  if ( comm_use_mpi_pc ) then
3646  do j=1, comm_vsize_max_pc
3647  do i=1, comm_nreq_max+1
3648  if (preq_list(i,j) .NE. mpi_request_null) &
3649  call mpi_request_free(preq_list(i,j), ierr)
3650  enddo
3651  enddo
3652  deallocate( preq_cnt )
3653  deallocate( preq_list )
3654  deallocate( pseqid )
3655  end if

Referenced by mod_rm_driver::rm_driver().

Here is the caller graph for this function:

Variable Documentation

◆ comm_datatype

integer, public scale_comm_cartesc::comm_datatype

datatype of variable

Definition at line 98 of file scale_comm_cartesC.F90.

98  integer, public :: COMM_datatype

Referenced by scale_atmos_phy_lt_sato2019::atmos_phy_lt_electric_field(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_judge_abse(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_neutralization_f2013(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_neutralization_mg2001(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_solve_bicgstab(), comm_bcast_1d_dp(), comm_bcast_1d_sp(), comm_bcast_2d_dp(), comm_bcast_2d_sp(), comm_bcast_3d_dp(), comm_bcast_3d_sp(), comm_bcast_4d_dp(), comm_bcast_4d_sp(), comm_bcast_scr_dp(), comm_bcast_scr_sp(), scale_comm_cartesc_nest::comm_cartesc_nest_domain_shape(), scale_comm_cartesc_nest::comm_cartesc_nest_intercomm_nestdown_3d(), scale_comm_cartesc_nest::comm_cartesc_nest_issuer_of_receive_3d(), comm_gather_2d(), comm_gather_3d(), comm_horizontal_mean_3d(), comm_setup(), comm_vars8_init(), scale_dft::dft_g2s(), scale_statistics::statistics_detail_2d(), scale_statistics::statistics_detail_3d(), scale_statistics::statistics_horizontal_max_2d(), scale_statistics::statistics_horizontal_max_3d(), scale_statistics::statistics_horizontal_min_2d(), scale_statistics::statistics_horizontal_min_3d(), vars8_2d_mpi(), vars8_3d_mpi(), vars8_init_mpi_pc(), vars_2d_mpi(), vars_3d_mpi(), and vars_init_mpi_pc().

◆ comm_world

integer, public scale_comm_cartesc::comm_world

communication world ID

Definition at line 99 of file scale_comm_cartesC.F90.

99  integer, public :: COMM_world

Referenced by scale_atmos_phy_lt_sato2019::atmos_phy_lt_electric_field(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_judge_abse(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_neutralization_f2013(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_neutralization_mg2001(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_solve_bicgstab(), comm_bcast_1d_dp(), comm_bcast_1d_sp(), comm_bcast_2d_dp(), comm_bcast_2d_sp(), comm_bcast_3d_dp(), comm_bcast_3d_sp(), comm_bcast_4d_dp(), comm_bcast_4d_sp(), comm_bcast_character(), comm_bcast_int_1d(), comm_bcast_int_2d(), comm_bcast_int_scr(), comm_bcast_logical_scr(), comm_bcast_scr_dp(), comm_bcast_scr_sp(), scale_comm_cartesc_nest::comm_cartesc_nest_domain_shape(), comm_gather_2d(), comm_gather_3d(), comm_horizontal_mean_3d(), comm_setup(), comm_vars8_init(), scale_atmos_dyn_tstep_short_fvm_hivi::solve_bicgstab(), vars8_2d_mpi(), vars8_3d_mpi(), vars8_init_mpi_pc(), vars_2d_mpi(), vars_3d_mpi(), and vars_init_mpi_pc().

scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:342
scale_atmos_grid_cartesc_index::ihalo
integer, public ihalo
Definition: scale_atmos_grid_cartesC_index.F90:44
scale_prc_cartesc::prc_has_s
logical, public prc_has_s
Definition: scale_prc_cartesC.F90:50
scale_prc::prc_local_comm_world
integer, public prc_local_comm_world
local communicator
Definition: scale_prc.F90:88
scale_prc_cartesc::prc_has_n
logical, public prc_has_n
Definition: scale_prc_cartesC.F90:48
scale_prc_cartesc::prc_has_e
logical, public prc_has_e
Definition: scale_prc_cartesC.F90:49
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_prc::prc_masterrank
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_prc.F90:66
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_prc_cartesc
module process / cartesC
Definition: scale_prc_cartesC.F90:11
scale_atmos_grid_cartesc_index::jhalo
integer, public jhalo
Definition: scale_atmos_grid_cartesC_index.F90:45
scale_const::const_undef
real(rp), public const_undef
Definition: scale_const.F90:41
scale_prc_cartesc::prc_has_w
logical, public prc_has_w
Definition: scale_prc_cartesC.F90:47
scale_prc_cartesc::prc_twod
logical, public prc_twod
2D experiment
Definition: scale_prc_cartesC.F90:55
Generated by   doxygen 1.8.17