SCALE-RM
scale_prc_icoA.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
10 #include "scalelib.h"
11 module scale_prc_icoa
12  !-----------------------------------------------------------------------------
13  !
14  !++ used modules
15  !
16  use mpi
17  use scale_precision
18  use scale_io
19  use scale_prc, only: &
20  prc_masterrank
21  !-----------------------------------------------------------------------------
22  implicit none
23  private
24  !-----------------------------------------------------------------------------
25  !
26  !++ Public procedure
27  !
28  public :: prc_icoa_setup
29  public :: prc_icoa_rgn_generate
30 
31  !-----------------------------------------------------------------------------
32  !
33  !++ Public parameters & variables
34  !
35 
36  !====== Information for processes ======
37 
38  integer, public, parameter :: prc_rank_pl = prc_masterrank
39  logical, public :: prc_have_pl
40 
41  !====== Information for processes-region relationship ======
42 
43  integer, public, parameter :: i_l = 1
44  integer, public, parameter :: i_prc = 2
45 
46  integer, public, parameter :: i_rgnid = 1
47  integer, public, parameter :: i_dir = 2
48 
49  ! Identifiers of directions of region edges
50  integer, public, parameter :: i_sw = 1
51  integer, public, parameter :: i_nw = 2
52  integer, public, parameter :: i_ne = 3
53  integer, public, parameter :: i_se = 4
54 
55  ! Identifiers of directions of region vertices
56  integer, public, parameter :: i_w = 1
57  integer, public, parameter :: i_n = 2
58  integer, public, parameter :: i_e = 3
59  integer, public, parameter :: i_s = 4
60 
61  ! Identifier of poles (north pole or south pole)
62  integer, public, parameter :: i_npl = 1
63  integer, public, parameter :: i_spl = 2
64 
65  ! main parameter
66  integer, public :: prc_rgn_level = -1
67  integer, public :: prc_rgn_ndiamond = 10
68  integer, public :: prc_rgn_vlink = 5
69 
70  ! region
71  integer, public :: prc_rgn_total
72  integer, public :: prc_rgn_local
73  integer, public, parameter :: prc_rgn_total_pl = 2
74 
75  integer, public, parameter :: prc_rgn_local_lim = 2560
76 
77  integer, public, allocatable :: prc_rgn_edge_tab (:,:,:)
78 
79  integer, public, allocatable :: prc_rgn_vert_num (:,:)
80  logical, public, allocatable :: prc_rgn_vert_pl (:,:)
81  integer, public, allocatable :: prc_rgn_vert_tab (:,:,:,:)
82  integer, public, allocatable :: prc_rgn_vert_tab_pl(:,:,:)
83 
84  integer, public, allocatable :: prc_rgn_lp2r(:,:)
85  integer, public, allocatable :: prc_rgn_r2lp(:,:)
86  integer, public, allocatable :: prc_rgn_l2r (:)
87 
88  integer, public :: prc_rgn_r2p_pl(prc_rgn_total_pl)
89  integer, public :: prc_rgn_rgn4pl(prc_rgn_total_pl)
90 
91  !====== Information for regions ======
92 
93  logical, public, allocatable :: prc_rgn_have_sgp(:)
94 
95  !-----------------------------------------------------------------------------
96  !
97  !++ Private procedure
98  !
99  private :: prc_icoa_rgn_setup
100  private :: prc_icoa_rgn_input
101  private :: prc_icoa_rgn_output
102  private :: prc_icoa_rgn_vertex_walkaround
103  private :: output_info
104 
105  !-----------------------------------------------------------------------------
106  !
107  !++ Private parameters & variables
108  !
109  character(len=H_LONG), private :: prc_icoa_rgn_in_fname = ''
110  character(len=H_LONG), private :: prc_icoa_rgn_out_fname = ''
111 
112  character(len=2), private, parameter :: prc_rgn_edgename(4) = (/'SW','NW','NE','SE'/)
113  character(len=2), private, parameter :: prc_rgn_vertname(4) = (/'W ','N ','E ','S '/)
114 
115  logical, private :: debug = .false.
116 
117  !-----------------------------------------------------------------------------
118 contains
119  !-----------------------------------------------------------------------------
121  subroutine prc_icoa_setup
122  use scale_prc, only: &
123  prc_abort, &
124  prc_abort_comm_world, &
125  prc_universal_comm_world, &
126  prc_universal_nprocs, &
127  prc_universal_myrank, &
128  prc_universal_ismaster, &
129  prc_global_comm_world, &
130  prc_global_nprocs, &
131  prc_global_myrank, &
132  prc_global_ismaster, &
133  prc_local_comm_world, &
134  prc_nprocs, &
135  prc_myrank, &
136  prc_ismaster
137  implicit none
138 
139  namelist / param_prc_icoa / &
140  prc_rgn_level, &
141  prc_rgn_ndiamond, &
142  debug
143 
144  integer :: l, rgnid
145 
146  integer :: ierr
147  !---------------------------------------------------------------------------
148 
149  log_newline
150  log_info("PRC_ICOA_setup",*) 'Setup'
151 
152  if ( io_l ) then
153  log_newline
154  log_progress(*) 'start MPI'
155  log_newline
156  log_info("PRC_ICOA_setup",*) 'Process information '
157  log_info_cont('(1x,A,I12)') 'UNIVERSAL_COMM_WORLD : ', prc_universal_comm_world
158  log_info_cont('(1x,A,I12)') 'total process [UNIVERSAL] : ', prc_universal_nprocs
159  log_info_cont('(1x,A,I12)') 'my process ID [UNIVERSAL] : ', prc_universal_myrank
160  log_info_cont('(1x,A,L12)') 'master rank? [UNIVERSAL] : ', prc_universal_ismaster
161  log_info_cont('(1x,A,I12)') 'GLOBAL_COMM_WORLD : ', prc_global_comm_world
162  log_info_cont('(1x,A,I12)') 'total process [GLOBAL] : ', prc_global_nprocs
163  log_info_cont('(1x,A,I12)') 'my process ID [GLOBAL] : ', prc_global_myrank
164  log_info_cont('(1x,A,L12)') 'master rank? [GLOBAL] : ', prc_global_ismaster
165  log_info_cont('(1x,A,I12)') 'LOCAL_COMM_WORLD : ', prc_local_comm_world
166  log_info_cont('(1x,A,I12)') 'total process [LOCAL] : ', prc_nprocs
167  log_info_cont('(1x,A,I12)') 'my process ID [LOCAL] : ', prc_myrank
168  log_info_cont('(1x,A,L12)') 'master rank? [LOCAL] : ', prc_ismaster
169  log_info_cont('(1x,A,I12)') 'ABORT_COMM_WORLD : ', prc_abort_comm_world
170  log_info_cont('(1x,A,I12)') 'master rank ID [each world] : ', prc_masterrank
171  endif
172 
173  !--- read namelist
174  rewind(io_fid_conf)
175  read(io_fid_conf,nml=param_prc_icoa,iostat=ierr)
176  if( ierr < 0 ) then !--- missing
177  log_info("PRC_ICOA_setup",*) 'Not found namelist. Default used.'
178  elseif( ierr > 0 ) then !--- fatal error
179  log_error("PRC_ICOA_setup",*) 'Not appropriate names in namelist PARAM_PRC_ICOA. Check!'
180  call prc_abort
181  endif
182  if( io_nml ) write(io_fid_nml,nml=param_prc_icoa)
183 
184  if ( prc_rgn_level < 0 ) then
185  log_error("PRC_ICOA_setup",*) 'PRC_RGN_level is not appropriate :', prc_rgn_level
186  call prc_abort
187  endif
188 
189  if ( prc_rgn_ndiamond == 10 &
190  .OR. prc_rgn_ndiamond == 12 ) then
191  prc_rgn_vlink = prc_rgn_ndiamond / 2
192  else
193  log_error("PRC_ICOA_setup",*) 'PRC_RGN_ndiamond is not appropriate :', prc_rgn_ndiamond
194  call prc_abort
195  endif
196 
197  prc_rgn_total = 2**prc_rgn_level * 2**prc_rgn_level * prc_rgn_ndiamond
198  prc_rgn_local = prc_rgn_total / prc_nprocs
199 
200  if ( mod(prc_rgn_total,prc_nprocs) /= 0 ) then
201  log_error("PRC_ICOA_setup",*) 'Number of total region must be divisible by the number of process', prc_rgn_total, prc_nprocs
202  call prc_abort
203  endif
204 
205  if ( prc_rgn_local > prc_rgn_local_lim ) then
206  log_error("PRC_ICOA_setup",*) 'limit exceed! local region: ', prc_rgn_local, prc_rgn_local_lim
207  call prc_abort
208  endif
209 
210  call prc_icoa_rgn_setup
211 
212  ! pole region management flag
213  if ( prc_myrank == prc_rank_pl ) then
214  prc_have_pl = .true.
215  else
216  prc_have_pl = .false.
217  endif
218 
219  ! singlar point management flag
220  allocate( prc_rgn_have_sgp(prc_rgn_local) )
221  prc_rgn_have_sgp(:) = .false.
222 
223  do l = 1, prc_rgn_local
224  rgnid = prc_rgn_lp2r(l,prc_myrank)
225  if ( prc_rgn_vert_num(i_w,rgnid) == 3 ) then
226  prc_rgn_have_sgp(l) = .true.
227  endif
228  enddo
229 
230  call output_info
231 
232  return
233  end subroutine prc_icoa_setup
234 
235  !-----------------------------------------------------------------------------
236  subroutine prc_icoa_rgn_setup
237  use scale_prc, only: &
238  prc_abort, &
239  prc_nprocs, &
240  prc_myrank
241  implicit none
242 
243  namelist / param_prc_icoa_rgn / &
244  prc_icoa_rgn_in_fname, &
245  prc_icoa_rgn_out_fname, &
246  debug
247 
248  integer :: l, p, r
249  integer :: ierr
250  !---------------------------------------------------------------------------
251 
252  log_newline
253  log_info("PRC_ICOA_RGN_setup",*) 'Setup'
254 
255  !--- read namelist
256  rewind(io_fid_conf)
257  read(io_fid_conf,nml=param_prc_icoa_rgn,iostat=ierr)
258  if( ierr < 0 ) then !--- missing
259  log_info("PRC_ICOA_RGN_setup",*) 'Not found namelist. Default used.'
260  elseif( ierr > 0 ) then !--- fatal error
261  log_error("PRC_ICOA_RGN_setup",*) 'Not appropriate names in namelist PARAM_PRC_ICOA_RGN. Check!'
262  call prc_abort
263  endif
264  if( io_nml ) write(io_fid_nml,nml=param_prc_icoa_rgn)
265 
266  ! Global information (Each process has all the information)
267  allocate( prc_rgn_edge_tab(i_rgnid:i_dir,i_sw:i_se,prc_rgn_total) )
268  allocate( prc_rgn_lp2r(prc_rgn_local,0:prc_nprocs-1) )
269 
270  if ( prc_icoa_rgn_in_fname /= '' ) then
271  call prc_icoa_rgn_input( prc_icoa_rgn_in_fname, & ! [IN]
272  prc_nprocs, & ! [IN]
273  prc_rgn_total, & ! [IN]
274  prc_rgn_local, & ! [IN]
275  prc_rgn_edge_tab(:,:,:), & ! [OUT]
276  prc_rgn_lp2r(:,:) ) ! [OUT]
277  else
278  log_info("PRC_ICOA_RGN_setup",*) 'input file is not specified.'
279 
280  call prc_icoa_rgn_generate( prc_rgn_level, & ! [IN]
281  prc_rgn_ndiamond, & ! [IN]
282  prc_nprocs, & ! [IN]
283  prc_rgn_total, & ! [IN]
284  prc_rgn_local, & ! [IN]
285  prc_rgn_edge_tab(:,:,:), & ! [OUT]
286  prc_rgn_lp2r(:,:) ) ! [OUT]
287  endif
288 
289  if ( prc_icoa_rgn_out_fname /= '' ) then
290  call prc_icoa_rgn_output( prc_icoa_rgn_out_fname, & ! [IN]
291  prc_nprocs, & ! [IN]
292  prc_rgn_total, & ! [IN]
293  prc_rgn_local, & ! [IN]
294  prc_rgn_edge_tab(:,:,:), & ! [IN]
295  prc_rgn_lp2r(:,:) ) ! [IN]
296  endif
297 
298  !--- additional table (reversal,local)
299  allocate( prc_rgn_r2lp(2,prc_rgn_total) )
300  allocate( prc_rgn_l2r( prc_rgn_local) )
301 
302  do p = 0, prc_nprocs-1
303  do l = 1, prc_rgn_local
304  prc_rgn_r2lp(i_l, prc_rgn_lp2r(l,p)) = l
305  prc_rgn_r2lp(i_prc,prc_rgn_lp2r(l,p)) = p
306  enddo
307  enddo
308 
309  do l = 1, prc_rgn_local
310  prc_rgn_l2r(l) = prc_rgn_lp2r(l,prc_myrank)
311  enddo
312 
313  !--- region connection chains around the diamond vertexes
314  allocate( prc_rgn_vert_num(i_w:i_s,prc_rgn_total) )
315  allocate( prc_rgn_vert_pl(prc_rgn_total_pl,prc_rgn_total) )
316  allocate( prc_rgn_vert_tab(i_rgnid:i_dir,i_w:i_s,prc_rgn_total ,prc_rgn_vlink) )
317  allocate( prc_rgn_vert_tab_pl(i_rgnid:i_dir, prc_rgn_total_pl,prc_rgn_vlink) )
318 
319  call prc_icoa_rgn_vertex_walkaround( prc_rgn_total, & ! [IN]
320  prc_rgn_total_pl, & ! [IN]
321  prc_rgn_vlink, & ! [IN]
322  prc_rgn_edge_tab(:,:,:), & ! [IN]
323  prc_rgn_vert_num(:,:), & ! [OUT]
324  prc_rgn_vert_pl(:,:), & ! [OUT]
325  prc_rgn_vert_tab(:,:,:,:), & ! [OUT]
326  prc_rgn_vert_tab_pl(:,:,:) ) ! [OUT]
327 
328  !--- tables for pole
329  do r = 1, prc_rgn_total
330  if ( prc_rgn_vert_pl(i_npl,r) ) then
331  prc_rgn_rgn4pl(i_npl) = r
332  exit
333  endif
334  enddo
335 
336  do r = 1, prc_rgn_total
337  if ( prc_rgn_vert_pl(i_spl,r) ) then
338  prc_rgn_rgn4pl(i_spl) = r
339  exit
340  endif
341  enddo
342 
343  prc_rgn_r2p_pl(i_npl) = prc_rank_pl
344  prc_rgn_r2p_pl(i_spl) = prc_rank_pl
345 
346  return
347  end subroutine prc_icoa_rgn_setup
348 
349  !-----------------------------------------------------------------------------
351  subroutine prc_icoa_rgn_input( &
352  in_fname, &
353  pall, &
354  rall, &
355  lall, &
356  edge_tab, &
357  lp2r )
358  use scale_prc, only: &
359  prc_abort
360  implicit none
361 
362  character(len=*), intent(in) :: in_fname
363  integer, intent(in) :: pall
364  integer, intent(in) :: rall
365  integer, intent(in) :: lall
366  integer, intent(out) :: edge_tab(2,4,rall)
367  integer, intent(out) :: lp2r(lall,0:pall-1)
368 
369  integer :: num_of_rgn
370 
371  namelist / rgn_info / &
372  num_of_rgn
373 
374  integer :: rgnid
375  integer :: sw(2) = -1
376  integer :: nw(2) = -1
377  integer :: ne(2) = -1
378  integer :: se(2) = -1
379 
380  namelist / rgn_link_info / &
381  rgnid, &
382  sw, &
383  nw, &
384  ne, &
385  se
386 
387  integer :: num_of_proc
388 
389  namelist / proc_info / &
390  num_of_proc
391 
392  integer :: peid
393  integer :: num_of_mng
394  integer :: mng_rgnid(prc_rgn_local_lim)
395 
396  namelist / rgn_mng_info / &
397  peid, &
398  num_of_mng, &
399  mng_rgnid
400 
401  integer :: fid, ierr
402  integer :: r, p, l
403  !---------------------------------------------------------------------------
404 
405  log_info("PRC_ICOA_RGN_input",*) 'input region management information file: ', trim(in_fname)
406 
407  fid = io_get_available_fid()
408  open( unit = fid, &
409  file = trim(in_fname), &
410  form = 'formatted', &
411  status = 'old', &
412  iostat = ierr )
413 
414  ! ERROR if filename are not defined
415  if ( ierr /= 0 ) then
416  log_error("PRC_ICOA_RGN_input",*) 'File is not found!', trim(in_fname)
417  call prc_abort
418  endif
419 
420  read(fid,nml=rgn_info)
421 
422  if ( num_of_rgn /= rall ) then
423  log_error("PRC_ICOA_RGN_input",*) 'Missmatch of region number!'
424  log_error_cont(*) 'rall= ', rall,', num_of_rgn=', num_of_rgn
425  call prc_abort
426  endif
427 
428  do r = 1, rall
429  read(fid,nml=rgn_link_info)
430 
431  edge_tab(i_rgnid:i_dir,i_sw,rgnid) = sw(i_rgnid:i_dir)
432  edge_tab(i_rgnid:i_dir,i_nw,rgnid) = nw(i_rgnid:i_dir)
433  edge_tab(i_rgnid:i_dir,i_ne,rgnid) = ne(i_rgnid:i_dir)
434  edge_tab(i_rgnid:i_dir,i_se,rgnid) = se(i_rgnid:i_dir)
435  enddo
436 
437  read(fid,nml=proc_info)
438  if ( num_of_proc /= pall ) then
439  log_error("PRC_ICOA_RGN_input",*) ' Missmatch of process number!'
440  log_error_cont(*) ' pall= ', pall, ', num_of_proc=', num_of_proc
441  call prc_abort
442  endif
443 
444  do p = 0, pall-1
445  read(fid,nml=rgn_mng_info)
446 
447  if ( p /= peid ) then
448  log_error("PRC_ICOA_RGN_input",*) 'Wrong peid: ', p, peid
449  call prc_abort
450  endif
451 
452  if ( num_of_mng /= lall ) then
453  log_error("PRC_ICOA_RGN_input",*) 'number of local region is not match: ', p, num_of_mng, lall
454  call prc_abort
455  endif
456 
457  lp2r(:,p) = -1 ! initialize
458  do l = 1, lall
459  lp2r(l,p) = mng_rgnid(l)
460  enddo
461  enddo
462 
463  close(fid)
464 
465  return
466  end subroutine prc_icoa_rgn_input
467 
468  !-----------------------------------------------------------------------------
470  subroutine prc_icoa_rgn_output( &
471  out_fname, &
472  pall, &
473  rall, &
474  lall, &
475  edge_tab, &
476  lp2r )
477  use scale_prc, only: &
478  prc_ismaster
479  implicit none
480 
481  character(len=*), intent(in) :: out_fname
482  integer, intent(in) :: pall
483  integer, intent(in) :: rall
484  integer, intent(in) :: lall
485  integer, intent(in) :: edge_tab(2,4,rall)
486  integer, intent(in) :: lp2r(lall,pall)
487 
488  integer :: num_of_rgn
489 
490  namelist / rgn_info / &
491  num_of_rgn
492 
493  integer :: rgnid
494  integer :: sw(2) = -1
495  integer :: nw(2) = -1
496  integer :: ne(2) = -1
497  integer :: se(2) = -1
498 
499  namelist / rgn_link_info / &
500  rgnid, &
501  sw, &
502  nw, &
503  ne, &
504  se
505 
506  integer :: num_of_proc
507 
508  namelist / proc_info / &
509  num_of_proc
510 
511  integer :: peid
512  integer :: num_of_mng
513  integer :: mng_rgnid(prc_rgn_local_lim)
514 
515  namelist / rgn_mng_info / &
516  peid, &
517  num_of_mng, &
518  mng_rgnid
519 
520  integer :: fid
521  integer :: r, p, l
522  !---------------------------------------------------------------------------
523 
524  if ( prc_ismaster ) then
525  log_info("PRC_ICOA_RGN_output",*) 'output region management information file: ', trim(out_fname)
526 
527  fid = io_get_available_fid()
528  open( unit = fid, &
529  file = trim(out_fname), &
530  form = 'formatted' )
531 
532  num_of_rgn = rall
533  write(fid,nml=rgn_info)
534 
535  do r = 1, rall
536  rgnid = r
537  sw(i_rgnid:i_dir) = edge_tab(i_rgnid:i_dir,i_sw,rgnid)
538  nw(i_rgnid:i_dir) = edge_tab(i_rgnid:i_dir,i_nw,rgnid)
539  ne(i_rgnid:i_dir) = edge_tab(i_rgnid:i_dir,i_ne,rgnid)
540  se(i_rgnid:i_dir) = edge_tab(i_rgnid:i_dir,i_se,rgnid)
541 
542  write(fid,nml=rgn_link_info)
543  enddo
544 
545  num_of_proc = pall
546  write(fid,nml=proc_info)
547 
548  do p = 0, pall-1
549  peid = p
550  num_of_mng = lall
551 
552  mng_rgnid(:) = -1
553  do l = 1, lall
554  mng_rgnid(l) = lp2r(l,p)
555  enddo
556 
557  write(fid,nml=rgn_mng_info)
558  enddo
559 
560  close(fid)
561  else
562  log_info("PRC_ICOA_RGN_output",*) 'output region management information file at the master process'
563  endif
564 
565  return
566  end subroutine prc_icoa_rgn_output
567 
568  !-----------------------------------------------------------------------------
570  Subroutine prc_icoa_rgn_generate( &
571  rlevel, &
572  ndmd, &
573  pall, &
574  rall, &
575  lall, &
576  edge_tab, &
577  lp2r )
578  use scale_prc, only: &
579  prc_abort
580  implicit none
581 
582  integer, intent(in) :: rlevel
583  integer, intent(in) :: ndmd
584  integer, intent(in) :: pall
585  integer, intent(in) :: rall
586  integer, intent(in) :: lall
587  integer, intent(out) :: edge_tab(2,4,rall)
588  integer, intent(out) :: lp2r(lall,0:pall-1)
589 
590  integer :: dmd_data(4,ndmd)
591  integer :: rall_1d, rall_1dmd
592 
593  integer :: d_nb, i_nb, j_nb, rgnid_nb, direction
594  integer :: d, i, j, rgnid
595  integer :: l, p
596  !---------------------------------------------------------------------------
597 
598  log_info("PRC_ICOA_RGN_generate",*) 'generate region management information file'
599 
600  if ( ndmd == 10 ) then
601  log_info_cont(*) 'Topology: icosahedral'
602  dmd_data(:, 1) = (/ 6, 5, 2,10 /)
603  dmd_data(:, 2) = (/ 10, 1, 3, 9 /)
604  dmd_data(:, 3) = (/ 9, 2, 4, 8 /)
605  dmd_data(:, 4) = (/ 8, 3, 5, 7 /)
606  dmd_data(:, 5) = (/ 7, 4, 1, 6 /)
607  dmd_data(:, 6) = (/ 7, 5, 1,10 /)
608  dmd_data(:, 7) = (/ 8, 4, 5, 6 /)
609  dmd_data(:, 8) = (/ 9, 3, 4, 7 /)
610  dmd_data(:, 9) = (/ 10, 2, 3, 8 /)
611  dmd_data(:,10) = (/ 6, 1, 2, 9 /)
612  elseif( ndmd == 12 ) then
613  log_info_cont(*) 'Topology: icosatetrahedral'
614  dmd_data(:, 1) = (/ 7, 6, 2,12 /)
615  dmd_data(:, 2) = (/ 12, 1, 3,11 /)
616  dmd_data(:, 3) = (/ 11, 2, 4,10 /)
617  dmd_data(:, 4) = (/ 10, 3, 5, 9 /)
618  dmd_data(:, 5) = (/ 9, 4, 6, 8 /)
619  dmd_data(:, 6) = (/ 8, 5, 1, 7 /)
620  dmd_data(:, 7) = (/ 8, 6, 1,12 /)
621  dmd_data(:, 8) = (/ 9, 5, 6, 7 /)
622  dmd_data(:, 9) = (/ 10, 4, 5, 8 /)
623  dmd_data(:,10) = (/ 11, 3, 4, 9 /)
624  dmd_data(:,11) = (/ 12, 2, 3,10 /)
625  dmd_data(:,12) = (/ 7, 1, 2,11 /)
626  endif
627 
628  rall_1d = 2**rlevel
629  rall_1dmd = rall_1d*rall_1d
630 
631  !--- make region link table
632  do d = 1, ndmd
633  do i = 1, rall_1d
634  do j = 1, rall_1d
635  rgnid = (d-1)*rall_1dmd + (j-1)*rall_1d + i
636 
637  !--- I_SW
638  if ( j == 1 ) then
639  if ( d <= ndmd / 2 ) then
640  i_nb = i
641  j_nb = rall_1d
642  d_nb = dmd_data(i_sw,d)
643  direction = i_ne
644  else
645  i_nb = rall_1d
646  j_nb = rall_1d+1-i
647  d_nb = dmd_data(i_sw,d)
648  direction = i_se
649  endif
650  else
651  i_nb = i
652  j_nb = j-1
653  d_nb = d
654  direction = i_ne
655  endif
656  rgnid_nb = (d_nb-1)*rall_1dmd + (j_nb-1)*rall_1d + i_nb
657 
658  edge_tab(i_rgnid,i_sw,rgnid) = rgnid_nb
659  edge_tab(i_dir, i_sw,rgnid) = direction
660 
661  !--- I_NW
662  if ( i == 1 ) then
663  if ( d <= ndmd / 2 ) then
664  i_nb = rall_1d+1-j
665  j_nb = rall_1d
666  d_nb = dmd_data(i_nw,d)
667  direction = i_ne
668  else
669  i_nb = rall_1d
670  j_nb = j
671  d_nb = dmd_data(i_nw,d)
672  direction = i_se
673  endif
674  else
675  i_nb = i-1
676  j_nb = j
677  d_nb = d
678  direction = i_se
679  endif
680  rgnid_nb = (d_nb-1)*rall_1dmd + (j_nb-1)*rall_1d + i_nb
681 
682  edge_tab(i_rgnid,i_nw,rgnid) = rgnid_nb
683  edge_tab(i_dir, i_nw,rgnid) = direction
684 
685  !--- I_NE
686  if ( j == rall_1d ) then
687  if ( d <= ndmd / 2 ) then
688  i_nb = 1
689  j_nb = rall_1d+1-i
690  d_nb = dmd_data(i_ne,d)
691  direction = i_nw
692  else
693  i_nb = i
694  j_nb = 1
695  d_nb = dmd_data(i_ne,d)
696  direction = i_sw
697  endif
698  else
699  i_nb = i
700  j_nb = j+1
701  d_nb = d
702  direction = i_sw
703  endif
704  rgnid_nb = (d_nb-1)*rall_1dmd + (j_nb-1)*rall_1d + i_nb
705 
706  edge_tab(i_rgnid,i_ne,rgnid) = rgnid_nb
707  edge_tab(i_dir, i_ne,rgnid) = direction
708 
709  !--- I_SE
710  if ( i == rall_1d ) then
711  if ( d <= ndmd / 2 ) then
712  i_nb = 1
713  j_nb = j
714  d_nb = dmd_data(i_se,d)
715  direction = i_nw
716  else
717  i_nb = rall_1d+1-j
718  j_nb = 1
719  d_nb = dmd_data(i_se,d)
720  direction = i_sw
721  endif
722  else
723  i_nb = i+1
724  j_nb = j
725  d_nb = d
726  direction = i_nw
727  endif
728  rgnid_nb = (d_nb-1)*rall_1dmd + (j_nb-1)*rall_1d + i_nb
729 
730  edge_tab(i_rgnid,i_se,rgnid) = rgnid_nb
731  edge_tab(i_dir, i_se,rgnid) = direction
732  enddo
733  enddo
734  enddo
735 
736  !--- make region-pe relationship
737  lp2r(:,:) = -1
738 
739  rgnid = 0
740  do p = 0, pall-1
741  do l = 1, lall
742  rgnid = rgnid + 1
743 
744  lp2r(l,p) = rgnid
745  enddo
746  enddo
747 
748  return
749  end Subroutine prc_icoa_rgn_generate
750 
751  !-----------------------------------------------------------------------------
753  subroutine prc_icoa_rgn_vertex_walkaround( &
754  rall, &
755  rall_pl, &
756  vlink, &
757  edge_tab, &
758  vert_num, &
759  vert_pl, &
760  vert_tab, &
761  vert_tab_pl )
762  implicit none
763 
764  integer, intent(in) :: rall
765  integer, intent(in) :: rall_pl
766  integer, intent(in) :: vlink
767  integer, intent(in) :: edge_tab(2,4,rall)
768 
769  integer, intent(out) :: vert_num (4,rall)
770  logical, intent(out) :: vert_pl (rall_pl,rall)
771  integer, intent(out) :: vert_tab (2,4,rall ,vlink)
772  integer, intent(out) :: vert_tab_pl(2 ,rall_pl,vlink)
773 
774  integer :: rgnid, dir
775  integer :: rgnid_next, dir_next
776  logical :: isaroundpole
777 
778  integer :: r, d, v
779  !---------------------------------------------------------------------------
780 
781  vert_num(:,:) = -1
782  vert_tab(:,:,:,:) = -1
783 
784  do r = 1, rall
785  do d = i_w, i_s
786 
787  rgnid = r
788  select case(d)
789  case(i_w)
790  dir = i_sw
791  case(i_n)
792  dir = i_nw
793  case(i_e)
794  dir = i_ne
795  case(i_s)
796  dir = i_se
797  end select
798 
799  v = 0
800  do
801  rgnid_next = edge_tab(i_rgnid,dir,rgnid)
802  dir_next = edge_tab(i_dir, dir,rgnid) - 1
803 
804  if( dir_next == 0 ) dir_next = 4
805  v = v + 1
806  vert_tab(i_rgnid,d,r,v) = rgnid
807  vert_tab(i_dir, d,r,v) = dir
808 
809  rgnid = rgnid_next
810  dir = dir_next
811 
812  if( rgnid == r ) exit
813  enddo
814  vert_num(d,r) = v
815 
816  enddo
817  enddo
818 
819  vert_pl(:,:) = .false.
820 
821  do r = 1, rall
822  if ( vert_num(i_n,r) == vlink ) then
823  isaroundpole = .true.
824  do v = 1, vlink
825  if( vert_tab(i_dir,i_n,r,v) /= i_n ) isaroundpole = .false.
826  enddo
827 
828  if ( isaroundpole ) then
829  vert_pl(i_npl,r) = .true.
830  endif
831  endif
832 
833  if ( vert_num(i_s,r) == vlink ) then
834  isaroundpole = .true.
835  do v = 1, vlink
836  if( vert_tab(i_dir,i_s,r,v) /= i_s ) isaroundpole = .false.
837  enddo
838 
839  if ( isaroundpole ) then
840  vert_pl(i_spl,r) = .true.
841  endif
842  endif
843  enddo
844 
845  vert_tab_pl(:,:,:) = -1
846 
847  do r = 1, rall
848  if ( vert_pl(i_npl,r) ) then
849  do v = 1, vlink
850  vert_tab_pl(i_rgnid,i_npl,v) = vert_tab(i_rgnid,i_n,r,v)
851  vert_tab_pl(i_dir, i_npl,v) = vert_tab(i_dir, i_n,r,v)
852  enddo
853  exit
854  endif
855  enddo
856 
857  do r = 1, rall
858  if ( vert_pl(i_spl,r) ) then
859  do v = 1, vlink
860  vert_tab_pl(i_rgnid,i_spl,v) = vert_tab(i_rgnid,i_s,r,v)
861  vert_tab_pl(i_dir, i_spl,v) = vert_tab(i_dir, i_s,r,v)
862  enddo
863  exit
864  endif
865  enddo
866 
867  return
868  end subroutine prc_icoa_rgn_vertex_walkaround
869 
870  !-----------------------------------------------------------------------------
871  subroutine output_info
872  use scale_prc, only: &
873  prc_myrank
874  implicit none
875 
876  integer :: rgnid, rgnid_next
877  character(len=2) :: dstr, dstr_next
878 
879  integer :: l, d, v
880  !---------------------------------------------------------------------------
881 
882  log_newline
883  log_info("PRC_ICOA_RGN_setup",'(1x,A)') 'Region management information'
884  if ( prc_rgn_ndiamond == 10 ) then
885  log_info_cont('(1x,A,A)' ) 'Grid sysytem : Icosahedral'
886  elseif( prc_rgn_ndiamond == 12 ) then
887  log_info_cont('(1x,A,A)' ) 'Grid sysytem : Icosatetrahedral'
888  endif
889  log_info_cont('(1x,A,I7)') 'number of diamond : ', prc_rgn_ndiamond
890  log_info_cont('(1x,A,I7)') 'maximum number of vertex linkage : ', prc_rgn_vlink
891  log_newline
892  log_info_cont('(1x,A,I7)') 'Region division level (RL) : ', prc_rgn_level
893  log_info_cont('(1x,A,I7,3(A,I4),A)') 'Total number of regular region : ', prc_rgn_total, &
894  ' (', 2**prc_rgn_level, ' x', 2**prc_rgn_level, ' x', prc_rgn_ndiamond, ' )'
895  log_info_cont('(1x,A,I7)') '# of region per process : ', prc_rgn_local
896  log_info_cont('(1x,A)' ) 'ID of region in my process : '
897  log_info_cont(*) prc_rgn_lp2r(:,prc_myrank)
898  log_info_cont('(1x,A,I7)') 'Region ID, containing north pole : ', prc_rgn_rgn4pl(i_npl)
899  log_info_cont('(1x,A,I7)') 'Region ID, containing south pole : ', prc_rgn_rgn4pl(i_spl)
900  log_info_cont('(1x,A,I7)') 'Process rank, managing north pole : ', prc_rgn_r2p_pl(i_npl)
901  log_info_cont('(1x,A,I7)') 'Process rank, managing south pole : ', prc_rgn_r2p_pl(i_spl)
902 
903  if ( debug ) then
904  log_newline
905  log_info("PRC_ICOA_RGN_setup",'(1x,A)') 'Detailed region management information'
906 
907  log_info_cont(*)'--- (l,myrank) => (rgn)'
908  do l = 1, prc_rgn_local
909  rgnid = prc_rgn_l2r(l)
910  log_info_cont('(1x,A,I4,A,I6,A,I6,A)') '--- (',l,',',prc_myrank,') => (',rgnid,') '
911  enddo
912 
913  log_newline
914  log_info_cont(*)'--- Link information'
915  do l = 1, prc_rgn_local
916  rgnid = prc_rgn_l2r(l)
917 
918  log_newline
919  log_info_cont(*)'--- edge link: (rgn,direction)'
920  do d = i_sw, i_se
921  rgnid_next = prc_rgn_edge_tab(i_rgnid,d,rgnid)
922  dstr = prc_rgn_edgename(d)
923  dstr_next = prc_rgn_edgename(prc_rgn_edge_tab(i_dir,d,rgnid))
924  log_info_cont('(5x,A,I6,A,A,A,I6,A,A,A)') '(',rgnid,',',dstr,') -> (', rgnid_next,',', dstr_next,')'
925  enddo
926 
927  log_info_cont(*)'--- vertex link: (rgn)'
928  do d = i_w, i_s
929  dstr = prc_rgn_vertname(d)
930  log_info_contna('(5x,A,I6,A,A,A)') '(',rgnid,',',dstr,')'
931  do v = 2, prc_rgn_vert_num(d,rgnid)
932  dstr = prc_rgn_vertname(prc_rgn_vert_tab(i_dir,d,rgnid,v))
933  log_info_contna('(A,I6,A,A,A)') ' -> (',prc_rgn_vert_tab(i_rgnid,d,rgnid,v),',',dstr,')'
934  enddo
935  log_newline
936  enddo
937  enddo
938 
939  log_newline
940  log_info_cont(*)'--- Pole information (in the global scope)'
941 
942  log_newline
943  log_info_cont(*)'--- Region ID, containing north pole data : ', prc_rgn_rgn4pl(i_npl)
944  log_info_cont(*)'--- vertex link: (north pole)'
945  do v = 2, prc_rgn_vlink
946  rgnid = prc_rgn_vert_tab_pl(i_rgnid,i_npl,v)
947  dstr = prc_rgn_vertname(prc_rgn_vert_tab_pl(i_dir,i_npl,v))
948  log_info_contna('(A,I6,A,A,A)') ' -> (',rgnid,',',dstr,')'
949  enddo
950  rgnid = prc_rgn_vert_tab_pl(i_rgnid,i_npl,1)
951  dstr = prc_rgn_vertname(prc_rgn_vert_tab_pl(i_dir,i_npl,1))
952  log_info_contna('(A,I6,A,A,A)') ' -> (',rgnid,',',dstr,')'
953  log_newline
954  log_info_cont(*)'--- process, managing north pole : ', prc_rgn_r2p_pl(i_npl)
955 
956  log_newline
957  log_info_cont(*)'--- Region ID, containing south pole data : ', prc_rgn_rgn4pl(i_spl)
958  log_info_cont(*)'--- vertex link: (south pole)'
959  do v = 2, prc_rgn_vlink
960  rgnid = prc_rgn_vert_tab_pl(i_rgnid,i_spl,v)
961  dstr = prc_rgn_vertname(prc_rgn_vert_tab_pl(i_dir,i_spl,v))
962  log_info_contna('(A,I6,A,A,A)') ' -> (',rgnid,',',dstr,')'
963  enddo
964  rgnid = prc_rgn_vert_tab_pl(i_rgnid,i_spl,1)
965  dstr = prc_rgn_vertname(prc_rgn_vert_tab_pl(i_dir,i_spl,1))
966  log_info_contna('(A,I6,A,A,A)') ' -> (',rgnid,',',dstr,')'
967  log_newline
968  log_info_cont(*)'--- process, managing south pole : ', prc_rgn_r2p_pl(i_spl)
969  endif
970 
971  return
972  end subroutine output_info
973 
974 end module scale_prc_icoa
scale_prc_icoa::i_s
integer, parameter, public i_s
south
Definition: scale_prc_icoA.F90:59
scale_prc::prc_universal_ismaster
logical, public prc_universal_ismaster
master process in universal communicator?
Definition: scale_prc.F90:74
scale_prc_icoa::prc_rgn_vert_num
integer, dimension(:,:), allocatable, public prc_rgn_vert_num
number of region around the vertex (4 vertexes)
Definition: scale_prc_icoA.F90:79
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:342
scale_prc_icoa::prc_rgn_total_pl
integer, parameter, public prc_rgn_total_pl
number of pole region
Definition: scale_prc_icoA.F90:73
scale_prc_icoa::i_l
integer, parameter, public i_l
local region
Definition: scale_prc_icoA.F90:43
scale_prc_icoa::prc_rgn_edge_tab
integer, dimension(:,:,:), allocatable, public prc_rgn_edge_tab
region link information (for 4 edges)
Definition: scale_prc_icoA.F90:77
scale_prc_icoa::prc_rgn_vlink
integer, public prc_rgn_vlink
maximum number of vertex linkage, ICO:5
Definition: scale_prc_icoA.F90:68
scale_prc_icoa::i_ne
integer, parameter, public i_ne
north east
Definition: scale_prc_icoA.F90:52
scale_prc_icoa::prc_rgn_r2p_pl
integer, dimension(prc_rgn_total_pl), public prc_rgn_r2p_pl
process ID which have the pole regions
Definition: scale_prc_icoA.F90:88
scale_precision
module PRECISION
Definition: scale_precision.F90:14
scale_prc_icoa::prc_rgn_l2r
integer, dimension(:), allocatable, public prc_rgn_l2r
l,prc_me => rgn
Definition: scale_prc_icoA.F90:86
scale_prc_icoa::i_e
integer, parameter, public i_e
east
Definition: scale_prc_icoA.F90:58
scale_prc::prc_local_comm_world
integer, public prc_local_comm_world
local communicator
Definition: scale_prc.F90:88
scale_prc_icoa::i_se
integer, parameter, public i_se
south east
Definition: scale_prc_icoA.F90:53
scale_prc_icoa::prc_rgn_ndiamond
integer, public prc_rgn_ndiamond
number of diamonds
Definition: scale_prc_icoA.F90:67
scale_prc_icoa::i_rgnid
integer, parameter, public i_rgnid
region id
Definition: scale_prc_icoA.F90:46
scale_prc_icoa::i_sw
integer, parameter, public i_sw
south west
Definition: scale_prc_icoA.F90:50
scale_prc::prc_myrank
integer, public prc_myrank
process num in local communicator
Definition: scale_prc.F90:90
scale_prc_icoa::prc_rgn_vert_pl
logical, dimension(:,:), allocatable, public prc_rgn_vert_pl
the northern/southern vertex is around the pole point?
Definition: scale_prc_icoA.F90:80
scale_prc_icoa::i_npl
integer, parameter, public i_npl
north pole
Definition: scale_prc_icoA.F90:62
scale_io::io_get_available_fid
integer function, public io_get_available_fid()
search & get available file ID
Definition: scale_io.F90:321
scale_prc_icoa
module process / icoA
Definition: scale_prc_icoA.F90:11
scale_prc_icoa::prc_have_pl
logical, public prc_have_pl
this ID manages pole region?
Definition: scale_prc_icoA.F90:39
scale_prc::prc_universal_myrank
integer, public prc_universal_myrank
myrank in universal communicator
Definition: scale_prc.F90:72
scale_prc_icoa::i_nw
integer, parameter, public i_nw
north west
Definition: scale_prc_icoA.F90:51
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_io
module STDIO
Definition: scale_io.F90:10
scale_prc::prc_masterrank
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_prc.F90:66
scale_prc::prc_global_ismaster
logical, public prc_global_ismaster
master process in global communicator?
Definition: scale_prc.F90:82
scale_prc_icoa::i_w
integer, parameter, public i_w
west
Definition: scale_prc_icoA.F90:56
scale_prc_icoa::prc_icoa_setup
subroutine, public prc_icoa_setup
Setup Processor topology.
Definition: scale_prc_icoA.F90:122
scale_prc_icoa::prc_rgn_local
integer, public prc_rgn_local
number of regular region (local)
Definition: scale_prc_icoA.F90:72
scale_prc_icoa::prc_rgn_lp2r
integer, dimension(:,:), allocatable, public prc_rgn_lp2r
l,prc => rgn
Definition: scale_prc_icoA.F90:84
scale_prc::prc_global_myrank
integer, public prc_global_myrank
myrank in global communicator
Definition: scale_prc.F90:80
scale_prc::prc_universal_comm_world
integer, public prc_universal_comm_world
original communicator
Definition: scale_prc.F90:71
scale_prc_icoa::i_spl
integer, parameter, public i_spl
south pole
Definition: scale_prc_icoA.F90:63
scale_prc_icoa::prc_rgn_rgn4pl
integer, dimension(prc_rgn_total_pl), public prc_rgn_rgn4pl
region, having pole data in the halo
Definition: scale_prc_icoA.F90:89
scale_prc_icoa::prc_rgn_level
integer, public prc_rgn_level
region division level
Definition: scale_prc_icoA.F90:66
scale_prc_icoa::i_dir
integer, parameter, public i_dir
direction
Definition: scale_prc_icoA.F90:47
scale_prc_icoa::prc_rgn_vert_tab
integer, dimension(:,:,:,:), allocatable, public prc_rgn_vert_tab
region link information (for 4 vertexes)
Definition: scale_prc_icoA.F90:81
scale_prc::prc_abort_comm_world
integer, public prc_abort_comm_world
communicator for aborting
Definition: scale_prc.F90:96
scale_prc_icoa::prc_rgn_total
integer, public prc_rgn_total
number of regular region (global total)
Definition: scale_prc_icoA.F90:71
scale_prc_icoa::i_n
integer, parameter, public i_n
north
Definition: scale_prc_icoA.F90:57
scale_prc_icoa::i_prc
integer, parameter, public i_prc
process
Definition: scale_prc_icoA.F90:44
scale_prc_icoa::prc_rgn_local_lim
integer, parameter, public prc_rgn_local_lim
maximum number of regular region (local)
Definition: scale_prc_icoA.F90:75
scale_prc::prc_nprocs
integer, public prc_nprocs
myrank in local communicator
Definition: scale_prc.F90:89
scale_prc_icoa::prc_rgn_r2lp
integer, dimension(:,:), allocatable, public prc_rgn_r2lp
rgn => l,prc
Definition: scale_prc_icoA.F90:85
scale_prc_icoa::prc_icoa_rgn_generate
subroutine, public prc_icoa_rgn_generate(rlevel, ndmd, pall, rall, lall, edge_tab, lp2r)
Generate region management info.
Definition: scale_prc_icoA.F90:578
scale_prc_icoa::prc_rank_pl
integer, parameter, public prc_rank_pl
process ID which manages the pole regions
Definition: scale_prc_icoA.F90:38
scale_io::io_l
logical, public io_l
output log or not? (this process)
Definition: scale_io.F90:62
scale_io::io_fid_nml
integer, public io_fid_nml
Log file ID (only for output namelist)
Definition: scale_io.F90:58
scale_io::io_nml
logical, public io_nml
output log or not? (for namelist, this process)
Definition: scale_io.F90:63
scale_prc_icoa::prc_rgn_vert_tab_pl
integer, dimension(:,:,:), allocatable, public prc_rgn_vert_tab_pl
region link information (for 4 vertexes)
Definition: scale_prc_icoA.F90:82
scale_prc::prc_global_comm_world
integer, public prc_global_comm_world
global communicator
Definition: scale_prc.F90:79
scale_prc::prc_universal_nprocs
integer, public prc_universal_nprocs
process num in universal communicator
Definition: scale_prc.F90:73
scale_prc::prc_global_nprocs
integer, public prc_global_nprocs
process num in global communicator
Definition: scale_prc.F90:81
scale_prc_icoa::prc_rgn_have_sgp
logical, dimension(:), allocatable, public prc_rgn_have_sgp
region have singlar point?
Definition: scale_prc_icoA.F90:93
scale_io::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:56
scale_prc::prc_ismaster
logical, public prc_ismaster
master process in local communicator?
Definition: scale_prc.F90:91
Generated by   doxygen 1.8.17