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

Last change on this file since 4869 was 4828, checked in by Giersch, 4 years ago

Copyright updated to year 2021, interface pmc_sort removed to accelarate the nesting code

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