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

Last change on this file since 4775 was 4629, checked in by raasch, 4 years ago

support for MPI Fortran77 interface (mpif.h) removed

  • Property svn:keywords set to Id
File size: 46.4 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! -----------------
26! $Id: shared_memory_io_mod.f90 4629 2020-07-29 09:37:56Z raasch $
27! support for MPI Fortran77 interface (mpif.h) removed
28!
29! 4628 2020-07-29 07:23:03Z raasch
30! extensions required for MPI-I/O of particle data to restart files
31!
32! 4620 2020-07-22 14:11:16Z raasch
33! bugfix: variable definition changed
34!
35! 4618 2020-07-22 11:21:08Z raasch
36! unused variable removed
37!
38!
39! Additions for cyclic fill mode
40!
41!
42! File re-formatted to follow the PALM coding standard
43!
44!
45! Initial version (Klaus Ketelsen)
46!
47!
48!
49! Description:
50! ------------
51!> Handle MPI-IO or NetCDF-IO shared memory arrays.
52!> This module performs the organization of new communicators, adapted PE-grids and allocation of
53!> shared memory arrays. The IO itself is not done here.
54!--------------------------------------------------------------------------------------------------!
55 MODULE shared_memory_io_mod
56
57#if defined( __parallel )
58    USE MPI
59#endif
60
61    USE, INTRINSIC ::  ISO_C_BINDING
62
63    USE control_parameters,                                                                        &
64        ONLY: maximum_grid_level,                                                                  &
65              message_string,                                                                      &
66              mg_switch_to_pe0_level
67
68
69    USE indices,                                                                                   &
70        ONLY: nbgp,                                                                                &
71              nnx,                                                                                 &
72              nny,                                                                                 &
73              nnz,                                                                                 &
74              nx,                                                                                  &
75              nxl,                                                                                 &
76              nxlg,                                                                                &
77              nxr,                                                                                 &
78              nxrg,                                                                                &
79              ny,                                                                                  &
80              nyn,                                                                                 &
81              nyng,                                                                                &
82              nys,                                                                                 &
83              nysg,                                                                                &
84              nzb,                                                                                 &
85              nzt
86
87    USE kinds,                                                                                     &
88        ONLY: dp,                                                                                  &
89              idp,                                                                                 &
90              isp,                                                                                 &
91              iwp,                                                                                 &
92              sp,                                                                                  &
93              wp
94
95    USE pegrid,                                                                                    &
96        ONLY: comm1dx,                                                                             &
97              comm1dy,                                                                             &
98              comm2d,                                                                              &
99              ierr,                                                                                &
100              myid,                                                                                &
101              myidx,                                                                               &
102              myidy,                                                                               &
103              npex,                                                                                &
104              npey,                                                                                &
105              numprocs,                                                                            &
106              pdims,                                                                               &
107              pleft,                                                                               &
108              pnorth,                                                                              &
109              pright,                                                                              &
110              psouth,                                                                              &
111              sendrecvcount_xy
112
113#if defined( __parallel )
114    USE pegrid,                                                                                    &
115        ONLY: pcoord,                                                                              &
116              reorder
117#endif
118
119    IMPLICIT NONE
120
121    PRIVATE
122
123    SAVE
124
125!
126!-- Type to store information about the domain decomposition grid
127    TYPE, PUBLIC ::  domain_decomposition_grid_features  !<
128
129       INTEGER(iwp) ::  comm2d    !<
130       INTEGER(iwp) ::  myid      !<
131       INTEGER(iwp) ::  nnx       !<
132       INTEGER(iwp) ::  nny       !<
133       INTEGER(iwp) ::  nx        !<
134       INTEGER(iwp) ::  nxl       !<
135       INTEGER(iwp) ::  nxr       !<
136       INTEGER(iwp) ::  ny        !<
137       INTEGER(iwp) ::  nyn       !<
138       INTEGER(iwp) ::  nys       !<
139       INTEGER(iwp) ::  numprocs  !<
140
141       CONTAINS
142
143          PROCEDURE, PASS(this), PUBLIC :: activate_grid_from_this_class
144          PROCEDURE, PASS(this), PUBLIC :: save_grid_into_this_class
145
146    END TYPE domain_decomposition_grid_features
147
148!
149!-- Class definition for shared memory instances.
150!-- For every use of shared memory IO, one instance of this class is created.
151    TYPE, PUBLIC ::  sm_class  !<
152
153       INTEGER(iwp) ::  nr_io_pe_per_node = 2         !< typical configuration, 2 sockets per node
154       LOGICAL      ::  no_shared_Memory_in_this_run  !<
155
156       INTEGER(iwp) ::  comm_model            !< communicator of this model run
157!
158!--    Variables for the shared memory communicator
159       INTEGER(iwp), PUBLIC ::  comm_shared   !< communicator for processes with shared array
160       INTEGER(iwp), PUBLIC ::  sh_npes       !<
161       INTEGER(iwp), PUBLIC ::  sh_rank       !<
162
163       LOGICAL, PUBLIC ::  iam_io_pe = .TRUE.  !< This PE is an IO-PE
164!
165!--    Variables for the I/O virtual grid
166       INTEGER(iwp), PUBLIC ::  comm_io  !< Communicator for all IO processes
167       INTEGER(iwp), PUBLIC ::  io_npes  !<
168       INTEGER(iwp), PUBLIC ::  io_rank  !<
169!
170!--    Variables for the node local communicator
171       INTEGER(iwp) ::  comm_node          !< Communicator for all processes of current node
172       INTEGER(iwp) ::  io_pe_global_rank  !<
173       INTEGER(iwp) ::  n_npes             !<
174       INTEGER(iwp) ::  n_rank             !<
175
176       TYPE(domain_decomposition_grid_features), PUBLIC ::  io_grid  !< io grid features, depending on reading from prerun or restart run
177
178
179       CONTAINS
180
181          PRIVATE
182
183          PROCEDURE, PASS(this), PUBLIC ::  is_sm_active
184          PROCEDURE, PASS(this), PUBLIC ::  sm_adjust_outer_boundary
185          PROCEDURE, PASS(this), PUBLIC ::  sm_free_shared
186          PROCEDURE, PASS(this), PUBLIC ::  sm_init_comm
187          PROCEDURE, PASS(this), PUBLIC ::  sm_init_part
188          PROCEDURE, PASS(this), PUBLIC ::  sm_node_barrier
189#if defined( __parallel )
190          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_1d_64
191          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_1d_32
192          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_1di
193          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_2d_64
194          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_2d_32
195          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_2di
196          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_3d_64
197          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_3d_32
198          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_3di_32
199          PROCEDURE, PASS(this), PUBLIC ::  sm_allocate_shared_3di_64
200
201          GENERIC, PUBLIC ::  sm_allocate_shared =>                                                &
202                                              sm_allocate_shared_1d_64,  sm_allocate_shared_1d_32, &
203                                              sm_allocate_shared_2d_64,  sm_allocate_shared_2d_32, &
204                                              sm_allocate_shared_2di,    sm_allocate_shared_3d_64, &
205                                              sm_allocate_shared_3d_32,  sm_allocate_shared_1di,   &
206                                              sm_allocate_shared_3di_32, sm_allocate_shared_3di_64
207#endif
208    END TYPE sm_class
209
210
211 CONTAINS
212
213
214!--------------------------------------------------------------------------------------------------!
215! Description:
216! ------------
217!> Create the communicator for shared memory groups and IO-PEs.
218!> Setup the grid for shared memory IO.
219!--------------------------------------------------------------------------------------------------!
220 SUBROUTINE sm_init_comm( this, sm_active, comm_input )
221
222    IMPLICIT NONE
223
224    CLASS(sm_class), INTENT(INOUT) ::  this        !< pointer to access internal variables of this call
225    INTEGER, INTENT(IN), OPTIONAL  ::  comm_input  !< main model communicator (comm2d) can optional be set
226
227#if defined( __parallel )
228    INTEGER ::  color
229    INTEGER ::  max_n_npes  !< maximum number of PEs/node
230#endif
231
232    LOGICAL, INTENT(IN) ::  sm_active  !< flag to activate shared-memory IO
233
234    IF ( PRESENT( comm_input ) )  THEN
235       this%comm_model = comm_input
236    ELSE
237       this%comm_model = comm2d
238    ENDIF
239
240    this%no_shared_memory_in_this_run = .NOT. sm_active
241    this%comm_io = this%comm_model      ! preset in case of non shared-memory-IO
242
243    IF ( this%no_shared_memory_in_this_run )  THEN
244       this%iam_io_pe = .TRUE.
245       RETURN
246    ENDIF
247
248#if defined( __parallel )
249!
250!-- Determine, how many MPI threads are running on a node
251    this%iam_io_pe = .FALSE.
252    CALL MPI_COMM_SPLIT_TYPE( this%comm_model, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL,             &
253                              this%comm_node, ierr )
254    CALL MPI_COMM_SIZE( this%comm_node, this%n_npes, ierr )
255    CALL MPI_COMM_RANK( this%comm_node, this%n_rank, ierr )
256
257    CALL MPI_ALLREDUCE( this%n_npes, max_n_npes, 1, MPI_INTEGER, MPI_MAX, this%comm_model, ierr )
258!
259!-- Decide, if the configuration can run with shared-memory IO
260    IF ( max_n_npes > 64 )  THEN
261!
262!--    Special configuration on the HLRN-IV system with 4 shared memory blocks/node
263       this%nr_io_pe_per_node = 4
264
265    ELSEIF ( max_n_npes <= 32 )  THEN
266!
267!--    No shared memory IO with less than 32 threads/node
268       this%no_shared_memory_in_this_run = .TRUE.
269       this%iam_io_pe = .TRUE.
270       RETURN
271    ENDIF
272
273!
274!-- No shared memory IO with small setups
275    IF ( nx < 24  .OR.  ny < 24 )  THEN
276       this%no_shared_memory_in_this_run = .TRUE.
277       this%iam_io_pe = .TRUE.
278       RETURN
279    ENDIF
280
281!
282!-- Divide a node into shared memory groups, depending on the virtual x-y grid
283    CALL compute_color( color )
284!
285!-- If no shared memory IO possible, nothing is left to be done here.
286    IF ( this%no_shared_memory_in_this_run )  RETURN
287
288!
289!-- Setup the shared memory area
290    CALL MPI_COMM_SPLIT( this%comm_node, color, 0, this%comm_shared, ierr )
291    CALL MPI_COMM_SIZE( this%comm_shared, this%sh_npes, ierr )
292    CALL MPI_COMM_RANK( this%comm_shared, this%sh_rank, ierr )
293
294!
295!-- Setup the communicator across the nodes depending on the shared memory rank.
296!-- All threads with shared memory rank 0 will be I/O threads.
297    color = this%sh_rank
298    CALL MPI_COMM_SPLIT( this%comm_model, color, 0, this%comm_io, ierr )
299
300    IF ( this%comm_io /= MPI_COMM_NULL )  THEN
301       CALL MPI_COMM_SIZE( this%comm_io, this%io_npes, ierr )
302       CALL MPI_COMM_RANK( this%comm_io, this%io_rank, ierr )
303    ELSE
304       this%io_npes = -1
305       this%io_rank = -1
306    ENDIF
307
308    IF ( this%sh_rank == 0 )  THEN
309       this%iam_io_pe = .TRUE.
310       this%io_pe_global_rank = myid
311    ENDIF
312    CALL MPI_BCAST( this%io_pe_global_rank, 1, MPI_INTEGER, 0, this%comm_shared, ierr )
313
314#else
315    this%iam_io_pe = .TRUE.
316#endif
317
318!      write(9,'(a,8i7)') ' end of sm_init_comm ',this%sh_rank,this%sh_npes,this%io_rank,this%io_npes,this%io_pe_global_rank
319!      write(9,*) 'This process is IO Process ',this%iam_io_pe
320
321#if defined( __parallel )
322 CONTAINS
323
324 SUBROUTINE compute_color( color )
325
326    IMPLICIT NONE
327
328    INTEGER(iwp), INTENT(OUT) ::  color  !<
329
330    INTEGER(iwp) ::  group_start    !<
331    INTEGER(iwp) ::  my_color       !<
332    INTEGER(iwp) ::  n              !<
333    INTEGER(iwp) ::  pe             !<
334    INTEGER(iwp) ::  sh_group_size  !<
335
336    INTEGER(iwp), DIMENSION(4,0:this%n_npes-1) ::  local_dim_s   !<
337    INTEGER(iwp), DIMENSION(4,0:this%n_npes-1) ::  local_dim_r   !<
338
339    TYPE(domain_decomposition_grid_features), DIMENSION(32) ::  node_grid  !<
340
341!
342!-- No shared memory I/O on one node jobs
343    IF ( numprocs < this%n_npes )  THEN
344       this%no_shared_memory_in_this_run = .TRUE.
345       RETURN
346    ENDIF
347
348    local_dim_s = 0
349    local_dim_s(1,this%n_rank) = nxl
350    local_dim_s(2,this%n_rank) = nxr
351    local_dim_s(3,this%n_rank) = nys
352    local_dim_s(4,this%n_rank) = nyn
353
354    node_grid%nyn = -1
355!
356!-- Distribute the x-y layout of all cores of a node to all node processes
357    CALL MPI_ALLREDUCE( local_dim_s, local_dim_r, SIZE( local_dim_s ), MPI_INTEGER, MPI_SUM,       &
358                        this%comm_node, ierr )
359    sh_group_size = ( max_n_npes + this%nr_io_pe_per_node - 1 ) / this%nr_io_pe_per_node
360
361    pe       = 0
362    my_color = 1  ! color is used to split the shared memory communicator into a communicator for
363                  ! io groups
364    group_start = pe
365    node_grid(my_color)%nxl = local_dim_r(1,group_start)
366    node_grid(my_color)%nxr = local_dim_r(2,group_start)
367    node_grid(my_color)%nys = local_dim_r(3,group_start)
368
369    DO  n = 1, this%n_npes-1
370
371       pe =  n
372       IF ( n > 0  .AND.  MOD( n,sh_group_size ) == 0 )  THEN
373!
374!--       If group boundary, start new IO group
375          node_grid(my_color)%nyn = local_dim_r(4,pe-1)
376          my_color = my_color + 1
377          group_start = pe
378          node_grid(my_color)%nxl = local_dim_r(1,group_start)
379          node_grid(my_color)%nxr = local_dim_r(2,group_start)
380          node_grid(my_color)%nys = local_dim_r(3,group_start)
381
382       ELSEIF ( local_dim_r(1,pe) /= node_grid(my_color)%nxl )  THEN
383!
384!--       If nxl changes, start new IO group
385          node_grid(my_color)%nyn = local_dim_r(4,pe-1)
386          my_color = my_color+1
387          group_start = pe
388          node_grid(my_color)%nxl = local_dim_r(1,group_start)
389          node_grid(my_color)%nxr = local_dim_r(2,group_start)
390          node_grid(my_color)%nys = local_dim_r(3,group_start)
391       ENDIF
392!
393!--    Save values for local PE
394       IF ( this%n_rank == pe )  THEN                                 !
395          color = my_color
396       ENDIF
397       IF ( n == this%n_npes-1 )  node_grid(my_color)%nyn = local_dim_r(4,pe)
398
399    ENDDO
400
401    IF ( this%n_rank == 0 )  THEN
402       color = 1
403    ENDIF
404
405    this%io_grid = node_grid(color)
406    this%io_grid%nnx = this%io_grid%nxr - this%io_grid%nxl + 1
407    this%io_grid%nny = this%io_grid%nyn - this%io_grid%nys + 1
408
409 END SUBROUTINE compute_color
410#endif
411
412 END SUBROUTINE sm_init_comm
413
414
415!
416!-- TODO: short description required, about the meaning of the following routine
417!--       part must be renamed particles!
418 SUBROUTINE sm_init_part( this )
419
420    IMPLICIT NONE
421
422    CLASS(sm_class), INTENT(INOUT) ::  this  !< pointer to access internal variables of this call
423
424#if defined( __parallel )
425    INTEGER(iwp) ::  color             !<
426    INTEGER(iwp) ::  ierr              !<
427    INTEGER(iwp) ::  max_n_npes        !< maximum number of PEs/node
428#endif
429
430    LOGICAL :: sm_active  !<
431
432
433    sm_active       = .TRUE.   ! particle IO always uses shared memory
434    this%comm_model = comm2d
435
436    this%no_shared_memory_in_this_run = .NOT. sm_active
437    this%comm_io = this%comm_model  ! preset in case of non shared-memory-IO
438
439    IF ( this%no_shared_memory_in_this_run )  THEN
440       this%iam_io_pe = .TRUE.
441       RETURN
442    ENDIF
443
444#if defined( __parallel )
445!
446!-- Determine, how many MPI threads are running on a node
447    this%iam_io_pe = .FALSE.
448    CALL MPI_COMM_SPLIT_TYPE( this%comm_model, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL,             &
449                              this%comm_node, ierr )
450    CALL MPI_COMM_SIZE( this%comm_node, this%n_npes, ierr )
451    CALL MPI_COMM_RANK( this%comm_node, this%n_rank, ierr )
452
453    CALL MPI_ALLREDUCE( this%n_npes, max_n_npes, 1, MPI_INTEGER, MPI_MAX, this%comm_model, ierr )
454
455!
456!-- TODO: better explanation
457!-- It has to be testet, if using memory blocks for an IO process (MPI shared Memory), or if it is
458!-- even better to use the complete node for MPI shared memory (this%nr_io_pe_per_node = 1).
459!-  In the latter case, the access to the MPI shared memory buffer is slower, the number of
460!-- particles to move between threads will be much smaller.
461    IF ( max_n_npes > 64 )  THEN
462!
463!--    Special configuration on the HLRN-IV system with 4 shared memory blocks/node
464       this%nr_io_pe_per_node = 4
465    ENDIF
466
467    IF ( this%nr_io_pe_per_node == 1 )  THEN
468!
469!--    This branch is not realized so far
470       this%iam_io_pe   = ( this%n_rank == 0 )
471       this%comm_shared = this%comm_node
472       CALL MPI_COMM_SIZE( this%comm_shared, this%sh_npes, ierr )
473       CALL MPI_COMM_RANK( this%comm_shared, this%sh_rank, ierr )
474
475    ELSEIF( this%nr_io_pe_per_node == 2 )  THEN
476
477       this%iam_io_pe = ( this%n_rank == 0  .OR.  this%n_rank == this%n_npes/2 )
478       IF ( this%n_rank < this%n_npes/2 )  THEN
479          color = 1
480       ELSE
481          color = 2
482       ENDIF
483       CALL MPI_COMM_SPLIT( this%comm_node, color, 0, this%comm_shared, ierr )
484       CALL MPI_COMM_SIZE( this%comm_shared, this%sh_npes, ierr )
485       CALL MPI_COMM_RANK( this%comm_shared, this%sh_rank, ierr )
486
487    ELSEIF( this%nr_io_pe_per_node == 4 )  THEN
488
489       this%iam_io_pe = ( this%n_rank == 0  .OR.  this%n_rank == this%n_npes/4  .OR.               &
490                          this%n_rank == this%n_npes/2  .OR.  this%n_rank == (3*this%n_npes)/4 )
491       IF ( this%n_rank < this%n_npes/4 )  THEN
492          color = 1
493       ELSEIF( this%n_rank < this%n_npes/2 )  THEN
494          color = 2
495       ELSEIF( this%n_rank < (3*this%n_npes)/4 )  THEN
496          color = 3
497       ELSE
498          color = 4
499       ENDIF
500       CALL MPI_COMM_SPLIT( this%comm_node, color, 0, this%comm_shared, ierr )
501       CALL MPI_COMM_SIZE( this%comm_shared, this%sh_npes, ierr )
502       CALL MPI_COMM_RANK( this%comm_shared, this%sh_rank, ierr )
503
504    ELSE
505
506       WRITE( *, * ) 'shared_memory_io_mod: internal error'
507       WRITE( *, * ) 'only 2 or 4 shared memory groups per node are allowed'
508       STOP
509
510    ENDIF
511
512!
513!-- Setup the shared memory area
514    CALL MPI_COMM_SPLIT( this%comm_node, color, 0, this%comm_shared, ierr )
515    CALL MPI_COMM_SIZE( this%comm_shared, this%sh_npes, ierr )
516    CALL MPI_COMM_RANK( this%comm_shared, this%sh_rank, ierr )
517
518!
519!-- Setup the communicator across the nodes depending on the shared memory rank.
520!-- All threads with shared memory rank 0 will be I/O threads.
521    color = this%sh_rank
522    CALL MPI_COMM_SPLIT( this%comm_model, color, 0, this%comm_io, ierr )
523
524    IF ( this%comm_io /= MPI_COMM_NULL )  THEN
525       CALL MPI_COMM_SIZE( this%comm_io, this%io_npes, ierr )
526       CALL MPI_COMM_RANK( this%comm_io, this%io_rank, ierr )
527    ELSE
528       this%io_npes = -1
529       this%io_rank = -1
530    ENDIF
531
532    IF ( this%sh_rank == 0 )  THEN
533       this%iam_io_pe = .TRUE.
534       this%io_pe_global_rank = myid
535    ENDIF
536    CALL MPI_BCAST( this%io_pe_global_rank, 1, MPI_INTEGER, 0, this%comm_shared, ierr )
537
538#else
539    this%iam_io_pe = .FALSE.
540#endif
541
542!    write(9,'(a,8i7)') 'sm_init_comm_part ',this%sh_rank,this%sh_npes,this%io_rank,this%io_npes
543
544 END SUBROUTINE sm_init_part
545
546!--------------------------------------------------------------------------------------------------!
547! Description:
548! ------------
549!> Function to return if shared Memory IO is active.
550!--------------------------------------------------------------------------------------------------!
551 FUNCTION is_sm_active( this ) RESULT( ac )
552
553    IMPLICIT NONE
554
555    CLASS(sm_class), INTENT(inout) ::  this  !<
556
557    LOGICAL ::  ac  !<
558
559    ac = .NOT. this%no_shared_memory_in_this_run
560
561 END FUNCTION is_sm_active
562
563
564#if defined( __parallel )
565
566!--------------------------------------------------------------------------------------------------!
567! Description:
568! ------------
569!> Allocate shared 1d-REAL (64 Bit) array on ALL threads
570!--------------------------------------------------------------------------------------------------!
571 SUBROUTINE sm_allocate_shared_1d_64( this, p1, d1, d2, win )
572
573    IMPLICIT NONE
574
575    CLASS(sm_class), INTENT(inout)  ::  this
576
577    INTEGER(iwp)                    ::  disp_unit
578    INTEGER(iwp), INTENT(IN)        ::  d1
579    INTEGER(iwp), INTENT(IN)        ::  d2
580    INTEGER(iwp), SAVE              ::  pe_from = 0
581    INTEGER(iwp), INTENT(OUT)       ::  win
582
583    INTEGER(KIND=MPI_ADDRESS_KIND)  ::  rem_size
584    INTEGER(KIND=MPI_ADDRESS_KIND)  ::  wsize
585
586    INTEGER, DIMENSION(1)           ::  buf_shape
587
588    REAL(dp), DIMENSION(:), POINTER ::  buf
589    REAL(dp), DIMENSION(:), POINTER ::  p1
590
591    TYPE(C_PTR), SAVE               ::  base_ptr
592    TYPE(C_PTR), SAVE               ::  rem_ptr
593
594
595    IF ( this%no_shared_memory_in_this_run )  RETURN
596!
597!-- Allocate shared memory on node rank 0 threads.
598    IF ( this%sh_rank == pe_from )  THEN
599       wsize = d2 - d1 + 1
600    ELSE
601       wsize = 1
602    ENDIF
603    wsize = wsize * dp  ! please note, size is always in bytes, independently of the displacement
604                        ! unit
605
606    CALL MPI_WIN_ALLOCATE_SHARED( wsize, dp, MPI_INFO_NULL, this%comm_shared,base_ptr, win, ierr )
607!
608!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
609    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
610!
611!-- Convert C- to Fortran-pointer
612    buf_shape(1) = d2 - d1 + 1
613    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
614    p1(d1:) => buf
615!
616!-- Allocate shared memory in round robin on all PEs of a node.
617    pe_from = MOD( pe_from, this%sh_npes )
618
619 END SUBROUTINE sm_allocate_shared_1d_64
620
621
622!--------------------------------------------------------------------------------------------------!
623! Description:
624! ------------
625!> Allocate shared 1d-REAL (32 Bit) array on ALL threads
626!--------------------------------------------------------------------------------------------------!
627 SUBROUTINE sm_allocate_shared_1d_32( this, p1, d1, d2, win )
628
629    IMPLICIT NONE
630
631    CLASS(sm_class), INTENT(inout)  ::  this
632
633    INTEGER(iwp)                    ::  disp_unit
634    INTEGER(iwp), INTENT(IN)        ::  d1
635    INTEGER(iwp), INTENT(IN)        ::  d2
636    INTEGER(iwp), SAVE              ::  pe_from = 0
637    INTEGER(iwp), INTENT(OUT)       ::  win
638
639    INTEGER(KIND=MPI_ADDRESS_KIND)  ::  rem_size
640    INTEGER(KIND=MPI_ADDRESS_KIND)  ::  wsize
641
642    INTEGER, DIMENSION(1)           ::  buf_shape
643
644    REAL(sp), DIMENSION(:), POINTER ::  buf
645    REAL(sp), DIMENSION(:), POINTER ::  p1
646
647    TYPE(C_PTR), SAVE               ::  base_ptr
648    TYPE(C_PTR), SAVE               ::  rem_ptr
649
650
651    IF ( this%no_shared_memory_in_this_run )  RETURN
652!
653!-- Allocate shared memory on node rank 0 threads.
654    IF ( this%sh_rank == pe_from )  THEN
655       wsize = d2 - d1 + 1
656    ELSE
657       wsize = 1
658    ENDIF
659    wsize = wsize * sp  ! Please note, size is always in bytes, independently of the displacement
660                       ! unit
661
662    CALL MPI_WIN_ALLOCATE_SHARED( wsize, sp, MPI_INFO_NULL, this%comm_shared,base_ptr, win, ierr )
663!
664!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
665    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
666!
667!-- Convert C- to Fortran-pointer
668    buf_shape(1) = d2 - d1 + 1
669    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
670    p1(d1:) => buf
671!
672!-- Allocate shared memory in round robin on all PEs of a node.
673    pe_from = MOD( pe_from, this%sh_npes )
674
675 END SUBROUTINE sm_allocate_shared_1d_32
676
677
678!--------------------------------------------------------------------------------------------------!
679! Description:
680! ------------
681!> Allocate shared 1d-INTEGER array on ALL threads
682!--------------------------------------------------------------------------------------------------!
683 SUBROUTINE sm_allocate_shared_1di( this, p1, d1, d2, win )
684
685    IMPLICIT NONE
686
687    CLASS(sm_class), INTENT(inout)  ::  this
688
689    INTEGER(iwp)                    ::  disp_unit
690    INTEGER(iwp), INTENT(IN)        ::  d1
691    INTEGER(iwp), INTENT(IN)        ::  d2
692    INTEGER(iwp), SAVE              ::  pe_from = 0
693    INTEGER(iwp), INTENT(OUT)       ::  win
694
695    INTEGER(KIND=MPI_ADDRESS_KIND)  ::  rem_size
696    INTEGER(KIND=MPI_ADDRESS_KIND)  ::  wsize
697
698    INTEGER, DIMENSION(1)           ::  buf_shape
699
700    INTEGER(iwp), DIMENSION(:), POINTER ::  buf
701    INTEGER(iwp), DIMENSION(:), POINTER ::  p1
702
703    TYPE(C_PTR), SAVE                   ::  base_ptr
704    TYPE(C_PTR), SAVE                   ::  rem_ptr
705
706
707    IF ( this%no_shared_memory_in_this_run )  RETURN
708!
709!-- Allocate shared memory on node rank 0 threads.
710    IF ( this%sh_rank == pe_from )  THEN
711       wsize = d2 - d1 + 1
712    ELSE
713       wsize = 1
714    ENDIF
715    wsize = wsize * iwp  ! Please note, size is always in bytes, independently of the displacement
716                       ! unit
717
718    CALL MPI_WIN_ALLOCATE_SHARED( wsize, iwp, MPI_INFO_NULL, this%comm_shared,base_ptr, win, ierr )
719!
720!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
721    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
722!
723!-- Convert C- to Fortran-pointer
724    buf_shape(1) = d2 - d1 + 1
725    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
726    p1(d1:) => buf
727!
728!-- Allocate shared memory in round robin on all PEs of a node.
729    pe_from = MOD( pe_from, this%sh_npes )
730
731 END SUBROUTINE sm_allocate_shared_1di
732
733
734!--------------------------------------------------------------------------------------------------!
735! Description:
736! ------------
737!> Allocate shared 2d-REAL array on ALL threads (64 Bit)
738!--------------------------------------------------------------------------------------------------!
739 SUBROUTINE sm_allocate_shared_2d_64( this, p2, n_nxlg, n_nxrg, n_nysg, n_nyng, win )
740
741    IMPLICIT NONE
742
743    CLASS(sm_class), INTENT(INOUT)    ::  this
744
745    INTEGER(iwp)                      ::  disp_unit
746    INTEGER(iwp), INTENT(IN)          ::  n_nxlg
747    INTEGER(iwp), INTENT(IN)          ::  n_nxrg
748    INTEGER(iwp), INTENT(IN)          ::  n_nyng
749    INTEGER(iwp), INTENT(IN)          ::  n_nysg
750    INTEGER(iwp), SAVE                ::  pe_from = 0
751    INTEGER(iwp), INTENT(OUT)         ::  win
752
753    INTEGER(KIND=MPI_ADDRESS_KIND)    ::  rem_size
754    INTEGER(KIND=MPI_ADDRESS_KIND)    ::  wsize
755
756    INTEGER(iwp), DIMENSION(2)        ::  buf_shape
757
758    REAL(dp), DIMENSION(:,:), POINTER ::  buf
759    REAL(dp), DIMENSION(:,:), POINTER ::  p2
760
761    TYPE(C_PTR), SAVE                 ::  base_ptr
762    TYPE(C_PTR), SAVE                 ::  rem_ptr
763
764
765    IF ( this%no_shared_memory_in_this_run )  RETURN
766!
767!-- Allocate shared memory on node rank 0 threads.
768    IF ( this%sh_rank == pe_from )  THEN
769       wsize = ( n_nyng - n_nysg + 1 ) * ( n_nxrg - n_nxlg + 1 )
770    ELSE
771       wsize = 1
772    ENDIF
773
774    wsize = wsize * dp  ! Please note, size is always in bytes, independently of the displacement
775                        ! unit
776
777    CALL MPI_WIN_ALLOCATE_SHARED( wsize, 8, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
778!
779!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
780    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
781!
782!-- Convert C- to Fortran-pointer
783    buf_shape(2) = n_nyng - n_nysg + 1
784    buf_shape(1) = n_nxrg - n_nxlg + 1
785    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
786    p2(n_nxlg:, n_nysg:) => buf
787!
788!-- Allocate shared memory in round robin on all PEs of a node.
789    pe_from = MOD( pe_from, this%sh_npes )
790
791 END SUBROUTINE sm_allocate_shared_2d_64
792
793
794!--------------------------------------------------------------------------------------------------!
795! Description:
796! ------------
797!> Allocate shared 2d-REAL (32 Bit) array on ALL threads
798!--------------------------------------------------------------------------------------------------!
799 SUBROUTINE sm_allocate_shared_2d_32( this, p2, n_nxlg, n_nxrg, n_nysg, n_nyng, win )
800
801    IMPLICIT NONE
802
803    CLASS(sm_class), INTENT(INOUT)    ::  this
804
805    INTEGER(iwp)                      ::  disp_unit
806    INTEGER(iwp), INTENT(IN)          ::  n_nxlg
807    INTEGER(iwp), INTENT(IN)          ::  n_nxrg
808    INTEGER(iwp), INTENT(IN)          ::  n_nyng
809    INTEGER(iwp), INTENT(IN)          ::  n_nysg
810    INTEGER(iwp), SAVE                ::  pe_from = 0
811    INTEGER(iwp), INTENT(OUT)         ::  win
812
813    INTEGER(KIND=MPI_ADDRESS_KIND)    ::  rem_size
814    INTEGER(KIND=MPI_ADDRESS_KIND)    ::  wsize
815
816    INTEGER(iwp), DIMENSION(2)        ::  buf_shape
817
818    REAL(sp), DIMENSION(:,:), POINTER ::  buf
819    REAL(sp), DIMENSION(:,:), POINTER ::  p2
820
821    TYPE(C_PTR), SAVE                 ::  base_ptr
822    TYPE(C_PTR), SAVE                 ::  rem_ptr
823
824
825    IF ( this%no_shared_memory_in_this_run )  RETURN
826!
827!-- Allocate shared memory on node rank 0 threads.
828    IF ( this%sh_rank == pe_from )  THEN
829       wsize = ( n_nyng - n_nysg + 1 ) * ( n_nxrg - n_nxlg + 1 )
830    ELSE
831       wsize = 1
832    ENDIF
833
834    wsize = wsize * sp  ! Please note, size is always in bytes, independently of the displacement
835                        ! unit
836
837    CALL MPI_WIN_ALLOCATE_SHARED( wsize, dp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
838!
839!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
840    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
841!
842!-- Convert C- to Fortran-pointer
843    buf_shape(2) = n_nyng - n_nysg + 1
844    buf_shape(1) = n_nxrg - n_nxlg + 1
845    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
846    p2(n_nxlg:, n_nysg:) => buf
847!
848!-- Allocate shared memory in round robin on all PEs of a node.
849    pe_from = MOD( pe_from, this%sh_npes )
850
851 END SUBROUTINE sm_allocate_shared_2d_32
852
853
854!--------------------------------------------------------------------------------------------------!
855! Description:
856! ------------
857!> Allocate shared 2d-INTEGER array on ALL threads
858!--------------------------------------------------------------------------------------------------!
859 SUBROUTINE sm_allocate_shared_2di( this, p2i, n_nxlg, n_nxrg, n_nysg, n_nyng, win )
860
861    IMPLICIT NONE
862
863    CLASS(sm_class), INTENT(inout)        ::  this         !<
864
865    INTEGER(iwp)                          ::  disp_unit    !<
866    INTEGER(iwp), INTENT(IN)              ::  n_nxlg       !<
867    INTEGER(iwp), INTENT(IN)              ::  n_nxrg       !<
868    INTEGER(iwp), INTENT(IN)              ::  n_nyng       !<
869    INTEGER(iwp), INTENT(IN)              ::  n_nysg       !<
870    INTEGER(iwp), SAVE                    ::  pe_from = 0  !<
871    INTEGER(iwp), INTENT(OUT)             ::  win          !<
872
873    INTEGER(kind=MPI_ADDRESS_KIND)        ::  rem_size     !<
874    INTEGER(kind=MPI_ADDRESS_KIND)        ::  wsize        !<
875
876    INTEGER(iwp), DIMENSION(2)            ::  buf_shape    !<
877
878    INTEGER(iwp), DIMENSION(:,:), POINTER ::  buf          !<
879    INTEGER(iwp), DIMENSION(:,:), POINTER ::  p2i          !<
880
881    TYPE(C_PTR), SAVE                     ::  base_ptr     !<
882    TYPE(C_PTR), SAVE                     ::  rem_ptr      !<
883
884
885    IF ( this%no_shared_memory_in_this_run )  RETURN
886!
887!-- Allocate shared memory on node rank 0 threads.
888    IF ( this%sh_rank == pe_from )  THEN
889       wsize = ( n_nyng - n_nysg + 1 ) * ( n_nxrg - n_nxlg + 1 )
890    ELSE
891       wsize = 1
892    ENDIF
893
894    wsize = wsize * 4  ! Please note, size is always in bytes, independently of the displacement
895                       ! unit
896
897    CALL MPI_WIN_ALLOCATE_SHARED( wsize, 4, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
898!
899!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
900    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
901!
902!-- Convert C- to Fortran-pointer
903    buf_shape(2) = n_nyng - n_nysg + 1
904    buf_shape(1) = n_nxrg - n_nxlg + 1
905    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
906    p2i(n_nxlg:, n_nysg:) => buf
907!
908!-- Allocate shared memory in round robin on all PEs of a node.
909    pe_from = MOD( pe_from, this%sh_npes )
910
911 END SUBROUTINE sm_allocate_shared_2di
912
913
914!--------------------------------------------------------------------------------------------------!
915! Description:
916! ------------
917!> Allocate shared 3d-REAL (64 Bit) array on ALL threads
918!--------------------------------------------------------------------------------------------------!
919 SUBROUTINE sm_allocate_shared_3d_64( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, win )
920
921    IMPLICIT NONE
922
923    CLASS(sm_class), INTENT(inout)      ::  this         !<
924
925    INTEGER                             ::  disp_unit    !<
926    INTEGER, INTENT(IN)                 ::  d1e          !<
927    INTEGER, INTENT(IN)                 ::  d1s          !<
928    INTEGER, INTENT(IN)                 ::  d2e          !<
929    INTEGER, INTENT(IN)                 ::  d2s          !<
930    INTEGER, INTENT(IN)                 ::  d3e          !<
931    INTEGER, INTENT(IN)                 ::  d3s          !<
932    INTEGER, SAVE                       ::  pe_from = 0  !<
933    INTEGER, INTENT(OUT)                ::  win          !<
934
935    INTEGER(KIND=MPI_ADDRESS_KIND)      ::  rem_size     !<
936    INTEGER(KIND=MPI_ADDRESS_KIND)      ::  wsize        !<
937
938    INTEGER, DIMENSION(3)               ::  buf_shape    !<
939
940    REAL(dp), DIMENSION(:,:,:), POINTER ::  buf          !<
941    REAL(dp), DIMENSION(:,:,:), POINTER ::  p3           !<
942
943    TYPE(C_PTR), SAVE                   ::  base_ptr     !<
944    TYPE(C_PTR), SAVE                   ::  rem_ptr      !<
945
946
947    IF ( this%no_shared_memory_in_this_run )  RETURN
948!
949!-- Allocate shared memory on node rank 0 threads.
950    IF ( this%sh_rank == pe_from )  THEN
951       wsize = ( d3e - d3s + 1 ) * ( d2e - d2s + 1 ) * ( d1e - d1s + 1 )
952    ELSE
953       wsize = 1
954    ENDIF
955
956    wsize = wsize * dp ! Please note, size is always in bytes, independently of the displacement
957                       ! unit
958
959    CALL MPI_WIN_ALLOCATE_SHARED( wsize, dp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
960!
961!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
962    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
963!
964!-- Convert C- to Fortran-pointer
965    buf_shape(3) = d3e - d3s + 1
966    buf_shape(2) = d2e - d2s + 1
967    buf_shape(1) = d1e - d1s + 1
968    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
969    p3(d1s:,d2s:,d3s:) => buf
970!
971!-- Allocate shared memory in round robin on all PEs of a node.
972    pe_from = MOD( pe_from, this%sh_npes )
973
974 END SUBROUTINE sm_allocate_shared_3d_64
975
976
977!--------------------------------------------------------------------------------------------------!
978! Description:
979! ------------
980!> Allocate shared 3d-REAL (32 Bit) array on ALL threads
981!--------------------------------------------------------------------------------------------------!
982 SUBROUTINE sm_allocate_shared_3d_32( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, win )
983
984    IMPLICIT NONE
985
986    CLASS(sm_class), INTENT(inout)      ::  this
987
988    INTEGER                             ::  disp_unit
989    INTEGER, INTENT(IN)                 ::  d1e
990    INTEGER, INTENT(IN)                 ::  d1s
991    INTEGER, INTENT(IN)                 ::  d2e
992    INTEGER, INTENT(IN)                 ::  d2s
993    INTEGER, INTENT(IN)                 ::  d3e
994    INTEGER, INTENT(IN)                 ::  d3s
995    INTEGER, SAVE                       ::  pe_from = 0
996    INTEGER, INTENT(OUT)                ::  win
997
998    INTEGER(KIND=MPI_ADDRESS_KIND)      ::  rem_size
999    INTEGER(KIND=MPI_ADDRESS_KIND)      ::  wsize
1000
1001    INTEGER, DIMENSION(3)               ::  buf_shape
1002
1003    REAL(sp), DIMENSION(:,:,:), POINTER ::  buf
1004    REAL(sp), DIMENSION(:,:,:), POINTER ::  p3
1005
1006    TYPE(C_PTR), SAVE                   ::  base_ptr
1007    TYPE(C_PTR), SAVE                   ::  rem_ptr
1008
1009
1010    IF ( this%no_shared_memory_in_this_run )  RETURN
1011!
1012!-- Allocate shared memory on node rank 0 threads.
1013    IF ( this%sh_rank == pe_from )  THEN
1014       wsize = ( d3e - d3s + 1 ) * ( d2e - d2s + 1 ) * ( d1e - d1s + 1 )
1015    ELSE
1016       wsize = 1
1017    ENDIF
1018
1019    wsize = wsize * sp ! Please note, size is always in bytes, independently of the displacement
1020                       ! unit
1021
1022    CALL MPI_WIN_ALLOCATE_SHARED( wsize, sp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
1023!
1024!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
1025    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
1026!
1027!-- Convert C- to Fortran-pointer
1028    buf_shape(3) = d3e - d3s + 1
1029    buf_shape(2) = d2e - d2s + 1
1030    buf_shape(1) = d1e - d1s + 1
1031    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
1032    p3(d1s:,d2s:,d3s:) => buf
1033!
1034!-- Allocate shared memory in round robin on all PEs of a node.
1035    pe_from = MOD( pe_from, this%sh_npes )
1036
1037 END SUBROUTINE sm_allocate_shared_3d_32
1038
1039
1040!--------------------------------------------------------------------------------------------------!
1041! Description:
1042! ------------
1043!> Allocate shared 3d-REAL (32 bit) array on ALL threads
1044!--------------------------------------------------------------------------------------------------!
1045 SUBROUTINE sm_allocate_shared_3di_32( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, win )
1046
1047    IMPLICIT NONE
1048
1049    CLASS(sm_class), INTENT(inout)      ::  this
1050
1051    INTEGER                             ::  disp_unit
1052    INTEGER, INTENT(IN)                 ::  d1e
1053    INTEGER, INTENT(IN)                 ::  d1s
1054    INTEGER, INTENT(IN)                 ::  d2e
1055    INTEGER, INTENT(IN)                 ::  d2s
1056    INTEGER, INTENT(IN)                 ::  d3e
1057    INTEGER, INTENT(IN)                 ::  d3s
1058    INTEGER, SAVE                       ::  pe_from = 0
1059    INTEGER, INTENT(OUT)                ::  win
1060
1061    INTEGER(KIND=MPI_ADDRESS_KIND)      ::  rem_size
1062    INTEGER(KIND=MPI_ADDRESS_KIND)      ::  wsize
1063
1064    INTEGER, DIMENSION(3)               ::  buf_shape
1065
1066    INTEGER(isp), DIMENSION(:,:,:), POINTER ::  buf
1067    INTEGER(isp), DIMENSION(:,:,:), POINTER ::  p3
1068
1069    TYPE(C_PTR), SAVE                   ::  base_ptr
1070    TYPE(C_PTR), SAVE                   ::  rem_ptr
1071
1072
1073    IF ( this%no_shared_memory_in_this_run )  RETURN
1074!
1075!-- Allocate shared memory on node rank 0 threads.
1076    IF ( this%sh_rank == pe_from )  THEN
1077       wsize = ( d3e - d3s + 1 ) * ( d2e - d2s + 1 ) * ( d1e - d1s + 1 )
1078    ELSE
1079       wsize = 1
1080    ENDIF
1081
1082    wsize = wsize * isp ! Please note, size is always in bytes, independently of the displacement
1083                       ! unit
1084
1085    CALL MPI_WIN_ALLOCATE_SHARED( wsize, isp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
1086!
1087!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
1088    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
1089!
1090!-- Convert C- to Fortran-pointer
1091    buf_shape(3) = d3e - d3s + 1
1092    buf_shape(2) = d2e - d2s + 1
1093    buf_shape(1) = d1e - d1s + 1
1094    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
1095    p3(d1s:,d2s:,d3s:) => buf
1096!
1097!-- Allocate shared memory in round robin on all PEs of a node.
1098    pe_from = MOD( pe_from, this%sh_npes )
1099
1100 END SUBROUTINE sm_allocate_shared_3di_32
1101
1102
1103!--------------------------------------------------------------------------------------------------!
1104! Description:
1105! ------------
1106!> Allocate shared 3d-REAL (64 bit) array on ALL threads
1107!--------------------------------------------------------------------------------------------------!
1108 SUBROUTINE sm_allocate_shared_3di_64( this, p3, d1s, d1e, d2s, d2e, d3s, d3e, win )
1109
1110    IMPLICIT NONE
1111
1112    CLASS(sm_class), INTENT(inout)      ::  this         !<
1113
1114    INTEGER                             ::  disp_unit    !<
1115    INTEGER, INTENT(IN)                 ::  d1e          !<
1116    INTEGER, INTENT(IN)                 ::  d1s          !<
1117    INTEGER, INTENT(IN)                 ::  d2e          !<
1118    INTEGER, INTENT(IN)                 ::  d2s          !<
1119    INTEGER, INTENT(IN)                 ::  d3e          !<
1120    INTEGER, INTENT(IN)                 ::  d3s          !<
1121    INTEGER, SAVE                       ::  pe_from = 0  !<
1122    INTEGER, INTENT(OUT)                ::  win          !<
1123
1124    INTEGER(KIND=MPI_ADDRESS_KIND)      ::  rem_size     !<
1125    INTEGER(KIND=MPI_ADDRESS_KIND)      ::  wsize        !<
1126
1127    INTEGER, DIMENSION(3)               ::  buf_shape    !<
1128
1129    INTEGER(idp), DIMENSION(:,:,:), POINTER ::  buf          !<
1130    INTEGER(idp), DIMENSION(:,:,:), POINTER ::  p3           !<
1131
1132    TYPE(C_PTR), SAVE                   ::  base_ptr     !<
1133    TYPE(C_PTR), SAVE                   ::  rem_ptr      !<
1134
1135
1136    IF ( this%no_shared_memory_in_this_run )  RETURN
1137!
1138!-- Allocate shared memory on node rank 0 threads.
1139    IF ( this%sh_rank == pe_from )  THEN
1140       wsize = ( d3e - d3s + 1 ) * ( d2e - d2s + 1 ) * ( d1e - d1s + 1 )
1141    ELSE
1142       wsize = 1
1143    ENDIF
1144
1145    wsize = wsize * idp ! Please note, size is always in bytes, independently of the displacement
1146                        ! unit
1147
1148    CALL MPI_WIN_ALLOCATE_SHARED( wsize, idp, MPI_INFO_NULL, this%comm_shared, base_ptr, win, ierr )
1149!
1150!-- Get C-pointer of the memory located on node-rank pe_from (sh_rank == pe_from)
1151    CALL MPI_WIN_SHARED_QUERY( win, pe_from, rem_size, disp_unit, rem_ptr, ierr )
1152!
1153!-- Convert C- to Fortran-pointer
1154    buf_shape(3) = d3e - d3s + 1
1155    buf_shape(2) = d2e - d2s + 1
1156    buf_shape(1) = d1e - d1s + 1
1157    CALL C_F_POINTER( rem_ptr, buf, buf_shape )
1158    p3(d1s:,d2s:,d3s:) => buf
1159!
1160!-- Allocate shared memory in round robin on all PEs of a node.
1161    pe_from = MOD( pe_from, this%sh_npes )
1162
1163 END SUBROUTINE sm_allocate_shared_3di_64
1164
1165#endif
1166
1167
1168!--------------------------------------------------------------------------------------------------!
1169! Description:
1170! ------------
1171!> ???
1172!--------------------------------------------------------------------------------------------------!
1173 SUBROUTINE sm_adjust_outer_boundary( this )
1174
1175    IMPLICIT NONE
1176
1177    CLASS(sm_class), INTENT(inout) ::  this  !<
1178
1179
1180    IF ( this%no_shared_memory_in_this_run )  RETURN
1181
1182    IF ( this%io_grid%nxl == 0 )  THEN
1183       this%io_grid%nxl = this%io_grid%nxl - nbgp
1184       this%io_grid%nnx = this%io_grid%nnx + nbgp
1185    ENDIF
1186
1187    IF ( this%io_grid%nxr == nx  .OR.  npex == -1 )  THEN   ! npex == -1 if -D__parallel not set
1188       this%io_grid%nxr = this%io_grid%nxr + nbgp
1189       this%io_grid%nnx = this%io_grid%nnx + nbgp
1190    ENDIF
1191
1192    IF ( this%io_grid%nys == 0 )  THEN
1193       this%io_grid%nys = this%io_grid%nys - nbgp
1194       this%io_grid%nny = this%io_grid%nny + nbgp
1195    ENDIF
1196
1197    IF ( this%io_grid%nyn == ny .OR.  npey == -1 )  THEN   ! npey == -1 if -D__parallel not set
1198       this%io_grid%nyn = this%io_grid%nyn + nbgp
1199       this%io_grid%nny = this%io_grid%nny + nbgp
1200    ENDIF
1201
1202    this%io_grid%nxl = this%io_grid%nxl + nbgp
1203    this%io_grid%nxr = this%io_grid%nxr + nbgp
1204    this%io_grid%nys = this%io_grid%nys + nbgp
1205    this%io_grid%nyn = this%io_grid%nyn + nbgp
1206    this%io_grid%nnx = this%io_grid%nnx
1207    this%io_grid%nny = this%io_grid%nny
1208
1209 END SUBROUTINE sm_adjust_outer_boundary
1210
1211
1212!--------------------------------------------------------------------------------------------------!
1213! Description:
1214! ------------
1215!> Deallocate shared aray and free related window.
1216!--------------------------------------------------------------------------------------------------!
1217 SUBROUTINE sm_free_shared( this, win )
1218
1219    IMPLICIT NONE
1220
1221    CLASS(sm_class), INTENT(inout) ::  this  !<
1222
1223    INTEGER(iwp), INTENT(INOUT)    ::  win   !<
1224
1225    IF ( this%no_shared_memory_in_this_run )  RETURN
1226#if defined( __parallel )
1227    CALL MPI_WIN_FREE( win, ierr )
1228#endif
1229    win = -1
1230
1231 END SUBROUTINE sm_free_shared
1232
1233
1234!--------------------------------------------------------------------------------------------------!
1235! Description:
1236! ------------
1237!> ...
1238!--------------------------------------------------------------------------------------------------!
1239 SUBROUTINE sm_node_barrier( this )
1240
1241    IMPLICIT NONE
1242
1243    CLASS(sm_class), INTENT(inout) ::  this  !<
1244
1245
1246    IF ( this%no_shared_memory_in_this_run )  RETURN
1247
1248#if defined( __parallel )
1249    CALL MPI_BARRIER( this%comm_shared, ierr )
1250#endif
1251
1252 END SUBROUTINE sm_node_barrier
1253
1254
1255 SUBROUTINE save_grid_into_this_class( this )
1256
1257    IMPLICIT NONE
1258
1259    CLASS(domain_decomposition_grid_features), INTENT(inout) ::  this  !<
1260
1261       this%myid     = myid      !<
1262       this%nnx      = nnx       !<
1263       this%nny      = nny       !<
1264       this%nx       = nx        !<
1265       this%nxl      = nxl       !<
1266       this%nxr      = nxr       !<
1267       this%ny       = ny        !<
1268       this%nyn      = nyn       !<
1269       this%nys      = nys       !<
1270       this%numprocs = numprocs  !<
1271       this%comm2d   = comm2d    !<
1272
1273 END SUBROUTINE save_grid_into_this_class
1274
1275
1276 SUBROUTINE activate_grid_from_this_class( this )
1277
1278    IMPLICIT NONE
1279
1280    CLASS(domain_decomposition_grid_features), INTENT(inout) ::  this  !<
1281
1282       myid     = this%myid      !<
1283       nnx      = this%nnx       !<
1284       nny      = this%nny       !<
1285       nx       = this%nx        !<
1286       nxl      = this%nxl       !<
1287       nxr      = this%nxr       !<
1288       ny       = this%ny        !<
1289       nyn      = this%nyn       !<
1290       nys      = this%nys       !<
1291       numprocs = this%numprocs  !<
1292       comm2d   = this%comm2d    !<
1293
1294 END SUBROUTINE activate_grid_from_this_class
1295
1296 END MODULE shared_memory_io_mod
Note: See TracBrowser for help on using the repository browser.