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 (var)
 Broadcast data for whole process value in scalar field. More...
 
subroutine comm_bcast_1d (var, gIA)
 Broadcast data for whole process value in 1D field. More...
 
subroutine comm_bcast_2d (var, gIA, gJA)
 Broadcast data for whole process value in 2D field. More...
 
subroutine comm_bcast_3d (var, gIA, gJA, gKA)
 Broadcast data for whole process value in 3D field. More...
 
subroutine comm_bcast_4d (var, gIA, gJA, gKA, gTime)
 Broadcast data for whole process value in 4D field. More...
 
subroutine comm_bcast_int_scr (var)
 Broadcast data for whole process value in scalar (integer) More...
 
subroutine comm_bcast_int_1d (var, gIA)
 Broadcast data for whole process value in 1D field (integer) More...
 
subroutine comm_bcast_int_2d (var, gIA, gJA)
 Broadcast data for whole process value in 2D field (integer) More...
 
subroutine comm_bcast_logical_scr (var)
 Broadcast data for whole process value in scalar (logical) More...
 
subroutine comm_bcast_character (var)
 Broadcast data for whole process value in character. More...
 
subroutine vars_init_mpi_pc (var, vid, seqid)
 
subroutine vars8_3d_mpi (var, vid)
 
subroutine vars_2d_mpi (var, vid)
 
subroutine vars8_2d_mpi (var, vid)
 
subroutine vars_3d_mpi_pc (var, vid)
 
subroutine wait_3d_mpi (var, vid)
 
subroutine, public comm_cleanup
 

Variables

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

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 140 of file scale_comm_cartesC.F90.

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().

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

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

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

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_prc::prc_abort(), scale_prof::prof_rapend(), scale_prof::prof_rapstart(), vars8_2d_mpi(), vars8_3d_mpi(), vars_2d_mpi(), vars_3d_mpi_pc(), and wait_3d_mpi().

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

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

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_atmos_grid_cartesc_index::ka, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

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

References comm_datatype, comm_world, and scale_prc::prc_masterrank.

580  use scale_prc, only: &
582  implicit none
583 
584  real(RP), intent(out) :: recv(:,:,:)
585  real(RP), intent(in) :: send(:,:)
586  integer, intent(in) :: gia
587  integer, intent(in) :: gja
588 
589  integer :: sendcounts, recvcounts
590  integer :: ierr
591  !---------------------------------------------------------------------------
592 
593  sendcounts = gia * gja
594  recvcounts = gia * gja
595 
596  call mpi_gather( send(:,:), &
597  sendcounts, &
598  comm_datatype, &
599  recv(:,:,:), &
600  recvcounts, &
601  comm_datatype, &
602  prc_masterrank, &
603  comm_world, &
604  ierr )
605 
606  return
module PROCESS
Definition: scale_prc.F90:11
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_prc.F90:65

◆ 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 612 of file scale_comm_cartesC.F90.

References comm_datatype, comm_world, and scale_prc::prc_masterrank.

612  use scale_prc, only: &
614  implicit none
615 
616  real(RP), intent(out) :: recv(:,:,:,:)
617  real(RP), intent(in) :: send(:,:,:)
618  integer, intent(in) :: gia
619  integer, intent(in) :: gja
620  integer, intent(in) :: gka
621 
622  integer :: sendcounts, recvcounts
623  integer :: ierr
624  !---------------------------------------------------------------------------
625 
626  sendcounts = gia * gja * gka
627  recvcounts = gia * gja * gka
628 
629  call mpi_gather( send(:,:,:), &
630  sendcounts, &
631  comm_datatype, &
632  recv(:,:,:,:), &
633  recvcounts, &
634  comm_datatype, &
635  prc_masterrank, &
636  comm_world, &
637  ierr )
638 
639  return
module PROCESS
Definition: scale_prc.F90:11
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_prc.F90:65

◆ comm_bcast_scr()

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

Broadcast data for whole process value in scalar field.

Parameters
[in,out]varbroadcast buffer (gIA)

Definition at line 645 of file scale_comm_cartesC.F90.

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

645  use scale_prc, only: &
647  implicit none
648 
649  real(RP), intent(inout) :: var
650 
651  integer :: counts
652  integer :: ierr
653  !---------------------------------------------------------------------------
654 
655  call prof_rapstart('COMM_Bcast', 2)
656 
657  counts = 1
658 
659  call mpi_bcast( var, &
660  counts, &
661  comm_datatype, &
662  prc_masterrank, &
663  comm_world, &
664  ierr )
665 
666  call prof_rapend('COMM_Bcast', 2)
667 
668  return
module PROCESS
Definition: scale_prc.F90:11
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_prc.F90:65
Here is the call graph for this function:

◆ comm_bcast_1d()

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

Broadcast data for whole process value in 1D field.

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

Definition at line 674 of file scale_comm_cartesC.F90.

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

674  use scale_prc, only: &
676  implicit none
677 
678  real(RP), intent(inout) :: var(:)
679  integer, intent(in) :: gia
680 
681  integer :: counts
682  integer :: ierr
683  !---------------------------------------------------------------------------
684 
685  call prof_rapstart('COMM_Bcast', 2)
686 
687  counts = gia
688 
689  call mpi_bcast( var(:), &
690  counts, &
691  comm_datatype, &
692  prc_masterrank, &
693  comm_world, &
694  ierr )
695 
696  call prof_rapend('COMM_Bcast', 2)
697 
698  return
module PROCESS
Definition: scale_prc.F90:11
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_prc.F90:65
Here is the call graph for this function:

◆ comm_bcast_2d()

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

Broadcast data for whole process value in 2D field.

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

Definition at line 704 of file scale_comm_cartesC.F90.

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

704  use scale_prc, only: &
706  implicit none
707 
708  real(RP), intent(inout) :: var(:,:)
709  integer, intent(in) :: gia
710  integer, intent(in) :: gja
711 
712  integer :: counts
713  integer :: ierr
714  !---------------------------------------------------------------------------
715 
716  call prof_rapstart('COMM_Bcast', 2)
717 
718  counts = gia * gja
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
module PROCESS
Definition: scale_prc.F90:11
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_prc.F90:65
Here is the call graph for this function:

◆ comm_bcast_3d()

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

Broadcast data for whole process value in 3D field.

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

Definition at line 735 of file scale_comm_cartesC.F90.

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

735  use scale_prc, only: &
737  implicit none
738 
739  real(RP), intent(inout) :: var(:,:,:)
740  integer, intent(in) :: gia
741  integer, intent(in) :: gja
742  integer, intent(in) :: gka
743 
744  integer :: counts
745  integer :: ierr
746  !---------------------------------------------------------------------------
747 
748  call prof_rapstart('COMM_Bcast', 2)
749 
750  counts = gia * gja * gka
751 
752  call mpi_bcast( var(:,:,:), &
753  counts, &
754  comm_datatype, &
755  prc_masterrank, &
756  comm_world, &
757  ierr )
758 
759  call prof_rapend('COMM_Bcast', 2)
760 
761  return
module PROCESS
Definition: scale_prc.F90:11
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_prc.F90:65
Here is the call graph for this function:

◆ comm_bcast_4d()

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

Broadcast data for whole process value in 4D field.

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

Definition at line 767 of file scale_comm_cartesC.F90.

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

