source: palm/trunk/SOURCE/pmc_mpi_wrapper_mod.f90 @ 1933

Last change on this file since 1933 was 1933, checked in by hellstea, 5 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 18.8 KB
Line 
1 MODULE pmc_mpi_wrapper
2
3!-------------------------------------------------------------------------------!
4! This file is part of PALM.
5!
6! PALM is free software: you can redistribute it and/or modify it under the terms
7! of the GNU General Public License as published by the Free Software Foundation,
8! either version 3 of the License, or (at your option) any later version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2016 Leibniz Universitaet Hannover
18!-------------------------------------------------------------------------------!
19!
20! Current revisions:
21! ------------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: pmc_mpi_wrapper_mod.f90 1933 2016-06-13 07:12:51Z hellstea $
27!
28! 1901 2016-05-04 15:39:38Z raasch
29! Code clean up. The words server/client changed to parent/child.
30!
31! 1900 2016-05-04 15:27:53Z raasch
32! re-formatted to match PALM style
33!
34! 1850 2016-04-08 13:29:27Z maronga
35! Module renamed
36!
37!
38! 1808 2016-04-05 19:44:00Z raasch
39! MPI module used by default on all machines
40!
41! 1779 2016-03-03 08:01:28Z raasch
42! kind=dp replaced by wp
43!
44! 1764 2016-02-28 12:45:19Z raasch
45! cpp-statement added (nesting can only be used in parallel mode),
46! kind-parameters adjusted to PALM-kinds
47!
48! 1762 2016-02-25 12:31:13Z hellstea
49! Initial revision by K. Ketelsen
50!
51! Description:
52! ------------
53!
54! MPI Wrapper of Palm Model Coupler
55!-------------------------------------------------------------------------------!
56
57#if defined( __parallel )
58    USE, INTRINSIC ::  ISO_C_BINDING
59
60#if defined( __mpifh )
61    INCLUDE "mpif.h"
62#else
63    USE MPI
64#endif
65
66    USE kinds
67    USE pmc_handle_communicator,                                                &
68        ONLY: m_model_comm, m_model_rank, m_to_parent_comm, m_to_child_comm
69
70    IMPLICIT NONE
71
72    PRIVATE
73    SAVE
74
75    INTERFACE pmc_send_to_parent
76       MODULE PROCEDURE pmc_send_to_parent_integer
77       MODULE PROCEDURE pmc_send_to_parent_integer_2
78       MODULE PROCEDURE pmc_send_to_parent_real_r1
79       MODULE PROCEDURE pmc_send_to_parent_real_r2
80       MODULE PROCEDURE pmc_send_to_parent_real_r3
81    END INTERFACE pmc_send_to_parent
82
83    INTERFACE pmc_recv_from_parent
84       MODULE PROCEDURE pmc_recv_from_parent_integer
85       MODULE PROCEDURE pmc_recv_from_parent_real_r1
86       MODULE PROCEDURE pmc_recv_from_parent_real_r2
87       MODULE PROCEDURE pmc_recv_from_parent_real_r3
88    END INTERFACE pmc_recv_from_parent
89
90    INTERFACE pmc_send_to_child
91       MODULE PROCEDURE pmc_send_to_child_integer
92       MODULE PROCEDURE pmc_send_to_child_real_r1
93       MODULE PROCEDURE pmc_send_to_child_real_r2
94       MODULE PROCEDURE pmc_send_to_child_real_r3
95    END INTERFACE pmc_send_to_child
96
97    INTERFACE pmc_recv_from_child
98       MODULE PROCEDURE pmc_recv_from_child_integer
99       MODULE PROCEDURE pmc_recv_from_child_integer_2
100       MODULE PROCEDURE pmc_recv_from_child_real_r1
101       MODULE PROCEDURE pmc_recv_from_child_real_r2
102       MODULE PROCEDURE pmc_recv_from_child_real_r3
103    END INTERFACE pmc_recv_from_child
104
105    INTERFACE pmc_bcast
106       MODULE PROCEDURE pmc_bcast_integer
107       MODULE PROCEDURE pmc_bcast_character
108    END INTERFACE pmc_bcast
109
110    INTERFACE pmc_inter_bcast
111       MODULE PROCEDURE pmc_inter_bcast_integer_1
112    END INTERFACE pmc_inter_bcast
113
114    INTERFACE pmc_alloc_mem
115       MODULE PROCEDURE pmc_alloc_mem_integer_1
116       MODULE PROCEDURE pmc_alloc_mem_Real_1
117    END INTERFACE pmc_alloc_mem
118
119    INTERFACE pmc_time
120       MODULE PROCEDURE pmc_time
121    END INTERFACE pmc_time
122
123    PUBLIC pmc_alloc_mem, pmc_bcast, pmc_inter_bcast, pmc_recv_from_child,      &
124           pmc_recv_from_parent, pmc_send_to_child, pmc_send_to_parent,         &
125           pmc_time
126
127 CONTAINS
128
129
130 SUBROUTINE pmc_send_to_parent_integer( buf, n, parent_rank, tag, ierr )
131
132    IMPLICIT NONE
133
134    INTEGER, DIMENSION(:), INTENT(IN) ::  buf          !<
135    INTEGER, INTENT(IN)               ::  n            !<
136    INTEGER, INTENT(IN)               ::  parent_rank  !<
137    INTEGER, INTENT(IN)               ::  tag          !<
138    INTEGER, INTENT(OUT)              ::  ierr         !<
139
140    ierr = 0
141    CALL MPI_SEND( buf, n, MPI_INTEGER, parent_rank, tag, m_to_parent_comm,     &
142                   ierr)
143
144 END SUBROUTINE pmc_send_to_parent_integer
145
146
147
148 SUBROUTINE pmc_recv_from_parent_integer( buf, n, parent_rank, tag, ierr )
149
150    IMPLICIT NONE
151
152    INTEGER, DIMENSION(:), INTENT(OUT) ::  buf          !<
153    INTEGER, INTENT(IN)                ::  n            !<
154    INTEGER, INTENT(IN)                ::  parent_rank  !<
155    INTEGER, INTENT(IN)                ::  tag          !<
156    INTEGER, INTENT(OUT)               ::  ierr         !<
157
158    ierr = 0
159    CALL MPI_RECV( buf, n, MPI_INTEGER, parent_rank, tag, m_to_parent_comm,     &
160                   MPI_STATUS_IGNORE, ierr )
161
162 END SUBROUTINE pmc_recv_from_parent_integer
163
164
165
166 SUBROUTINE pmc_send_to_parent_integer_2( buf, n, parent_rank, tag, ierr )
167
168    IMPLICIT NONE
169
170    INTEGER, DIMENSION(:,:), INTENT(IN) :: buf          !<
171    INTEGER, INTENT(IN)                 :: n            !<
172    INTEGER, INTENT(IN)                 :: parent_rank  !<
173    INTEGER, INTENT(IN)                 :: tag          !<
174    INTEGER, INTENT(OUT)                :: ierr         !<
175
176    ierr = 0
177    CALL MPI_SEND( buf, n, MPI_INTEGER, parent_rank, tag, m_to_parent_comm,     &
178                   ierr )
179
180 END SUBROUTINE pmc_send_to_parent_integer_2
181
182
183
184 SUBROUTINE pmc_send_to_parent_real_r1( buf, n, parent_rank, tag, ierr )
185
186    IMPLICIT NONE
187
188    REAL(wp), DIMENSION(:), INTENT(IN) ::  buf          !<
189    INTEGER, INTENT(IN)                ::  n            !<
190    INTEGER, INTENT(IN)                ::  parent_rank  !<
191    INTEGER, INTENT(IN)                ::  tag          !<
192    INTEGER, INTENT(OUT)               ::  ierr         !<
193
194    ierr = 0
195    CALL MPI_SEND( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm, ierr )
196
197 END SUBROUTINE pmc_send_to_parent_real_r1
198
199
200
201 SUBROUTINE pmc_recv_from_parent_real_r1( buf, n, parent_rank, tag, ierr )
202
203    IMPLICIT NONE
204
205    REAL(wp), DIMENSION(:), INTENT(OUT) ::  buf          !<
206    INTEGER, INTENT(IN)                 ::  n            !<
207    INTEGER, INTENT(IN)                 ::  parent_rank  !<
208    INTEGER, INTENT(IN)                 ::  tag          !<
209    INTEGER, INTENT(OUT)                ::  ierr         !<
210
211    ierr = 0
212    CALL MPI_RECV( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm,        &
213                   MPI_STATUS_IGNORE, ierr )
214
215 END SUBROUTINE pmc_recv_from_parent_real_r1
216
217
218
219 SUBROUTINE pmc_send_to_parent_real_r2( buf, n, parent_rank, tag, ierr )
220
221    IMPLICIT NONE
222
223    REAL(wp), DIMENSION(:,:), INTENT(IN) ::  buf          !<
224    INTEGER, INTENT(IN)                  ::  n            !<
225    INTEGER, INTENT(IN)                  ::  parent_rank  !<
226    INTEGER, INTENT(IN)                  ::  tag          !<
227    INTEGER, INTENT(OUT)                 ::  ierr         !<
228
229    ierr = 0
230    CALL MPI_SEND( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm, ierr )
231
232 END SUBROUTINE pmc_send_to_parent_real_r2
233
234
235 SUBROUTINE pmc_recv_from_parent_real_r2( buf, n, parent_rank, tag, ierr )
236
237    IMPLICIT NONE
238
239    REAL(wp), DIMENSION(:,:), INTENT(OUT) ::  buf          !<
240    INTEGER, INTENT(IN)                   ::  n            !<
241    INTEGER, INTENT(IN)                   ::  parent_rank  !<
242    INTEGER, INTENT(IN)                   ::  tag          !<
243    INTEGER, INTENT(OUT)                  ::  ierr         !<
244
245    ierr = 0
246    CALL MPI_RECV( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm,        &
247                   MPI_STATUS_IGNORE, ierr )
248
249 END SUBROUTINE pmc_recv_from_parent_real_r2
250
251
252
253 SUBROUTINE pmc_send_to_parent_real_r3( buf, n, parent_rank, tag, ierr )
254
255    IMPLICIT NONE
256
257    REAL(wp), DIMENSION(:,:,:), INTENT(IN) ::  buf          !<
258    INTEGER, INTENT(IN)                    ::  n            !<
259    INTEGER, INTENT(IN)                    ::  parent_rank  !<
260    INTEGER, INTENT(IN)                    ::  tag          !<
261    INTEGER, INTENT(OUT)                   ::  ierr         !<
262
263    ierr = 0
264    CALL MPI_SEND( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm, ierr )
265
266 END SUBROUTINE pmc_send_to_parent_real_r3
267
268
269
270 SUBROUTINE pmc_recv_from_parent_real_r3( buf, n, parent_rank, tag, ierr )
271
272    IMPLICIT NONE
273
274    REAL(wp), DIMENSION(:,:,:), INTENT(OUT) ::  buf          !<
275    INTEGER, INTENT(IN)                     ::  n            !<
276    INTEGER, INTENT(IN)                     ::  parent_rank  !<
277    INTEGER, INTENT(IN)                     ::  tag          !<
278    INTEGER, INTENT(OUT)                    ::  ierr         !<
279
280    ierr = 0
281    CALL MPI_RECV( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm,        &
282                   MPI_STATUS_IGNORE, ierr )
283
284 END SUBROUTINE pmc_recv_from_parent_real_r3
285
286
287
288 SUBROUTINE pmc_send_to_child_integer( child_id, buf, n, child_rank, tag,       &
289                                       ierr )
290
291    IMPLICIT NONE
292
293    INTEGER, INTENT(IN)               ::  child_id     !<
294    INTEGER, DIMENSION(:), INTENT(IN) ::  buf          !<
295    INTEGER, INTENT(IN)               ::  n            !<
296    INTEGER, INTENT(IN)               ::  child_rank   !<
297    INTEGER, INTENT(IN)               ::  tag          !<
298    INTEGER, INTENT(OUT)              ::  ierr         !<
299
300    ierr = 0
301    CALL MPI_SEND( buf, n, MPI_INTEGER, child_rank, tag,                        &
302                   m_to_child_comm(child_id), ierr )
303
304 END SUBROUTINE pmc_send_to_child_integer
305
306
307
308 SUBROUTINE pmc_recv_from_child_integer( child_id, buf, n, child_rank, tag,     &
309                                         ierr )
310
311    IMPLICIT NONE
312
313    INTEGER, INTENT(IN)                  ::  child_id     !<
314    INTEGER, DIMENSION(:), INTENT(INOUT) ::  buf          !<
315    INTEGER, INTENT(IN)                  ::  n            !<
316    INTEGER, INTENT(IN)                  ::  child_rank   !<
317    INTEGER, INTENT(IN)                  ::  tag          !<
318    INTEGER, INTENT(OUT)                 ::  ierr         !<
319
320    ierr = 0
321    CALL MPI_RECV( buf, n, MPI_INTEGER, child_rank, tag,                        &
322                   m_to_child_comm(child_id), MPI_STATUS_IGNORE, ierr )
323
324 END SUBROUTINE pmc_recv_from_child_integer
325
326
327
328 SUBROUTINE pmc_recv_from_child_integer_2( child_id, buf, n, child_rank,        &
329                                           tag, ierr )
330
331    IMPLICIT NONE
332
333    INTEGER, INTENT(IN)                  ::  child_id     !<
334    INTEGER, DIMENSION(:,:), INTENT(OUT) ::  buf          !<
335    INTEGER, INTENT(IN)                  ::  n            !<
336    INTEGER, INTENT(IN)                  ::  child_rank   !<
337    INTEGER, INTENT(IN)                  ::  tag          !<
338    INTEGER, INTENT(OUT)                 ::  ierr         !<
339
340    ierr = 0
341    CALL MPI_RECV( buf, n, MPI_INTEGER, child_rank, tag,                        &
342                   m_to_child_comm(child_id), MPI_STATUS_IGNORE, ierr )
343
344 END SUBROUTINE pmc_recv_from_child_integer_2
345
346
347
348 SUBROUTINE pmc_send_to_child_real_r1( child_id, buf, n, child_rank, tag,       &
349                                       ierr )
350
351    IMPLICIT NONE
352
353    INTEGER, INTENT(IN)                ::  child_id     !<
354    REAL(wp), DIMENSION(:), INTENT(IN) ::  buf          !<
355    INTEGER, INTENT(IN)                ::  n            !<
356    INTEGER, INTENT(IN)                ::  child_rank   !<
357    INTEGER, INTENT(IN)                ::  tag          !<
358    INTEGER, INTENT(OUT)               ::  ierr         !<
359
360    ierr = 0
361    CALL MPI_SEND( buf, n, MPI_REAL, child_rank, tag,                           &
362                   m_to_child_comm(child_id), ierr )
363
364 END SUBROUTINE pmc_send_to_child_real_r1
365
366
367
368 SUBROUTINE pmc_recv_from_child_real_r1( child_id, buf, n, child_rank, tag,     &
369                                         ierr )
370
371    IMPLICIT NONE
372
373    INTEGER, INTENT(IN)                   ::  child_id     !<
374    REAL(wp), DIMENSION(:), INTENT(INOUT) ::  buf          !<
375    INTEGER, INTENT(IN)                   ::  n            !<
376    INTEGER, INTENT(IN)                   ::  child_rank   !<
377    INTEGER, INTENT(IN)                   ::  tag          !<
378    INTEGER, INTENT(OUT)                  ::  ierr         !<
379
380    ierr = 0
381    CALL MPI_RECV( buf, n, MPI_REAL, child_rank, tag,                           &
382                   m_to_child_comm(child_id), MPI_STATUS_IGNORE, ierr )
383
384 END SUBROUTINE pmc_recv_from_child_real_r1
385
386
387
388 SUBROUTINE pmc_send_to_child_real_r2( child_id, buf, n, child_rank, tag,       &
389                                       ierr )
390
391    IMPLICIT NONE
392
393    INTEGER, INTENT(IN)                  ::  child_id     !<
394    REAL(wp), DIMENSION(:,:), INTENT(IN) ::  buf          !<
395    INTEGER, INTENT(IN)                  ::  n            !<
396    INTEGER, INTENT(IN)                  ::  child_rank   !<
397    INTEGER, INTENT(IN)                  ::  tag          !<
398    INTEGER, INTENT(OUT)                 ::  ierr         !<
399
400    ierr = 0
401    CALL MPI_SEND( buf, n, MPI_REAL, child_rank, tag,                           &
402                   m_to_child_comm(child_id), ierr )
403
404 END SUBROUTINE pmc_send_to_child_real_r2
405
406
407
408 SUBROUTINE pmc_recv_from_child_real_r2( child_id, buf, n, child_rank, tag,     &
409                                         ierr )
410
411    IMPLICIT NONE
412
413    INTEGER, INTENT(IN)                   ::  child_id     !<
414    REAL(wp), DIMENSION(:,:), INTENT(OUT) ::  buf          !<
415    INTEGER, INTENT(IN)                   ::  n            !<
416    INTEGER, INTENT(IN)                   ::  child_rank   !<
417    INTEGER, INTENT(IN)                   ::  tag          !<
418    INTEGER, INTENT(OUT)                  ::  ierr         !<
419
420    ierr = 0
421    CALL MPI_RECV( buf, n, MPI_REAL, child_rank, tag,                           &
422                   m_to_child_comm(child_id), MPI_STATUS_IGNORE, ierr )
423
424 END SUBROUTINE pmc_recv_from_child_real_r2
425
426
427
428 SUBROUTINE pmc_send_to_child_real_r3( child_id, buf, n, child_rank, tag,       &
429                                       ierr)
430
431    IMPLICIT NONE
432
433    INTEGER, INTENT(IN)                    ::  child_id     !<
434    REAL(wp), DIMENSION(:,:,:), INTENT(IN) ::  buf          !<
435    INTEGER, INTENT(IN)                    ::  n            !<
436    INTEGER, INTENT(IN)                    ::  child_rank   !<
437    INTEGER, INTENT(IN)                    ::  tag          !<
438    INTEGER, INTENT(OUT)                   ::  ierr         !<
439
440    ierr = 0
441    CALL MPI_SEND( buf, n, MPI_REAL, child_rank, tag,                           &
442                   m_to_child_comm(child_id), ierr )
443
444 END SUBROUTINE pmc_send_to_child_real_r3
445
446
447
448 SUBROUTINE pmc_recv_from_child_real_r3( child_id, buf, n, child_rank, tag,     &
449                                         ierr )
450
451    IMPLICIT NONE
452
453    INTEGER, INTENT(IN)                     ::  child_id     !<
454    REAL(wp), DIMENSION(:,:,:), INTENT(OUT) ::  buf          !<
455    INTEGER, INTENT(IN)                     ::  n            !<
456    INTEGER, INTENT(IN)                     ::  child_rank   !<
457    INTEGER, INTENT(IN)                     ::  tag          !<
458    INTEGER, INTENT(OUT)                    ::  ierr         !<
459
460    ierr = 0
461    CALL MPI_RECV( buf, n, MPI_REAL, child_rank, tag,                           & 
462                   m_to_child_comm(child_id), MPI_STATUS_IGNORE, ierr )
463
464 END SUBROUTINE pmc_recv_from_child_real_r3
465
466
467
468 SUBROUTINE pmc_bcast_integer( buf, root_pe, comm, ierr )
469
470    IMPLICIT NONE
471
472    INTEGER, INTENT(INOUT)         ::  buf      !<
473    INTEGER, INTENT(IN)            ::  root_pe  !<
474    INTEGER, INTENT(IN), OPTIONAL  ::  comm     !<
475    INTEGER, INTENT(OUT), OPTIONAL ::  ierr     !<
476
477    INTEGER ::  mycomm  !<
478    INTEGER ::  myerr   !<
479
480
481    IF ( PRESENT( comm ) )  THEN
482       mycomm = comm
483    ELSE
484       mycomm = m_model_comm
485    ENDIF
486
487    CALL MPI_BCAST( buf, 1, MPI_INTEGER, root_pe, mycomm, myerr )
488
489    IF ( PRESENT( ierr ) )  THEN
490       ierr = myerr
491    ENDIF
492
493 END SUBROUTINE pmc_bcast_integer
494
495
496
497 SUBROUTINE pmc_bcast_character( buf, root_pe, comm, ierr )
498
499    IMPLICIT NONE
500
501    CHARACTER(LEN=*), INTENT(INOUT) ::  buf      !<
502    INTEGER, INTENT(IN)             ::  root_pe  !<
503    INTEGER, INTENT(IN), OPTIONAL   ::  comm     !<
504    INTEGER, INTENT(OUT), OPTIONAL  ::  ierr     !<
505
506    INTEGER ::  mycomm  !<
507    INTEGER ::  myerr   !<
508
509    IF ( PRESENT( comm ) )  THEN
510       mycomm = comm
511    ELSE
512       mycomm = m_model_comm
513    ENDIF
514
515    CALL MPI_BCAST( buf, LEN(buf), MPI_CHARACTER, root_pe, mycomm, myerr )
516
517    IF ( PRESENT( ierr ) )  THEN
518       ierr = myerr
519    ENDIF
520
521 END SUBROUTINE pmc_bcast_character
522
523
524
525 SUBROUTINE pmc_inter_bcast_integer_1( buf, child_id, ierr )
526
527    IMPLICIT NONE
528
529    INTEGER, INTENT(INOUT),DIMENSION(:) ::  buf        !<
530    INTEGER, INTENT(IN),optional        ::  child_id   !<
531    INTEGER, INTENT(OUT),optional       ::  ierr       !<
532
533    INTEGER ::  mycomm   !<
534    INTEGER ::  myerr    !<
535    INTEGER ::  root_pe  !<
536
537!
538!-- PE 0 on parent broadcast to all child PEs
539    IF ( PRESENT( child_id ) )  THEN
540
541       mycomm = m_to_child_comm(child_id)
542
543       IF ( m_model_rank == 0 )  THEN
544          root_pe = MPI_ROOT
545       ELSE
546          root_pe = MPI_PROC_NULL
547       ENDIF
548
549    ELSE
550       mycomm  = m_to_parent_comm
551       root_pe = 0
552    ENDIF
553
554    CALL MPI_BCAST( buf, SIZE( buf ), MPI_INTEGER, root_pe, mycomm, myerr )
555
556    IF ( PRESENT( ierr ) )  THEN
557       ierr = myerr
558    ENDIF
559
560 END SUBROUTINE pmc_inter_bcast_integer_1
561
562
563
564 SUBROUTINE pmc_alloc_mem_integer_1( iarray, idim1 )
565!
566!-- Allocate memory with MPI_ALLOC_MEM using intermediate C-pointer
567
568    IMPLICIT NONE
569
570    INTEGER, DIMENSION(:), POINTER, INTENT(INOUT) ::  iarray  !<
571    INTEGER, INTENT(IN)                           ::  idim1   !<
572
573    INTEGER, DIMENSION(1)          ::  ashape   !<
574    INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize  !<
575    INTEGER                        ::  ierr     !<
576
577    TYPE(C_PTR)                    ::  p_myind  !<
578
579    winsize = idim1 * C_SIZEOF( ierr )
580
581    CALL MPI_ALLOC_MEM( winsize, MPI_INFO_NULL, p_myind, ierr )
582    ashape(1) = idim1
583    CALL C_F_POINTER( p_myind, iarray, ashape )
584
585 END SUBROUTINE pmc_alloc_mem_integer_1
586
587
588
589 SUBROUTINE pmc_alloc_mem_real_1( array, idim1, base_ptr )
590
591    IMPLICIT NONE
592
593    INTEGER(idp), INTENT(IN)                            ::  idim1     !<
594    REAL(KIND=wp), DIMENSION(:), POINTER, INTENT(INOUT) ::  array     !<
595    TYPE(C_PTR), INTENT(OUT), OPTIONAL                  ::  base_ptr  !<
596
597    INTEGER, DIMENSION(1)          :: ashape   !<
598    INTEGER(KIND=MPI_ADDRESS_KIND) :: winsize  !<
599    INTEGER                        :: ierr     !<
600
601    TYPE(C_PTR)                    :: p_myind  !<
602
603    winsize = idim1 * wp
604
605    CALL MPI_ALLOC_MEM( winsize , MPI_INFO_NULL, p_myind, ierr )
606    ashape(1) = idim1
607    CALL C_F_POINTER( p_myind, array, ashape )
608
609    IF ( PRESENT( base_ptr ) )  THEN
610       base_ptr = p_myind
611    ENDIF
612
613 END SUBROUTINE pmc_alloc_mem_Real_1
614
615
616
617 FUNCTION pmc_time()
618
619    REAL(kind=wp) :: pmc_time  !<
620
621    pmc_time = MPI_WTIME()
622
623  END FUNCTION pmc_time
624
625#endif
626 END MODULE pmc_mpi_wrapper
Note: See TracBrowser for help on using the repository browser.