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

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