767  use scale_prc, only: &
769  implicit none
770 
771  real(RP), intent(inout) :: var(:,:,:,:)
772  integer, intent(in) :: gia
773  integer, intent(in) :: gja
774  integer, intent(in) :: gka
775  integer, intent(in) :: gtime
776 
777  integer :: counts
778  integer :: ierr
779  !---------------------------------------------------------------------------
780 
781  call prof_rapstart('COMM_Bcast', 2)
782 
783  counts = gia * gja * gka * gtime
784  if ( gia>0 .AND. gja>0 .AND. gka>0 .AND. gtime>0 .AND. &
785  counts < 0 ) then
786  log_error("COMM_bcast_4D",*) 'counts overflow'
787  call prc_abort
788  end if
789 
790  call mpi_bcast( var(:,:,:,:), &
791  counts, &
792  comm_datatype, &
793  prc_masterrank, &
794  comm_world, &
795  ierr )
796 
797  call prof_rapend('COMM_Bcast', 2)
798 
799  return
module PROCESS
Definition: scale_prc.F90:11
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_prc.F90:65
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 805 of file scale_comm_cartesC.F90.

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

805  use scale_prc, only: &
807  implicit none
808 
809  integer, intent(inout) :: var
810 
811  integer :: counts
812  integer :: ierr
813  !---------------------------------------------------------------------------
814 
815  call prof_rapstart('COMM_Bcast', 2)
816 
817  counts = 1
818 
819  call mpi_bcast( var, &
820  counts, &
821  mpi_integer, &
822  prc_masterrank, &
823  comm_world, &
824  ierr )
825 
826  call prof_rapend('COMM_Bcast', 2)
827 
828  return
module PROCESS
Definition: scale_prc.F90:11
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_prc.F90:65
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 834 of file scale_comm_cartesC.F90.

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

834  use scale_prc, only: &
836  implicit none
837 
838  integer, intent(inout) :: var(:)
839  integer, intent(in) :: gia
840 
841  integer :: counts
842  integer :: ierr
843  !---------------------------------------------------------------------------
844 
845  call prof_rapstart('COMM_Bcast', 2)
846 
847  counts = gia
848 
849  call mpi_bcast( var(:), &
850  counts, &
851  mpi_integer, &
852  prc_masterrank, &
853  comm_world, &
854  ierr )
855 
856  call prof_rapend('COMM_Bcast', 2)
857 
858  return
module PROCESS
Definition: scale_prc.F90:11
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_prc.F90:65
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 864 of file scale_comm_cartesC.F90.

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

864  use scale_prc, only: &
866  implicit none
867 
868  integer, intent(inout) :: var(:,:)
869  integer, intent(in) :: gia
870  integer, intent(in) :: gja
871 
872  integer :: counts
873  integer :: ierr
874  !---------------------------------------------------------------------------
875 
876  call prof_rapstart('COMM_Bcast', 2)
877 
878  counts = gia * gja
879 
880  call mpi_bcast( var(:,:), &
881  counts, &
882  mpi_integer, &
883  prc_masterrank, &
884  comm_world, &
885  ierr )
886 
887  call prof_rapend('COMM_Bcast', 2)
888 
889  return
module PROCESS
Definition: scale_prc.F90:11
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_prc.F90:65
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 895 of file scale_comm_cartesC.F90.

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

895  use scale_prc, only: &
897  implicit none
898 
899  logical, intent(inout) :: var
900 
901  integer :: counts
902  integer :: ierr
903  !---------------------------------------------------------------------------
904 
905  call prof_rapstart('COMM_Bcast', 2)
906 
907  counts = 1
908 
909  call mpi_bcast( var, &
910  counts, &
911  mpi_logical, &
912  prc_masterrank, &
913  comm_world, &
914  ierr )
915 
916  call prof_rapend('COMM_Bcast', 2)
917 
918  return
module PROCESS
Definition: scale_prc.F90:11
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_prc.F90:65
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 924 of file scale_comm_cartesC.F90.

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

924  use scale_prc, only: &
926  implicit none
927 
928  character(len=*), intent(inout) :: var
929 
930  integer :: counts
931  integer :: ierr
932  !---------------------------------------------------------------------------
933 
934  call prof_rapstart('COMM_Bcast', 2)
935 
936  counts = len(var)
937 
938  call mpi_bcast( var, &
939  counts, &
940  mpi_character, &
941  prc_masterrank, &
942  comm_world, &
943  ierr )
944 
945  call prof_rapend('COMM_Bcast', 2)
946 
947  return
module PROCESS
Definition: scale_prc.F90:11
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_prc.F90:65
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 954 of file scale_comm_cartesC.F90.

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(), scale_prc_cartesc::prc_e, 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_cartesc::prc_n, scale_prc_cartesc::prc_ne, scale_prc_cartesc::prc_next, scale_prc_cartesc::prc_nw, scale_prc_cartesc::prc_s, scale_prc_cartesc::prc_se, scale_prc_cartesc::prc_sw, and scale_prc_cartesc::prc_w.

Referenced by comm_vars_init().

954  implicit none
955 
956  real(RP), intent(inout) :: var(:,:,:)
957  integer, intent(in) :: vid
958  integer, intent(in) :: seqid
959 
960  integer :: ireq, tag, ierr
961  logical :: flag
962 
963  integer :: kd
964  integer :: i
965 
966  tag = vid * 100
967  ireq = 1
968 
969  kd = size(var, 1)
970 
971  ! register whole array to inner table of MPI and/or lower library
972  ! otherwise a lot of sub small segments would be registered
973  call mpi_send_init( var(:,:,:), size(var), comm_datatype, &
974  mpi_proc_null, tag+comm_nreq_max+1, comm_world, &
975  preq_list(comm_nreq_max+1,vid), ierr )
976 
977  !--- From 4-Direction HALO communicate
978  ! From S
979  call mpi_recv_init( var(:,:,js-jhalo:js-1), comm_size2d_ns4*kd, comm_datatype, &
980  prc_next(prc_s), tag+1, comm_world, preq_list(ireq,vid), ierr )
981  ireq = ireq + 1
982  ! From N
983  call mpi_recv_init( var(:,:,je+1:je+jhalo), comm_size2d_ns4*kd, comm_datatype, &
984  prc_next(prc_n), tag+2, comm_world, preq_list(ireq,vid), ierr )
985  ireq = ireq + 1
986  ! From E
987  call mpi_recv_init( recvpack_e2p(:,seqid), comm_size2d_we*kd, comm_datatype, &
988  prc_next(prc_e), tag+3, comm_world, preq_list(ireq,vid), ierr )
989  ireq = ireq + 1
990  ! From W
991  call mpi_recv_init( recvpack_w2p(:,seqid), comm_size2d_we*kd, comm_datatype, &
992  prc_next(prc_w), tag+4, comm_world, preq_list(ireq,vid), ierr )
993  ireq = ireq + 1
994 
995  !--- To 4-Direction HALO communicate
996  ! To W HALO
997  call mpi_send_init( sendpack_p2w(:,seqid), comm_size2d_we*kd, comm_datatype, &
998  prc_next(prc_w), tag+3, comm_world, preq_list(ireq,vid), ierr )
999  ireq = ireq + 1
1000  ! To E HALO
1001  call mpi_send_init( sendpack_p2e(:,seqid), comm_size2d_we*kd, comm_datatype, &
1002  prc_next(prc_e), tag+4, comm_world, preq_list(ireq,vid), ierr )
1003  ireq = ireq + 1
1004  ! To N HALO
1005  call mpi_send_init( var(:,:,je-jhalo+1:je), comm_size2d_ns4*kd, comm_datatype, &
1006  prc_next(prc_n), tag+1, comm_world, preq_list(ireq,vid), ierr )
1007  ireq = ireq + 1
1008  ! To S HALO
1009  call mpi_send_init( var(:,:,js:js+jhalo-1), comm_size2d_ns4*kd, comm_datatype, &
1010  prc_next(prc_s), tag+2, comm_world, preq_list(ireq,vid), ierr )
1011  ireq = ireq + 1
1012 
1013  preq_cnt(vid) = ireq - 1
1014  pseqid(vid) = seqid
1015 
1016  ! to finish initial processes of MPIa
1017  do i = 1, 32
1018  call mpi_testall( preq_cnt(vid), preq_list(1:preq_cnt(vid),vid), &
1019  flag, mpi_statuses_ignore, ierr )
1020  enddo
1021 
1022  return
integer, public je
end point of inner domain: y, local
integer, public js
start point of inner domain: y, local
Here is the call graph for this function:
Here is the caller graph for this function:

