source: palm/trunk/SOURCE/shared_memory_io_mod.f90 @ 4598

Last change on this file since 4598 was 4591, checked in by raasch, 10 months ago

files re-formatted to follow the PALM coding standard

  • Property svn:keywords set to Id
File size: 26.6 KB
Line 
1!> @file shared_memory_io_mod.f90
2!--------------------------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
6! Public License as published by the Free Software Foundation, either version 3 of the License, or
7! (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
10! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
11! Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with PALM. If not, see
14! <http://www.gnu.org/licenses/>.
15!
16! Copyright 1997-2020 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------------------------!
18!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! $Id: shared_memory_io_mod.f90 4591 2020-07-06 15:56:08Z suehring $
26!
27! File re-formatted to follow the PALM coding standard
28!
29!
30!
31! Initial version (Klaus Ketelsen)
32!
33!
34!
35! Description:
36! ------------
37!> Handle MPI-IO or NetCDF-IO shared memory arrays.
38!> This module performs the organization of new communicators, adapted PE-grids and allocation of
39!> shared memory arrays. The IO itself is not done here.
40!--------------------------------------------------------------------------------------------------!
41 MODULE shared_memory_io_mod
42
43#if defined( __parallel )
44#if defined( __mpifh )
45    INCLUDE "mpif.h"
46#else
47    USE MPI
48#endif
49#endif
50
51    USE, INTRINSIC ::  ISO_C_BINDING
52
53    USE control_parameters,                                                                        &
54        ONLY: maximum_grid_level,                                                                  &
55              message_string,                                                                      &
56              mg_switch_to_pe0_level
57
58
59    USE indices,                                                                                   &
60        ONLY: nbgp,                                                                                &
61              nnx,                                                                                 &
62              nny,                                                                                 &
63              nnz,                                                                                 &
64              nx,                                                                                  &
65              nxl,                                                                                 &
66              nxlg,                                                                                &
67              nxr,                                                                                 &
68              nxrg,                                                                                &
69              ny,                                                                                  &
70              nyn,                                                                                 &
71              nyng,                                                                                &
72              nys,                                                                                 &
73              nysg,                                                                                &
74              nzb,                                                                                 &
75              nzt
76
77    USE kinds,                                                                                     &
78        ONLY: iwp,                                                                                 &
79              wp
80
81
82    USE transpose_indices,                                                                         &
83        ONLY: nxl_z,                                                                               &
84              nxr_z,                                                                               &
85              nyn_x,                                                                               &
86              nyn_z,                                                                               &
87              nys_x,                                                                               &
88              nys_z
89
90
91
92    USE pegrid,                                                                                    &
93        ONLY: comm1dx,                                                                             &
94              comm1dy,                                                                             &
95              comm2d,                                                                              &
96              ierr,                                                                                &
97              myid,                                                                                &
98              myidx,                                                                               &
99              myidy,                                                                               &
100              npex,                                                                                &
101              npey,                                                                                &
102              numprocs,                                                                            &
103              pdims,                                                                               &
104              pleft,                                                                               &
105              pnorth,                                                                              &
106              pright,                                                                              &
107              psouth,                                                                              &
108              sendrecvcount_xy
109
110#if defined( __parallel )
111    USE pegrid,                                                                                    &
112        ONLY: pcoord,                                                                              &
113              reorder
114#endif
115
116    IMPLICIT NONE
117
118    PRIVATE
119
120    SAVE
121
122!
123!-- Type to store grid information
124    TYPE, PUBLIC ::  local_boundaries  !<
125
126       INTEGER(iwp) ::  nnx  !<
127       INTEGER(iwp) ::  nny  !<
128       INTEGER(iwp) ::  nx   !<
129       INTEGER(iwp) ::  nxl  !<
130       INTEGER(iwp) ::  nxr  !<
131       INTEGER(iwp) ::  ny   !<
132       INTEGER(iwp) ::  nyn  !<
133       INTEGER(iwp) ::  nys  !<
134
135
136
137
138    END TYPE local_boundaries
139
140!
141!-- Class definition for shared memory instances.
142!-- For every use of shared memory IO, one instance of this class is created.
143    TYPE, PUBLIC ::  sm_class  !<
144
145       INTEGER(iwp) ::  nr_io_pe_per_node = 2         !< typical configuration, 2 sockets per node
146       LOGICAL      ::  no_shared_Memory_in_this_run  !<
147!
148!--    Variables for the shared memory communicator
149       INTEGER(iwp), PUBLIC ::  comm_shared   !< Communicator for processes with shared array
150       INTEGER(iwp), PUBLIC ::  sh_npes       !<
151       INTEGER(iwp), PUBLIC ::  sh_rank       !<
152
153       LOGICAL, PUBLIC ::  iam_io_pe = .TRUE.  !< This PE is an IO-PE
154!
155!--    Variables for the I/O virtual grid
156       INTEGER(iwp), PUBLIC ::  comm_io  !< Communicator for all IO processes
157       INTEGER(iwp), PUBLIC ::  io_npes  !<
158       INTEGER(iwp), PUBLIC ::  io_rank  !<
159
160       TYPE( local_boundaries ), PUBLIC ::  io_grid
161
162!
163!--    Variables for the node local communicator
164       INTEGER(iwp) ::  comm_node          !< Communicator for all processes of current node
165       INTEGER(iwp) ::  io_pe_global_rank  !<
166       INTEGER(iwp) ::  n_npes             !<
167       INTEGER(iwp) ::  n_rank             !<
168
169 CONTAINS
170
171       PRIVATE
172
173          PROCEDURE, PASS(this), PUBLIC ::  is_sm_active              !<
174          PROCEDURE, PASS(this), PUBLIC ::  sm_adjust_outer_boundary  !<
175          PROCEDURE, PASS(this), PUBLIC ::  sm_free_shared            !<
176          PROCEDURE, PASS(this), PUBLIC ::  sm_init_comm              !<
177          PROCEDURE, PASS(this), PUBLIC ::  sm_node_barrier           !<
178#if defined( __parallel )
179          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_1d   !<
180          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_2d   !<
181          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_2di  !<
182          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_3d   !<
183
184          GENERIC, PUBLIC ::  sm_allocate_shared =>  sm_allocate_shared_1d, sm_allocate_shared_2d, &
185                                                  sm_allocate_shared_2di, sm_allocate_shared_3d  !<
186#endif
187    END TYPE sm_class
188
189
190 CONTAINS
191
192
193!--------------------------------------------------------------------------------------------------!
194! Description:
195! ------------
196!> Create the communicator for shared memory groups and IO-PEs.
197!> Setup the grid for shared memory IO.
198!--------------------------------------------------------------------------------------------------!
199 SUBROUTINE sm_init_comm( this, sm_active )
200
201    IMPLICIT NONE
202
203    CLASS(sm_class), INTENT(INOUT) ::  this  !< pointer to access internal variables of this call
204
205#if defined( __parallel )
206    INTEGER ::  color       !<
207    INTEGER ::  max_n_npes  !< Maximum number of PEs/node
208#endif
209
210    LOGICAL, INTENT(IN) ::  sm_active  !< Flag to activate shared-memory IO
211
212
213    this%no_shared_memory_in_this_run = .NOT. sm_active
214
215    IF ( this%no_shared_memory_in_this_run )  THEN
216       this%iam_io_pe = .TRUE.
217       RETURN
218    ENDIF
219
220#if defined( __parallel )
221!
222!-- Determine, how many MPI threads are running on a node
223    this%iam_io_pe = .FALSE.
224    CALL MPI_COMM_SPLIT_TYPE( comm2d, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL, this%comm_node, ierr )
225    CALL MPI_COMM_SIZE( this%comm_node, this%n_npes, ierr )
226    CALL MPI_COMM_RANK( this%comm_node, this%n_rank, ierr )
227
228    CALL MPI_ALLREDUCE( this%n_npes, max_n_npes, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr )
229!
230!-- Decide, if the configuration can run with shared-memory IO
231    IF ( max_n_npes > 64 )  THEN
232!
233!--    Special configuration on the HLRN-IV system with 4 shared memory blocks/node
234       this%nr_io_pe_per_node = 4
235
236    ELSEIF ( max_n_npes <= 32 )  THEN
237!
238!--    No shared memory IO with less than 32 threads/node
239       this%no_shared_memory_in_this_run = .TRUE.
240       this%iam_io_pe = .TRUE.
241       RETURN
242    ENDIF
243
244!
245!-- No shared memory IO with small setups
246    IF ( nx < 24  .OR.  ny < 24 )  THEN
247       this%no_shared_memory_in_this_run = .TRUE.
248       this%iam_io_pe = .TRUE.
249       RETURN
250    ENDIF
251
252!
253!-- Divide a node into shared memory groups, depending on the virtual x-y grid
254    CALL compute_color( color )
255!
256!-- If no shared memory IO possible, nothing is left to be done here.
257    IF ( this%no_shared_memory_in_this_run )  RETURN
258
259!
260!-- Setup the shared memory area
261    CALL MPI_COMM_SPLIT( this%comm_node, color, 0, this%comm_shared, ierr )
262    CALL MPI_COMM_SIZE( this%comm_shared, this%sh_npes, ierr )
263    CALL MPI_COMM_RANK( this%comm_shared, this%sh_rank, ierr )
264
265!
266!-- Setup the communicator across the nodes depending on the shared memory rank.
267!-- All threads with shared memory rank 0 will be I/O threads.
268    color = this%sh_rank
269    CALL MPI_COMM_SPLIT( comm2d, color, 0, this%comm_io, ierr )
270
271    IF ( this%comm_io /= MPI_COMM_NULL )  THEN
272       CALL MPI_COMM_SIZE( this%comm_io, this%io_npes, ierr )
273       CALL MPI_COMM_RANK( this%comm_io, this%io_rank, ierr )
274    ELSE
275       this%io_npes = -1
276       this%io_rank = -1
277    ENDIF
278
279    IF ( this%sh_rank == 0 )  THEN
280       this%iam_io_pe = .TRUE.
281       this%io_pe_global_rank = myid
282    ENDIF
283    CALL MPI_BCAST( this%io_pe_global_rank, 1, MPI_INTEGER, 0, this%comm_shared, ierr )
284
285#else
286    this%iam_io_pe = .TRUE.
287#endif
288
289#if defined( __parallel )
290 CONTAINS
291
292 SUBROUTINE compute_color( color )
293
294    IMPLICIT NONE
295
296    INTEGER(iwp), INTENT(OUT) ::  color  !<
297
298    INTEGER(iwp) ::  group_start    !<
299    INTEGER(iwp) ::  my_color       !<
300    INTEGER(iwp) ::  n              !<
301    INTEGER(iwp) ::  pe             !<
302    INTEGER(iwp) ::  sh_group_size  !<
303
304    INTEGER(iwp), DIMENSION(4,0:this%n_npes-1) ::  local_dim_s   !<
305    INTEGER(iwp), DIMENSION(4,0:this%n_npes-1) ::  local_dim_r   !<
306
307    TYPE(local_boundaries), DIMENSION(32) ::  node_grid  !<
308
309!
310!-- No shared memory I/O on one node jobs
311    IF ( numprocs < this%n_npes )  THEN
312       this%no_shared_memory_in_this_run = .TRUE.
313       RETURN
314    ENDIF
315
316    local_dim_s = 0
317    local_dim_s(1,this%n_rank) = nxl
318    local_dim_s(2,this%n_rank) = nxr
319    local_dim_s(3,this%n_rank) = nys
320    local_dim_s(4,this%n_rank) = nyn
321
322    node_grid%nyn = -1
323!
324!-- Distribute the x-y layout of all cores of a node to all node processes
325    CALL MPI_ALLREDUCE( local_dim_s, local_dim_r, SIZE( local_dim_s ), MPI_INTEGER, MPI_SUM,       &
326                        this%comm_node, ierr )
327    sh_group_size = ( max_n_npes + this%nr_io_pe_per_node - 1 ) / this%nr_io_pe_per_node
328
329    pe       = 0
330    my_color = 1  ! color is used to split the shared memory communicator into a communicator for
331                  ! io groups
332    group_start = pe
333    node_grid(my_color)%nxl = local_dim_r(1,group_start)
334    node_grid(my_color)%nxr = local_dim_r(2,group_start)
335    node_grid(my_color)%nys = local_dim_r(3,group_start)
336
337    DO  n = 1, this%n_npes-1
338
339       pe =  n
340       IF ( n > 0  .AND.  MOD( n,sh_group_size ) == 0 )  THEN
341!
342!--       If group boundary, start new IO group
343          node_grid(my_color)%nyn = local_dim_r(4,pe-1)
344          my_color = my_color + 1
345          group_start = pe
346          node_grid(my_color)%nxl = local_dim_r(1,group_start)
347          node_grid(my_color)%nxr = local_dim_r(2,group_start)
348          node_grid(my_color)%nys = local_dim_r(3,group_start)
349
350       ELSEIF ( local_dim_r(1,pe) /= node_grid(my_color)%nxl )  THEN
351!
352!--       If nxl changes, start new IO group
353          node_grid(my_color)%nyn = local_dim_r(4,pe-1)
354          my_color = my_color+1
355          group_start = pe
356          node_grid(my_color)%nxl = local_dim_r(1,group_start)
357          node_grid(my_color)%nxr = local_dim_r(2,group_start)
358          node_grid(my_color)%nys = local_dim_r(3,group_start)
359       ENDIF
360!
361!--    Save values for local PE
362       IF ( this%n_rank == pe )  THEN                                 !
363          color = my_color
364       ENDIF
365       IF ( n == this%n_npes-1 )  node_grid(my_color)%nyn = local_dim_r(4,pe)
366
367    ENDDO
368
369    IF ( this%n_rank == 0 )  THEN
370       color = 1
371    ENDIF
372
373    this%io_grid = node_grid(color)
374    this%io_grid%nnx = this%io_grid%nxr - this%io_grid%nxl + 1
375    this%io_grid%nny = this%io_grid%nyn - this%io_grid%nys + 1
376
377 END SUBROUTINE compute_color
378#endif
379
380 END SUBROUTINE sm_init_comm
381
382
383
384!--------------------------------------------------------------------------------------------------!
385! Description:
386! ------------
387!> Function to return if shared Memory IO is active.
388!--------------------------------------------------------------------------------------------------!
389 FUNCTION is_sm_active( this ) RESULT( ac )
390
391    IMPLICIT NONE
392
393    CLASS(sm_class), INTENT(inout) ::  this  !<
394
395    LOGICAL ::  ac  !<
396
397    ac = .NOT. this%no_shared_memory_in_this_run
398
399 END FUNCTION is_sm_active
400
401
402#if defined( __parallel )
403!--------------------------------------------------------------------------------------------------!
404! Description:
405! ------------
406!> Allocate shared 1d-REAL array on ALL threads
407!--------------------------------------------------------------------------------------------------!
408 SUBROUTINE sm_allocate_shared_1d( this, p1, d1, d2, win )
409
410    IMPLICIT NONE
411
412    CLASS(sm_class), INTENT(inout) ::  this         !<
413                                                    !<
414    INTEGER(iwp)                   ::  disp_unit    !<
415    INTEGER(iwp), INTENT(IN)       ::  d1           !<
416    INTEGER(iwp), INTENT(IN)       ::  d2           !<
417    INTEGER(iwp), SAVE             ::  pe_from = 0  !<
418    INTEGER(KIND=MPI_ADDRESS_KIND) ::  rem_size     !<
419    INTEGER(iwp), INTENT(OUT)      ::  win          !<
420    INTEGER(KIND=MPI_ADDRESS_KIND) ::  wsize        !<
421
422    INTEGER, DIMENSION(1)           ::  buf_shape   !<
423
424    REAL(wp), DIMENSION(:), POINTER ::  buf         !<
425    REAL(wp), DIMENSION(:), POINTER ::  p1          !<
426
427    TYPE(C_PTR), SAVE               ::  base_ptr    !<
428    TYPE(C_PTR), SAVE               ::  rem_ptr     !<
429
430
431    IF ( this%no_shared_memory_in_this_run )  RETURN
432!
433!-- Allocate shared memory on node rank 0 threads.
434    IF ( this%sh_rank == pe_from )  THEN
435       wsize = d2 - d1 + 1
436    ELSE
437       wsize = 1
438    ENDIF
439    wsize = wsize * 8  ! Please note, size is always in bytes, independently of the displacement
440                       ! unit
441
442    CALL MPI_WIN_ALLOCATE_SHARED( wsize, 8, MPI_INFO_NULL, this%comm_shared,base_ptr, win, ierr )
443!
444!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
445    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
446!
447!-- Convert C- to Fortran-pointer
448    buf_shape(1) = d2 - d1 + 1
449    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
450    p1(d1:) => buf
451!
452!-- Allocate shared memory in round robin on all PEs of a node.
453    pe_from = MOD( pe_from, this%sh_npes )
454
455 END SUBROUTINE sm_allocate_shared_1d
456
457
458!--------------------------------------------------------------------------------------------------!
459! Description:
460! ------------
461!> Allocate shared 2d-REAL array on ALL threads
462!--------------------------------------------------------------------------------------------------!
463 SUBROUTINE sm_allocate_shared_2d( this, p2, n_nxlg, n_nxrg, n_nysg, n_nyng, win )
464
465    IMPLICIT NONE
466
467    CLASS(sm_class), INTENT(INOUT)    ::  this         !<
468
469    INTEGER(iwp)                      ::  disp_unit    !<
470    INTEGER(iwp), INTENT(IN)          ::  n_nxlg       !<
471    INTEGER(iwp), INTENT(IN)          ::  n_nxrg       !<
472    INTEGER(iwp), INTENT(IN)          ::  n_nyng       !<
473    INTEGER(iwp), INTENT(IN)          ::  n_nysg       !<
474    INTEGER(iwp), SAVE                ::  pe_from = 0  !<
475    INTEGER(KIND=MPI_ADDRESS_KIND)    ::  rem_size     !<
476    INTEGER(iwp), INTENT(OUT)         ::  win          !<
477    INTEGER(KIND=MPI_ADDRESS_KIND)    ::  wsize        !<
478
479    INTEGER(iwp), DIMENSION(2)        ::  buf_shape    !<
480
481    REAL(wp), DIMENSION(:,:), POINTER ::  buf          !<
482    REAL(wp), DIMENSION(:,:), POINTER ::  p2           !<
483
484    TYPE(C_PTR),SAVE                  ::  base_ptr     !<
485    TYPE(C_PTR),SAVE                  ::  rem_ptr      !<
486
487
488    IF ( this%no_shared_memory_in_this_run )  RETURN
489!
490!-- Allocate shared memory on node rank 0 threads.
491    IF ( this%sh_rank == pe_from )  THEN
492       wsize = ( n_nyng - n_nysg + 1 ) * ( n_nxrg - n_nxlg + 1 )
493    ELSE
494       wsize = 1
495    ENDIF
496
497    wsize = wsize * 8  ! Please note, size is always in bytes, independently of the displacement
498                       ! unit
499
500    CALL MPI_WIN_ALLOCATE_SHARED( wsize, 8, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
501!
502!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
503    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
504!
505!-- Convert C- to Fortran-pointer
506    buf_shape(2) = n_nyng - n_nysg + 1
507    buf_shape(1) = n_nxrg - n_nxlg + 1
508    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
509    p2(n_nxlg:, n_nysg:) => buf
510!
511!-- Allocate shared memory in round robin on all PEs of a node.
512    pe_from = MOD( pe_from, this%sh_npes )
513
514 END SUBROUTINE sm_allocate_shared_2d
515
516
517!--------------------------------------------------------------------------------------------------!
518! Description:
519! ------------
520!> Allocate shared 2d-INTEGER array on ALL threads
521!--------------------------------------------------------------------------------------------------!
522 SUBROUTINE sm_allocate_shared_2di( this, p2i, n_nxlg, n_nxrg, n_nysg, n_nyng, win )
523
524    IMPLICIT NONE
525
526    CLASS(sm_class), INTENT(inout)        ::  this         !<
527
528    INTEGER(iwp)                          ::  disp_unit    !<
529    INTEGER(iwp), INTENT(IN)              ::  n_nxlg       !<
530    INTEGER(iwp), INTENT(IN)              ::  n_nxrg       !<
531    INTEGER(iwp), INTENT(IN)              ::  n_nyng       !<
532    INTEGER(iwp), INTENT(IN)              ::  n_nysg       !<
533    INTEGER(iwp), SAVE                    ::  pe_from = 0  !<
534    INTEGER(kind=MPI_ADDRESS_KIND)        ::  rem_size     !<
535    INTEGER(iwp), INTENT(OUT)             ::  win          !<
536    INTEGER(kind=MPI_ADDRESS_KIND)        ::  wsize        !<
537
538    INTEGER(iwp), DIMENSION(2)            ::  buf_shape    !<
539
540    INTEGER(iwp), DIMENSION(:,:), POINTER ::  buf          !<
541    INTEGER(iwp), DIMENSION(:,:), POINTER ::  p2i          !<
542
543    TYPE(C_PTR),SAVE                      ::  base_ptr     !<
544    TYPE(C_PTR),SAVE                      ::  rem_ptr      !<
545
546
547    IF ( this%no_shared_memory_in_this_run )  RETURN
548!
549!-- Allocate shared memory on node rank 0 threads.
550    IF ( this%sh_rank == pe_from )  THEN
551       wsize = ( n_nyng - n_nysg + 1 ) * ( n_nxrg - n_nxlg + 1 )
552    ELSE
553       wsize = 1
554    ENDIF
555
556    wsize = wsize * 4  ! Please note, size is always in bytes, independently of the displacement
557                       ! unit
558
559    CALL MPI_WIN_ALLOCATE_SHARED( wsize, 4, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
560!
561!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
562    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
563!
564!-- Convert C- to Fortran-pointer
565    buf_shape(2) = n_nyng - n_nysg + 1
566    buf_shape(1) = n_nxrg - n_nxlg + 1
567    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
568    p2i(n_nxlg:, n_nysg:) => buf
569!
570!-- Allocate shared memory in round robin on all PEs of a node.
571    pe_from = MOD( pe_from, this%sh_npes )
572
573 END SUBROUTINE sm_allocate_shared_2di
574
575
576!--------------------------------------------------------------------------------------------------!
577! Description:
578! ------------
579!> Allocate shared 3d-REAL array on ALL threads
580!--------------------------------------------------------------------------------------------------!
581 SUBROUTINE sm_allocate_shared_3d( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, win )
582
583    IMPLICIT NONE
584
585    CLASS(sm_class), INTENT(inout)      ::  this         !<
586
587    INTEGER                             ::  disp_unit    !<
588    INTEGER, INTENT(IN)                 ::  d1e          !<
589    INTEGER, INTENT(IN)                 ::  d1s          !<
590    INTEGER, INTENT(IN)                 ::  d2e          !<
591    INTEGER, INTENT(IN)                 ::  d2s          !<
592    INTEGER, INTENT(IN)                 ::  d3e          !<
593    INTEGER, INTENT(IN)                 ::  d3s          !<
594    INTEGER, SAVE                       ::  pe_from = 0  !<
595    INTEGER(KIND=MPI_ADDRESS_KIND)      ::  rem_size     !<
596    INTEGER, INTENT(OUT)                ::  win          !<
597    INTEGER(KIND=MPI_ADDRESS_KIND)      ::  wsize        !<
598
599    INTEGER, DIMENSION(3)               ::  buf_shape    !<
600
601    REAL(wp), DIMENSION(:,:,:), POINTER ::  buf          !<
602    REAL(wp), DIMENSION(:,:,:), POINTER ::  p3           !<
603
604    TYPE(C_PTR), SAVE                   ::  base_ptr     !<
605    TYPE(C_PTR), SAVE                   ::  rem_ptr      !<
606
607
608    IF ( this%no_shared_memory_in_this_run )  RETURN
609!
610!-- Allocate shared memory on node rank 0 threads.
611    IF ( this%sh_rank == pe_from )  THEN
612       wsize = ( d3e - d3s + 1 ) * ( d2e - d2s + 1 ) * ( d1e - d1s + 1 )
613    ELSE
614       wsize = 1
615    ENDIF
616
617    wsize = wsize * 8  ! Please note, size is always in bytes, independently of the displacement
618                       ! unit
619
620    CALL MPI_WIN_ALLOCATE_SHARED( wsize, 8, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
621!
622!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
623    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
624!
625!-- Convert C- to Fortran-pointer
626    buf_shape(3) = d3e - d3s + 1
627    buf_shape(2) = d2e - d2s + 1
628    buf_shape(1) = d1e - d1s + 1
629    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
630    p3(d1s:,d2s:,d3s:) => buf
631!
632!-- Allocate shared memory in round robin on all PEs of a node.
633    pe_from = MOD( pe_from, this%sh_npes )
634
635 END SUBROUTINE sm_allocate_shared_3d
636#endif
637
638
639!--------------------------------------------------------------------------------------------------!
640! Description:
641! ------------
642!> ???
643!--------------------------------------------------------------------------------------------------!
644 SUBROUTINE sm_adjust_outer_boundary( this )
645
646    IMPLICIT NONE
647
648    CLASS(sm_class), INTENT(inout) ::  this  !<
649
650
651    IF ( this%no_shared_memory_in_this_run )  RETURN
652
653    IF ( this%io_grid%nxl == 0 )  THEN
654       this%io_grid%nxl = this%io_grid%nxl - nbgp
655       this%io_grid%nnx = this%io_grid%nnx + nbgp
656    ENDIF
657
658    IF ( this%io_grid%nxr == nx  .OR.  npex == -1 )  THEN   ! npex == -1 if -D__parallel not set
659       this%io_grid%nxr = this%io_grid%nxr + nbgp
660       this%io_grid%nnx = this%io_grid%nnx + nbgp
661    ENDIF
662
663    IF ( this%io_grid%nys == 0 )  THEN
664       this%io_grid%nys = this%io_grid%nys - nbgp
665       this%io_grid%nny = this%io_grid%nny + nbgp
666    ENDIF
667
668    IF ( this%io_grid%nyn == ny .OR.  npey == -1 )  THEN   ! npey == -1 if -D__parallel not set
669       this%io_grid%nyn = this%io_grid%nyn + nbgp
670       this%io_grid%nny = this%io_grid%nny + nbgp
671    ENDIF
672
673    this%io_grid%nxl = this%io_grid%nxl + nbgp
674    this%io_grid%nxr = this%io_grid%nxr + nbgp
675    this%io_grid%nys = this%io_grid%nys + nbgp
676    this%io_grid%nyn = this%io_grid%nyn + nbgp
677    this%io_grid%nnx = this%io_grid%nnx
678    this%io_grid%nny = this%io_grid%nny
679
680 END SUBROUTINE sm_adjust_outer_boundary
681
682
683!--------------------------------------------------------------------------------------------------!
684! Description:
685! ------------
686!> Deallocate shared aray and free related window.
687!--------------------------------------------------------------------------------------------------!
688 SUBROUTINE sm_free_shared( this, win )
689
690    IMPLICIT NONE
691
692    CLASS(sm_class), INTENT(inout) ::  this  !<
693
694    INTEGER(iwp), INTENT(INOUT)    ::  win   !<
695
696    IF ( this%no_shared_memory_in_this_run  .OR.  win == -1234567890 )  RETURN
697                     ! win is used just to avoid compile errors because of unused arguments
698#if defined( __parallel )
699    CALL MPI_WIN_FREE( win, ierr )
700#endif
701
702 END SUBROUTINE sm_free_shared
703
704
705!--------------------------------------------------------------------------------------------------!
706! Description:
707! ------------
708!> ...
709!--------------------------------------------------------------------------------------------------!
710 SUBROUTINE sm_node_barrier( this )
711
712    IMPLICIT NONE
713
714    CLASS(sm_class), INTENT(inout) ::  this  !<
715
716
717    IF ( this%no_shared_memory_in_this_run )  RETURN
718
719#if defined( __parallel )
720    CALL MPI_BARRIER( this%comm_shared, ierr )
721#endif
722
723 END SUBROUTINE sm_node_barrier
724
725 END MODULE shared_memory_io_mod
Note: See TracBrowser for help on using the repository browser.