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

Last change on this file since 1900 was 1900, checked in by raasch, 5 years ago

re-formatting of remaining pmc routines

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