◆ vars8_3d_mpi()

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

Definition at line 1601 of file scale_comm_cartesC.F90.

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(), scale_prc_cartesc::prc_e, 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_cartesc::prc_n, scale_prc_cartesc::prc_ne, scale_prc_cartesc::prc_next, scale_prc_cartesc::prc_nw, scale_prc_cartesc::prc_s, scale_prc_cartesc::prc_se, scale_prc_cartesc::prc_sw, and scale_prc_cartesc::prc_w.

Referenced by comm_vars8_init().

1601  use scale_prc, only: &
1602  prc_abort
1603  implicit none
1604 
1605  real(RP), intent(inout) :: var(:,:,:)
1606  integer, intent(in) :: vid
1607 
1608  integer :: ireq, tag, tagc
1609 
1610  integer :: kd
1611 
1612  integer :: ierr
1613  integer :: j
1614  !---------------------------------------------------------------------------
1615 
1616  tag = vid * 100
1617  ireq = 1
1618 
1619  kd = size(var, 1)
1620 
1621 #ifdef DEBUG
1622  if ( use_packbuf(vid) ) then
1623  log_error("vars8_3D_mpi",*) 'packing buffer is already used', vid
1624  call prc_abort
1625  end if
1626  use_packbuf(vid) = .true.
1627 #endif
1628 
1629  if ( comm_isallperiodic ) then ! periodic condition
1630 
1631  !--- From 8-Direction HALO communicate
1632  ! From SE
1633  tagc = 0
1634  do j = js-jhalo, js-1
1635  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1636  prc_next(prc_se), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1637  ireq = ireq + 1
1638  tagc = tagc + 1
1639  enddo
1640  ! From SW
1641  tagc = 10
1642  do j = js-jhalo, js-1
1643  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1644  prc_next(prc_sw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1645  ireq = ireq + 1
1646  tagc = tagc + 1
1647  enddo
1648  ! From NE
1649  tagc = 20
1650  do j = je+1, je+jhalo
1651  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1652  prc_next(prc_ne), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1653  ireq = ireq + 1
1654  tagc = tagc + 1
1655  enddo
1656  ! From NW
1657  tagc = 30
1658  do j = je+1, je+jhalo
1659  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1660  prc_next(prc_nw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1661  ireq = ireq + 1
1662  tagc = tagc + 1
1663  enddo
1664  ! From S
1665  tagc = 40
1666  do j = js-jhalo, js-1
1667  call mpi_irecv( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1668  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1669  ireq = ireq + 1
1670  tagc = tagc + 1
1671  enddo
1672  ! From N
1673  tagc = 50
1674  do j = je+1, je+jhalo
1675  call mpi_irecv( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1676  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1677  ireq = ireq + 1
1678  tagc = tagc + 1
1679  enddo
1680  ! From E
1681  tagc = 60
1682  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we*kd, comm_datatype, &
1683  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1684  ireq = ireq + 1
1685  ! From W
1686  tagc = 70
1687  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we*kd, comm_datatype, &
1688  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1689  ireq = ireq + 1
1690 
1691  call pack_3d(var, vid)
1692 
1693 
1694  !--- To 8-Direction HALO communicate
1695  ! To W HALO
1696  tagc = 60
1697  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we*kd, comm_datatype, &
1698  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1699  ireq = ireq + 1
1700  ! To E HALO
1701  tagc = 70
1702  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we*kd, comm_datatype, &
1703  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1704  ireq = ireq + 1
1705  ! To N HALO
1706  tagc = 40
1707  do j = je-jhalo+1, je
1708  call mpi_isend( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1709  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1710  ireq = ireq + 1
1711  tagc = tagc + 1
1712  enddo
1713  ! To S HALO
1714  tagc = 50
1715  do j = js, js+jhalo-1
1716  call mpi_isend( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1717  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1718  ireq = ireq + 1
1719  tagc = tagc + 1
1720  enddo
1721  ! To NW HALO
1722  tagc = 0
1723  do j = je-jhalo+1, je
1724  call mpi_isend( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
1725  prc_next(prc_nw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1726  ireq = ireq + 1
1727  tagc = tagc + 1
1728  enddo
1729  ! To NE HALO
1730  tagc = 10
1731  do j = je-jhalo+1, je
1732  call mpi_isend( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
1733  prc_next(prc_ne), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1734  ireq = ireq + 1
1735  tagc = tagc + 1
1736  enddo
1737  ! To SW HALO
1738  tagc = 20
1739  do j = js, js+jhalo-1
1740  call mpi_isend( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
1741  prc_next(prc_sw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1742  ireq = ireq + 1
1743  tagc = tagc + 1
1744  enddo
1745  ! To SE HALO
1746  tagc = 30
1747  do j = js, js+jhalo-1
1748  call mpi_isend( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
1749  prc_next(prc_se), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1750  ireq = ireq + 1
1751  tagc = tagc + 1
1752  enddo
1753 
1754  else ! non-periodic condition
1755 
1756  !--- From 8-Direction HALO communicate
1757  ! From SE
1758  if ( prc_has_s .AND. prc_has_e ) then
1759  tagc = 0
1760  do j = js-jhalo, js-1
1761  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1762  prc_next(prc_se), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1763  ireq = ireq + 1
1764  tagc = tagc + 1
1765  enddo
1766  else if ( prc_has_s ) then
1767  tagc = 0
1768  do j = js-jhalo, js-1
1769  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1770  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1771  ireq = ireq + 1
1772  tagc = tagc + 1
1773  enddo
1774  else if ( prc_has_e ) then
1775  tagc = 0
1776  do j = js-jhalo, js-1
1777  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1778  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1779  ireq = ireq + 1
1780  tagc = tagc + 1
1781  enddo
1782  endif
1783  ! From SW
1784  if ( prc_has_s .AND. prc_has_w ) then
1785  tagc = 10
1786  do j = js-jhalo, js-1
1787  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1788  prc_next(prc_sw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1789  ireq = ireq + 1
1790  tagc = tagc + 1
1791  enddo
1792  else if ( prc_has_s ) then
1793  tagc = 10
1794  do j = js-jhalo, js-1
1795  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1796  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1797  ireq = ireq + 1
1798  tagc = tagc + 1
1799  enddo
1800  else if ( prc_has_w ) then
1801  tagc = 10
1802  do j = js-jhalo, js-1
1803  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1804  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1805  ireq = ireq + 1
1806  tagc = tagc + 1
1807  enddo
1808  endif
1809  ! From NE
1810  if ( prc_has_n .AND. prc_has_e ) then
1811  tagc = 20
1812  do j = je+1, je+jhalo
1813  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1814  prc_next(prc_ne), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1815  ireq = ireq + 1
1816  tagc = tagc + 1
1817  enddo
1818  else if ( prc_has_n ) then
1819  tagc = 20
1820  do j = je+1, je+jhalo
1821  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1822  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1823  ireq = ireq + 1
1824  tagc = tagc + 1
1825  enddo
1826  else if ( prc_has_e ) then
1827  tagc = 20
1828  do j = je+1, je+jhalo
1829  call mpi_irecv( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1830  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1831  ireq = ireq + 1
1832  tagc = tagc + 1
1833  enddo
1834  endif
1835  ! From NW
1836  if ( prc_has_n .AND. prc_has_w ) then
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  else if ( prc_has_n ) then
1845  tagc = 30
1846  do j = je+1, je+jhalo
1847  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1848  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1849  ireq = ireq + 1
1850  tagc = tagc + 1
1851  enddo
1852  else if ( prc_has_w ) then
1853  tagc = 30
1854  do j = je+1, je+jhalo
1855  call mpi_irecv( var(1,is-ihalo,j), comm_size2d_4c*kd, comm_datatype, &
1856  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1857  ireq = ireq + 1
1858  tagc = tagc + 1
1859  enddo
1860  endif
1861  ! From S
1862  if ( prc_has_s ) then
1863  tagc = 40
1864  do j = js-jhalo, js-1
1865  call mpi_irecv( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1866  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1867  ireq = ireq + 1
1868  tagc = tagc + 1
1869  enddo
1870  endif
1871  ! From N
1872  if ( prc_has_n ) then
1873  tagc = 50
1874  do j = je+1, je+jhalo
1875  call mpi_irecv( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1876  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1877  ireq = ireq + 1
1878  tagc = tagc + 1
1879  enddo
1880  endif
1881  ! From E
1882  if ( prc_has_e ) then
1883  tagc = 60
1884  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we*kd, comm_datatype, &
1885  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1886  ireq = ireq + 1
1887  endif
1888  ! From W
1889  if ( prc_has_w ) then
1890  tagc = 70
1891  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we*kd, comm_datatype, &
1892  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1893  ireq = ireq + 1
1894  endif
1895 
1896  call pack_3d(var, vid)
1897 
1898  !--- To 8-Direction HALO communicate
1899  ! To W HALO
1900  if ( prc_has_w ) then
1901  tagc = 60
1902  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we*kd, comm_datatype, &
1903  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1904  ireq = ireq + 1
1905  endif
1906  ! To E HALO
1907  if ( prc_has_e ) then
1908  tagc = 70
1909  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we*kd, comm_datatype, &
1910  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1911  ireq = ireq + 1
1912  endif
1913  ! To N HALO
1914  if ( prc_has_n ) then
1915  tagc = 40
1916  do j = je-jhalo+1, je
1917  call mpi_isend( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1918  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1919  ireq = ireq + 1
1920  tagc = tagc + 1
1921  enddo
1922  endif
1923  ! To S HALO
1924  if ( prc_has_s ) then
1925  tagc = 50
1926  do j = js, js+jhalo-1
1927  call mpi_isend( var(1,is,j), comm_size2d_ns8*kd, comm_datatype, &
1928  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1929  ireq = ireq + 1
1930  tagc = tagc + 1
1931  enddo
1932  endif
1933  ! To NW HALO
1934  if ( prc_has_n .AND. prc_has_w ) then
1935  tagc = 0
1936  do j = je-jhalo+1, je
1937  call mpi_isend( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
1938  prc_next(prc_nw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1939  ireq = ireq + 1
1940  tagc = tagc + 1
1941  enddo
1942  else if ( prc_has_n ) then
1943  tagc = 10
1944  do j = je-jhalo+1, je
1945  call mpi_isend( var(1,1,j), comm_size2d_4c*kd, comm_datatype, &
1946  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1947  ireq = ireq + 1
1948  tagc = tagc + 1
1949  enddo
1950  else if ( prc_has_w ) then
1951  tagc = 20
1952  do j = je+1, je+jhalo
1953  call mpi_isend( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
1954  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1955  ireq = ireq + 1
1956  tagc = tagc + 1
1957  enddo
1958  endif
1959  ! To NE HALO
1960  if ( prc_has_n .AND. prc_has_e ) then
1961  tagc = 10
1962  do j = je-jhalo+1, je
1963  call mpi_isend( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
1964  prc_next(prc_ne), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1965  ireq = ireq + 1
1966  tagc = tagc + 1
1967  enddo
1968  else if ( prc_has_n ) then
1969  tagc = 0
1970  do j = je-jhalo+1, je
1971  call mpi_isend( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
1972  prc_next(prc_n), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1973  ireq = ireq + 1
1974  tagc = tagc + 1
1975  enddo
1976  else if ( prc_has_e ) then
1977  tagc = 30
1978  do j = je+1, je+jhalo
1979  call mpi_isend( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
1980  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1981  ireq = ireq + 1
1982  tagc = tagc + 1
1983  enddo
1984  endif
1985  ! To SW HALO
1986  if ( prc_has_s .AND. prc_has_w ) then
1987  tagc = 20
1988  do j = js, js+jhalo-1
1989  call mpi_isend( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
1990  prc_next(prc_sw), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1991  ireq = ireq + 1
1992  tagc = tagc + 1
1993  enddo
1994  else if ( prc_has_s ) then
1995  tagc = 30
1996  do j = js, js+jhalo-1
1997  call mpi_isend( var(1,1,j), comm_size2d_4c*kd, comm_datatype, &
1998  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
1999  ireq = ireq + 1
2000  tagc = tagc + 1
2001  enddo
2002  else if ( prc_has_w ) then
2003  tagc = 0
2004  do j = js-jhalo, js-1
2005  call mpi_isend( var(1,is,j), comm_size2d_4c*kd, comm_datatype, &
2006  prc_next(prc_w), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2007  ireq = ireq + 1
2008  tagc = tagc + 1
2009  enddo
2010  endif
2011  ! To SE HALO
2012  if ( prc_has_s .AND. prc_has_e ) then
2013  tagc = 30
2014  do j = js, js+jhalo-1
2015  call mpi_isend( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
2016  prc_next(prc_se), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2017  ireq = ireq + 1
2018  tagc = tagc + 1
2019  enddo
2020  else if ( prc_has_s ) then
2021  tagc = 20
2022  do j = js, js+jhalo-1
2023  call mpi_isend( var(1,ie+1,j), comm_size2d_4c*kd, comm_datatype, &
2024  prc_next(prc_s), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2025  ireq = ireq + 1
2026  tagc = tagc + 1
2027  enddo
2028  else if ( prc_has_e ) then
2029  tagc = 10
2030  do j = js-jhalo, js-1
2031  call mpi_isend( var(1,ie-ihalo+1,j), comm_size2d_4c*kd, comm_datatype, &
2032  prc_next(prc_e), tag+tagc, comm_world, req_list(ireq,vid), ierr )
2033  ireq = ireq + 1
2034  tagc = tagc + 1
2035  enddo
2036  endif
2037 
2038  endif
2039 
2040  req_cnt(vid) = ireq - 1
2041 
2042  return
integer, public is
start point of inner domain: x, local
integer, public ie
end point of inner domain: x, local
module PROCESS
Definition: scale_prc.F90:11
integer, public je
end point of inner domain: y, local
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:338
integer, public js
start point of inner domain: y, local
Here is the call graph for this function:
Here is the caller graph for this function:

◆ vars_2d_mpi()

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

Definition at line 2046 of file scale_comm_cartesC.F90.

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(), scale_prc_cartesc::prc_e, 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_cartesc::prc_n, scale_prc_cartesc::prc_next, scale_prc_cartesc::prc_s, and scale_prc_cartesc::prc_w.

Referenced by comm_vars8_init().

2046  use scale_prc, only: &
2047  prc_abort
2048  implicit none
2049 
2050  real(RP), intent(inout) :: var(:,:)
2051  integer, intent(in) :: vid
2052 
2053  integer :: ireq, tag
2054  integer :: ierr
2055  !---------------------------------------------------------------------------
2056 
2057  tag = vid * 100
2058  ireq = 1
2059 
2060 #ifdef DEBUG
2061  if ( use_packbuf(vid) ) then
2062  log_error("vars_2D_mpi",*) 'packing buffer is already used', vid
2063  call prc_abort
2064  end if
2065  use_packbuf(vid) = .true.
2066 #endif
2067 
2068  if ( comm_isallperiodic ) then
2069  !--- periodic condition
2070  !--- From 4-Direction HALO communicate
2071  ! From S
2072  call mpi_irecv( var(:,js-jhalo:js-1), comm_size2d_ns4, &
2073  comm_datatype, prc_next(prc_s), tag+1, &
2074  comm_world, req_list(ireq,vid), ierr )
2075  ireq = ireq + 1
2076 
2077  ! From N
2078  call mpi_irecv( var(:,je+1:je+jhalo), comm_size2d_ns4, &
2079  comm_datatype, prc_next(prc_n), tag+2, &
2080  comm_world, req_list(ireq,vid), ierr )
2081  ireq = ireq + 1
2082 
2083  ! From E
2084  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we, &
2085  comm_datatype, prc_next(prc_e), tag+3, &
2086  comm_world, req_list(ireq,vid), ierr )
2087  ireq = ireq + 1
2088 
2089  ! From W
2090  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we, &
2091  comm_datatype, prc_next(prc_w), tag+4, &
2092  comm_world, req_list(ireq,vid), ierr )
2093  ireq = ireq + 1
2094 
2095  call pack_2d(var, vid)
2096 
2097  ! To W HALO communicate
2098  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we, &
2099  comm_datatype, prc_next(prc_w), tag+3, &
2100  comm_world, req_list(ireq,vid), ierr )
2101  ireq = ireq + 1
2102 
2103  ! To E HALO communicate
2104  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we, &
2105  comm_datatype, prc_next(prc_e), tag+4, &
2106  comm_world, req_list(ireq,vid), ierr )
2107  ireq = ireq + 1
2108 
2109  ! To N HALO communicate
2110  call mpi_isend( var(:,je-jhalo+1:je), comm_size2d_ns4, &
2111  comm_datatype, prc_next(prc_n), tag+1, &
2112  comm_world, req_list(ireq,vid), ierr )
2113  ireq = ireq + 1
2114 
2115  ! To S HALO communicate
2116  call mpi_isend( var(:,js:js+jhalo-1), comm_size2d_ns4, &
2117  comm_datatype, prc_next(prc_s), tag+2, &
2118  comm_world, req_list(ireq,vid), ierr )
2119  ireq = ireq + 1
2120 
2121  else
2122  !--- non-periodic condition
2123  !--- From 4-Direction HALO communicate
2124  ! From S
2125  if ( prc_has_s ) then
2126  call mpi_irecv( var(:,js-jhalo:js-1), comm_size2d_ns4, &
2127  comm_datatype, prc_next(prc_s), tag+1, &
2128  comm_world, req_list(ireq,vid), ierr )
2129  ireq = ireq + 1
2130  endif
2131 
2132  ! From N
2133  if ( prc_has_n ) then
2134  call mpi_irecv( var(:,je+1:je+jhalo), comm_size2d_ns4, &
2135  comm_datatype, prc_next(prc_n), tag+2, &
2136  comm_world, req_list(ireq,vid), ierr )
2137  ireq = ireq + 1
2138  endif
2139 
2140  ! From E
2141  if ( prc_has_e ) then
2142  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we, &
2143  comm_datatype, prc_next(prc_e), tag+3, &
2144  comm_world, req_list(ireq,vid), ierr )
2145  ireq = ireq + 1
2146  endif
2147 
2148  ! From W
2149  if ( prc_has_w ) then
2150  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we, &
2151  comm_datatype, prc_next(prc_w), tag+4, &
2152  comm_world, req_list(ireq,vid), ierr )
2153  ireq = ireq + 1
2154  endif
2155 
2156  call pack_2d(var, vid)
2157 
2158  ! To W HALO communicate
2159  if ( prc_has_w ) then
2160  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we, &
2161  comm_datatype, prc_next(prc_w), tag+3, &
2162  comm_world, req_list(ireq,vid), ierr )
2163  ireq = ireq + 1
2164  endif
2165 
2166  ! To E HALO communicate
2167  if ( prc_has_e ) then
2168  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we, &
2169  comm_datatype, prc_next(prc_e), tag+4, &
2170  comm_world, req_list(ireq,vid), ierr )
2171  ireq = ireq + 1
2172  endif
2173 
2174  ! To N HALO communicate
2175  if ( prc_has_n ) then
2176  call mpi_isend( var(:,je-jhalo+1:je), comm_size2d_ns4, &
2177  comm_datatype, prc_next(prc_n), tag+1, &
2178  comm_world, req_list(ireq,vid), ierr )
2179  ireq = ireq + 1
2180  endif
2181 
2182  ! To S HALO communicate
2183  if ( prc_has_s ) then
2184  call mpi_isend( var(:,js:js+jhalo-1), comm_size2d_ns4, &
2185  comm_datatype, prc_next(prc_s), tag+2, &
2186  comm_world, req_list(ireq,vid), ierr )
2187  ireq = ireq + 1
2188  endif
2189 
2190  endif
2191 
2192  req_cnt(vid) = ireq - 1
2193 
2194  return
module PROCESS
Definition: scale_prc.F90:11
integer, public je
end point of inner domain: y, local
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:338
integer, public js
start point of inner domain: y, local
Here is the call graph for this function:
Here is the caller graph for this function:

◆ vars8_2d_mpi()

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

Definition at line 2198 of file scale_comm_cartesC.F90.

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(), scale_prc_cartesc::prc_e, 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_cartesc::prc_n, scale_prc_cartesc::prc_ne, scale_prc_cartesc::prc_next, scale_prc_cartesc::prc_nw, scale_prc_cartesc::prc_s, scale_prc_cartesc::prc_se, scale_prc_cartesc::prc_sw, and scale_prc_cartesc::prc_w.

Referenced by comm_vars8_init().

2198  use scale_prc, only: &
2199  prc_abort
2200  implicit none
2201 
2202  real(RP), intent(inout) :: var(:,:)
2203  integer, intent(in) :: vid
2204 
2205  integer :: ireq, tag, tagc
2206 
2207  integer :: ierr
2208  integer :: j
2209  !---------------------------------------------------------------------------
2210 
2211  tag = vid * 100
2212  ireq = 1
2213 
2214 #ifdef DEBUG
2215  if ( use_packbuf(vid) ) then
2216  log_error("vars8_2D_mpi",*) 'packing buffer is already used', vid
2217  call prc_abort
2218  end if
2219  use_packbuf(vid) = .true.
2220 #endif
2221 
2222  if ( comm_isallperiodic ) then
2223  !--- periodic condition
2224  !--- From 8-Direction HALO communicate
2225  ! From SE
2226  tagc = 0
2227  do j = js-jhalo, js-1
2228  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2229  comm_datatype, prc_next(prc_se), tag+tagc, &
2230  comm_world, req_list(ireq,vid), ierr )
2231  ireq = ireq + 1
2232  tagc = tagc + 1
2233  enddo
2234  ! From SW
2235  tagc = 10
2236  do j = js-jhalo, js-1
2237  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2238  comm_datatype, prc_next(prc_sw), tag+tagc, &
2239  comm_world, req_list(ireq,vid), ierr )
2240  ireq = ireq + 1
2241  tagc = tagc + 1
2242  enddo
2243  ! From NE
2244  tagc = 20
2245  do j = je+1, je+jhalo
2246  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2247  comm_datatype, prc_next(prc_ne), tag+tagc, &
2248  comm_world, req_list(ireq,vid), ierr )
2249  ireq = ireq + 1
2250  tagc = tagc + 1
2251  enddo
2252  ! From NW
2253  tagc = 30
2254  do j = je+1, je+jhalo
2255  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2256  comm_datatype, prc_next(prc_nw), tag+tagc, &
2257  comm_world, req_list(ireq,vid), ierr )
2258  ireq = ireq + 1
2259  tagc = tagc + 1
2260  enddo
2261  ! From S
2262  tagc = 40
2263  do j = js-jhalo, js-1
2264  call mpi_irecv( var(is,j), comm_size2d_ns8, &
2265  comm_datatype, prc_next(prc_s), tag+tagc, &
2266  comm_world, req_list(ireq,vid), ierr )
2267  ireq = ireq + 1
2268  tagc = tagc + 1
2269  enddo
2270  ! From N
2271  tagc = 50
2272  do j = je+1, je+jhalo
2273  call mpi_irecv( var(is,j), comm_size2d_ns8, &
2274  comm_datatype, prc_next(prc_n), tag+tagc, &
2275  comm_world, req_list(ireq,vid), ierr )
2276  ireq = ireq + 1
2277  tagc = tagc + 1
2278  enddo
2279  ! From E
2280  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we, &
2281  comm_datatype, prc_next(prc_e), tag+60, &
2282  comm_world, req_list(ireq,vid), ierr )
2283  ireq = ireq + 1
2284  ! From W
2285  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we, &
2286  comm_datatype, prc_next(prc_w), tag+70, &
2287  comm_world, req_list(ireq,vid), ierr )
2288  ireq = ireq + 1
2289 
2290  call pack_2d(var, vid)
2291 
2292  ! To W HALO communicate
2293  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we, &
2294  comm_datatype, prc_next(prc_w), tag+60, &
2295  comm_world, req_list(ireq,vid), ierr )
2296  ireq = ireq + 1
2297 
2298  ! To E HALO communicate
2299  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we, &
2300  comm_datatype, prc_next(prc_e), tag+70, &
2301  comm_world, req_list(ireq,vid), ierr )
2302  ireq = ireq + 1
2303 
2304  ! To N HALO communicate
2305  tagc = 40
2306  do j = je-jhalo+1, je
2307  call mpi_isend( var(is,j), comm_size2d_ns8, &
2308  comm_datatype, prc_next(prc_n), tag+tagc, &
2309  comm_world, req_list(ireq,vid), ierr )
2310  ireq = ireq + 1
2311  tagc = tagc + 1
2312  enddo
2313 
2314  ! To S HALO communicate
2315  tagc = 50
2316  do j = js, js+jhalo-1
2317  call mpi_isend( var(is,j), comm_size2d_ns8, &
2318  comm_datatype, prc_next(prc_s), tag+tagc, &
2319  comm_world, req_list(ireq,vid), ierr )
2320  ireq = ireq + 1
2321  tagc = tagc + 1
2322  enddo
2323 
2324  ! To NW HALO communicate
2325  tagc = 0
2326  do j = je-jhalo+1, je
2327  call mpi_isend( var(is,j), comm_size2d_4c, &
2328  comm_datatype, prc_next(prc_nw), tag+tagc, &
2329  comm_world, req_list(ireq,vid), ierr )
2330  ireq = ireq + 1
2331  tagc = tagc + 1
2332  enddo
2333 
2334  ! To NE HALO communicate
2335  tagc = 10
2336  do j = je-jhalo+1, je
2337  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2338  comm_datatype, prc_next(prc_ne), tag+tagc, &
2339  comm_world, req_list(ireq,vid), ierr )
2340  ireq = ireq + 1
2341  tagc = tagc + 1
2342  enddo
2343 
2344  ! To SW HALO communicate
2345  tagc = 20
2346  do j = js, js+jhalo-1
2347  call mpi_isend( var(is,j), comm_size2d_4c, &
2348  comm_datatype, prc_next(prc_sw), tag+tagc, &
2349  comm_world, req_list(ireq,vid), ierr )
2350  ireq = ireq + 1
2351  tagc = tagc + 1
2352  enddo
2353 
2354  ! To SE HALO communicate
2355  tagc = 30
2356  do j = js, js+jhalo-1
2357  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2358  comm_datatype, prc_next(prc_se), tag+tagc, &
2359  comm_world, req_list(ireq,vid), ierr )
2360  ireq = ireq + 1
2361  tagc = tagc + 1
2362  enddo
2363  else
2364  !--- non-periodic condition
2365  !--- From 8-Direction HALO communicate
2366  ! From SE
2367  if ( prc_has_s .AND. prc_has_e ) then
2368  tagc = 0
2369  do j = js-jhalo, js-1
2370  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2371  comm_datatype, prc_next(prc_se), tag+tagc, &
2372  comm_world, req_list(ireq,vid), ierr )
2373  ireq = ireq + 1
2374  tagc = tagc + 1
2375  enddo
2376  else if ( prc_has_s ) then
2377  tagc = 0
2378  do j = js-jhalo, js-1
2379  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2380  comm_datatype, prc_next(prc_s), tag+tagc, &
2381  comm_world, req_list(ireq,vid), ierr )
2382  ireq = ireq + 1
2383  tagc = tagc + 1
2384  enddo
2385  else if ( prc_has_e ) then
2386  tagc = 0
2387  do j = js-jhalo, js-1
2388  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2389  comm_datatype, prc_next(prc_e), tag+tagc, &
2390  comm_world, req_list(ireq,vid), ierr )
2391  ireq = ireq + 1
2392  tagc = tagc + 1
2393  enddo
2394  endif
2395 
2396  ! From SW
2397  if ( prc_has_s .AND. prc_has_w ) then
2398  tagc = 10
2399  do j = js-jhalo, js-1
2400  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2401  comm_datatype, prc_next(prc_sw), tag+tagc, &
2402  comm_world, req_list(ireq,vid), ierr )
2403  ireq = ireq + 1
2404  tagc = tagc + 1
2405  enddo
2406  else if ( prc_has_s ) then
2407  tagc = 10
2408  do j = js-jhalo, js-1
2409  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2410  comm_datatype, prc_next(prc_s), tag+tagc, &
2411  comm_world, req_list(ireq,vid), ierr )
2412  ireq = ireq + 1
2413  tagc = tagc + 1
2414  enddo
2415  else if ( prc_has_w ) then
2416  tagc = 10
2417  do j = js-jhalo, js-1
2418  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2419  comm_datatype, prc_next(prc_w), tag+tagc, &
2420  comm_world, req_list(ireq,vid), ierr )
2421  ireq = ireq + 1
2422  tagc = tagc + 1
2423  enddo
2424  endif
2425 
2426  ! From NE
2427  if ( prc_has_n .AND. prc_has_e ) then
2428  tagc = 20
2429  do j = je+1, je+jhalo
2430  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2431  comm_datatype, prc_next(prc_ne), tag+tagc, &
2432  comm_world, req_list(ireq,vid), ierr )
2433  ireq = ireq + 1
2434  tagc = tagc + 1
2435  enddo
2436  else if ( prc_has_n ) then
2437  tagc = 20
2438  do j = je+1, je+jhalo
2439  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2440  comm_datatype, prc_next(prc_n), tag+tagc, &
2441  comm_world, req_list(ireq,vid), ierr )
2442  ireq = ireq + 1
2443  tagc = tagc + 1
2444  enddo
2445  else if ( prc_has_e ) then
2446  tagc = 20
2447  do j = je+1, je+jhalo
2448  call mpi_irecv( var(ie+1,j), comm_size2d_4c, &
2449  comm_datatype, prc_next(prc_e), tag+tagc, &
2450  comm_world, req_list(ireq,vid), ierr )
2451  ireq = ireq + 1
2452  tagc = tagc + 1
2453  enddo
2454  endif
2455 
2456  ! From NW
2457  if ( prc_has_n .AND. prc_has_w ) then
2458  tagc = 30
2459  do j = je+1, je+jhalo
2460  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2461  comm_datatype, prc_next(prc_nw), tag+tagc, &
2462  comm_world, req_list(ireq,vid), ierr )
2463  ireq = ireq + 1
2464  tagc = tagc + 1
2465  enddo
2466  else if ( prc_has_n ) then
2467  tagc = 30
2468  do j = je+1, je+jhalo
2469  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2470  comm_datatype, prc_next(prc_n), tag+tagc, &
2471  comm_world, req_list(ireq,vid), ierr )
2472  ireq = ireq + 1
2473  tagc = tagc + 1
2474  enddo
2475  else if ( prc_has_w ) then
2476  tagc = 30
2477  do j = je+1, je+jhalo
2478  call mpi_irecv( var(is-ihalo,j), comm_size2d_4c, &
2479  comm_datatype, prc_next(prc_w), tag+tagc, &
2480  comm_world, req_list(ireq,vid), ierr )
2481  ireq = ireq + 1
2482  tagc = tagc + 1
2483  enddo
2484  endif
2485 
2486  ! From S
2487  if ( prc_has_s ) then
2488  tagc = 40
2489  do j = js-jhalo, js-1
2490  call mpi_irecv( var(is,j), comm_size2d_ns8, &
2491  comm_datatype, prc_next(prc_s), tag+tagc, &
2492  comm_world, req_list(ireq,vid), ierr )
2493  ireq = ireq + 1
2494  tagc = tagc + 1
2495  enddo
2496  endif
2497 
2498  ! From N
2499  if ( prc_has_n ) then
2500  tagc = 50
2501  do j = je+1, je+jhalo
2502  call mpi_irecv( var(is,j), comm_size2d_ns8, &
2503  comm_datatype, prc_next(prc_n), tag+tagc, &
2504  comm_world, req_list(ireq,vid), ierr )
2505  ireq = ireq + 1
2506  tagc = tagc + 1
2507  enddo
2508  endif
2509 
2510  ! From E
2511  if ( prc_has_e ) then
2512  call mpi_irecv( recvpack_e2p(:,vid), comm_size2d_we, &
2513  comm_datatype, prc_next(prc_e), tag+60, &
2514  comm_world, req_list(ireq,vid), ierr )
2515  ireq = ireq + 1
2516  endif
2517 
2518  ! From W
2519  if ( prc_has_w ) then
2520  call mpi_irecv( recvpack_w2p(:,vid), comm_size2d_we, &
2521  comm_datatype, prc_next(prc_w), tag+70, &
2522  comm_world, req_list(ireq,vid), ierr )
2523  ireq = ireq + 1
2524  endif
2525 
2526  call pack_2d(var, vid)
2527 
2528  ! To W HALO communicate
2529  if ( prc_has_w ) then
2530  call mpi_isend( sendpack_p2w(:,vid), comm_size2d_we, &
2531  comm_datatype, prc_next(prc_w), tag+60, &
2532  comm_world, req_list(ireq,vid), ierr )
2533  ireq = ireq + 1
2534  endif
2535 
2536  ! To E HALO communicate
2537  if ( prc_has_e ) then
2538  call mpi_isend( sendpack_p2e(:,vid), comm_size2d_we, &
2539  comm_datatype, prc_next(prc_e), tag+70, &
2540  comm_world, req_list(ireq,vid), ierr )
2541  ireq = ireq + 1
2542  endif
2543 
2544  ! To N HALO communicate
2545  if ( prc_has_n ) then
2546  tagc = 40
2547  do j = je-jhalo+1, je
2548  call mpi_isend( var(is,j), comm_size2d_ns8, &
2549  comm_datatype, prc_next(prc_n), tag+tagc, &
2550  comm_world, req_list(ireq,vid), ierr )
2551  ireq = ireq + 1
2552  tagc = tagc + 1
2553  enddo
2554  endif
2555 
2556  ! To S HALO communicate
2557  if ( prc_has_s ) then
2558  tagc = 50
2559  do j = js, js+jhalo-1
2560  call mpi_isend( var(is,j), comm_size2d_ns8, &
2561  comm_datatype, prc_next(prc_s), tag+tagc, &
2562  comm_world, req_list(ireq,vid), ierr )
2563  ireq = ireq + 1
2564  tagc = tagc + 1
2565  enddo
2566  endif
2567 
2568  ! To NW HALO communicate
2569  if ( prc_has_n .AND. prc_has_w ) then
2570  tagc = 0
2571  do j = je-jhalo+1, je
2572  call mpi_isend( var(is,j), comm_size2d_4c, &
2573  comm_datatype, prc_next(prc_nw), tag+tagc, &
2574  comm_world, req_list(ireq,vid), ierr )
2575  ireq = ireq + 1
2576  tagc = tagc + 1
2577  enddo
2578  else if ( prc_has_n ) then
2579  tagc = 10
2580  do j = je-jhalo+1, je
2581  call mpi_isend( var(is,j), comm_size2d_4c, &
2582  comm_datatype, prc_next(prc_n), tag+tagc, &
2583  comm_world, req_list(ireq,vid), ierr )
2584  ireq = ireq + 1
2585  tagc = tagc + 1
2586  enddo
2587  else if ( prc_has_w ) then
2588  tagc = 20
2589  do j = je-jhalo+1, je
2590  call mpi_isend( var(is,j), comm_size2d_4c, &
2591  comm_datatype, prc_next(prc_w), tag+tagc, &
2592  comm_world, req_list(ireq,vid), ierr )
2593  ireq = ireq + 1
2594  tagc = tagc + 1
2595  enddo
2596  endif
2597 
2598  ! To NE HALO communicate
2599  if ( prc_has_n .AND. prc_has_e ) then
2600  tagc = 10
2601  do j = je-jhalo+1, je
2602  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2603  comm_datatype, prc_next(prc_ne), tag+tagc, &
2604  comm_world, req_list(ireq,vid), ierr )
2605  ireq = ireq + 1
2606  tagc = tagc + 1
2607  enddo
2608  else if ( prc_has_n ) then
2609  tagc = 0
2610  do j = je-jhalo+1, je
2611  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2612  comm_datatype, prc_next(prc_n), tag+tagc, &
2613  comm_world, req_list(ireq,vid), ierr )
2614  ireq = ireq + 1
2615  tagc = tagc + 1
2616  enddo
2617  else if ( prc_has_e ) then
2618  tagc = 30
2619  do j = je-jhalo+1, je
2620  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2621  comm_datatype, prc_next(prc_e), tag+tagc, &
2622  comm_world, req_list(ireq,vid), ierr )
2623  ireq = ireq + 1
2624  tagc = tagc + 1
2625  enddo
2626  endif
2627 
2628  ! To SW HALO communicate
2629  if ( prc_has_s .AND. prc_has_w ) then
2630  tagc = 20
2631  do j = js, js+jhalo-1
2632  call mpi_isend( var(is,j), comm_size2d_4c, &
2633  comm_datatype, prc_next(prc_sw), tag+tagc, &
2634  comm_world, req_list(ireq,vid), ierr )
2635  ireq = ireq + 1
2636  tagc = tagc + 1
2637  enddo
2638  else if ( prc_has_s ) then
2639  tagc = 30
2640  do j = js, js+jhalo-1
2641  call mpi_isend( var(is,j), comm_size2d_4c, &
2642  comm_datatype, prc_next(prc_s), tag+tagc, &
2643  comm_world, req_list(ireq,vid), ierr )
2644  ireq = ireq + 1
2645  tagc = tagc + 1
2646  enddo
2647  else if ( prc_has_w ) then
2648  tagc = 0
2649  do j = js, js+jhalo-1
2650  call mpi_isend( var(is,j), comm_size2d_4c, &
2651  comm_datatype, prc_next(prc_w), tag+tagc, &
2652  comm_world, req_list(ireq,vid), ierr )
2653  ireq = ireq + 1
2654  tagc = tagc + 1
2655  enddo
2656  endif
2657 
2658  ! To SE HALO communicate
2659  if ( prc_has_s .AND. prc_has_e ) then
2660  tagc = 30
2661  do j = js, js+jhalo-1
2662  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2663  comm_datatype, prc_next(prc_se), tag+tagc, &
2664  comm_world, req_list(ireq,vid), ierr )
2665  ireq = ireq + 1
2666  tagc = tagc + 1
2667  enddo
2668  else if ( prc_has_s ) then
2669  tagc = 20
2670  do j = js, js+jhalo-1
2671  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2672  comm_datatype, prc_next(prc_s), tag+tagc, &
2673  comm_world, req_list(ireq,vid), ierr )
2674  ireq = ireq + 1
2675  tagc = tagc + 1
2676  enddo
2677  else if ( prc_has_e ) then
2678  tagc = 10
2679  do j = js, js+jhalo-1
2680  call mpi_isend( var(ie-ihalo+1,j), comm_size2d_4c, &
2681  comm_datatype, prc_next(prc_e), tag+tagc, &
2682  comm_world, req_list(ireq,vid), ierr )
2683  ireq = ireq + 1
2684  tagc = tagc + 1
2685  enddo
2686  endif
2687 
2688  endif
2689 
2690  req_cnt(vid) = ireq - 1
2691 
2692  return
integer, public is
start point of inner domain: x, local
integer, public ie
end point of inner domain: x, local
module PROCESS
Definition: scale_prc.F90:11
integer, public je
end point of inner domain: y, local
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:338
integer, public js
start point of inner domain: y, local
Here is the call graph for this function:
Here is the caller graph for this function:

