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

Last change on this file since 4624 was 4620, checked in by raasch, 4 years ago

bugfix: variable definition changed

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