◆ 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 2696 of file scale_comm_cartesC.F90.

References scale_prc::prc_abort().

Referenced by comm_vars8_init().

2696  use scale_prc, only: &
2697  prc_abort
2698  implicit none
2699 
2700  real(RP), intent(inout) :: var(:,:,:)
2701  integer, intent(in) :: vid
2702  integer :: ierr
2703  !---------------------------------------------------------------------------
2704 
2705 #ifdef DEBUG
2706  if ( use_packbuf(pseqid(vid)) ) then
2707  log_error("vars_3D_mpi_pc",*) 'packing buffer is already used', vid, pseqid(vid)
2708  call prc_abort
2709  end if
2710  use_packbuf(pseqid(vid)) = .true.
2711 #endif
2712 
2713  call pack_3d(var, pseqid(vid))
2714 
2715  call mpi_startall(preq_cnt(vid), preq_list(1:preq_cnt(vid),vid), ierr)
2716 
2717  return
module PROCESS
Definition: scale_prc.F90:11
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:338
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 2721 of file scale_comm_cartesC.F90.

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_n, scale_prc_cartesc::prc_has_s, scale_prc_cartesc::prc_has_w, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Referenced by comm_vars8_init().

2721  implicit none
2722  real(RP), intent(inout) :: var(:,:,:)
2723  integer, intent(in) :: vid
2724 
2725  integer :: ierr
2726  !---------------------------------------------------------------------------
2727 
2728  !--- wait packets
2729  call mpi_waitall( req_cnt(vid), &
2730  req_list(1:req_cnt(vid),vid), &
2731  mpi_statuses_ignore, &
2732  ierr )
2733  call unpack_3d(var, vid)
2734 
2735 #ifdef DEBUG
2736  use_packbuf(vid) = .false.
2737 #endif
2738 
2739  return
Here is the call graph for this function:
Here is the caller graph for this function:

◆ comm_cleanup()

subroutine, public scale_comm_cartesc::comm_cleanup ( )

Definition at line 3373 of file scale_comm_cartesC.F90.

Referenced by mod_rm_driver::rm_driver().

3373  use mpi
3374  implicit none
3375 
3376  integer :: i, j, ierr
3377  !---------------------------------------------------------------------------
3378 
3379  deallocate( recvpack_w2p )
3380  deallocate( recvpack_e2p )
3381  deallocate( sendpack_p2w )
3382  deallocate( sendpack_p2e )
3383 #ifdef DEBUG
3384  deallocate( use_packbuf )
3385 #endif
3386 
3387  deallocate( req_cnt )
3388  deallocate( req_list )
3389 
3390  if ( comm_use_mpi_pc ) then
3391  do j=1, comm_vsize_max_pc
3392  do i=1, comm_nreq_max+1
3393  if (preq_list(i,j) .NE. mpi_request_null) &
3394  call mpi_request_free(preq_list(i,j), ierr)
3395  enddo
3396  enddo
3397  deallocate( preq_cnt )
3398  deallocate( preq_list )
3399  deallocate( pseqid )
3400  end if
Here is the caller graph for this function:

Variable Documentation

◆ comm_datatype

integer, public scale_comm_cartesc::comm_datatype

◆ comm_world

integer, public scale_comm_cartesc::comm_world