Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

source: palm/trunk/SOURCE/pmc_mpi_wrapper.f90 @ 1779

Last change on this file since 1779 was 1779, checked in by raasch, 8 years ago

pmc array management changed from linked list to sequential loop; further small changes and cosmetics for the pmc
  • Property svn:keywords set to Id
File size: 18.1 KB
RevLine 
[1762]1MODULE 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-2015 Leibniz Universitaet Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! ------------------
[1779]22! kind=dp replaced by wp
[1762]23!
24! Former revisions:
25! -----------------
26! $Id: pmc_mpi_wrapper.f90 1779 2016-03-03 08:01:28Z raasch $
27!
[1765]28! 1764 2016-02-28 12:45:19Z raasch
29! cpp-statement added (nesting can only be used in parallel mode),
30! kind-parameters adjusted to PALM-kinds
31!
[1763]32! 1762 2016-02-25 12:31:13Z hellstea
33! Initial revision by K. Ketelsen
[1762]34!
35! Description:
36! ------------
37!
38! MPI Wrapper of Palm Model Coupler
39!------------------------------------------------------------------------------!
40
[1764]41#if defined( __parallel )
[1762]42   use, intrinsic :: iso_c_binding
43
[1764]44#if defined( __lc )
45    USE MPI
46#else
47    INCLUDE "mpif.h"
48#endif
49   USE  kinds
[1762]50   USE  PMC_handle_communicator, ONLY: m_to_server_comm, m_to_client_comm, m_model_comm, m_model_rank
51   IMPLICIT none
52   PRIVATE
53   SAVE
54
55   INTERFACE PMC_Send_to_Server
56      MODULE PROCEDURE PMC_Send_to_Server_INTEGER
57      MODULE PROCEDURE PMC_Send_to_Server_INTEGER_2
58      MODULE PROCEDURE PMC_Send_to_Server_real_r1
59      MODULE PROCEDURE PMC_Send_to_Server_real_r2
60      MODULE PROCEDURE PMC_Send_to_Server_real_r3
61   END INTERFACE PMC_Send_to_Server
62
63   INTERFACE PMC_Recv_from_Server
64      MODULE PROCEDURE PMC_Recv_from_Server_INTEGER
65      MODULE PROCEDURE PMC_Recv_from_Server_real_r1
66      MODULE PROCEDURE PMC_Recv_from_Server_real_r2
67      MODULE PROCEDURE PMC_Recv_from_Server_real_r3
68   END INTERFACE PMC_Recv_from_Server
69
70   INTERFACE PMC_Send_to_Client
71      MODULE PROCEDURE PMC_Send_to_Client_INTEGER
72      MODULE PROCEDURE PMC_Send_to_Client_real_r1
73      MODULE PROCEDURE PMC_Send_to_Client_real_r2
74      MODULE PROCEDURE PMC_Send_to_Client_real_r3
75   END INTERFACE PMC_Send_to_Client
76
77   INTERFACE PMC_Recv_from_Client
78      MODULE PROCEDURE PMC_Recv_from_Client_INTEGER
79      MODULE PROCEDURE PMC_Recv_from_Client_INTEGER_2
80      MODULE PROCEDURE PMC_Recv_from_Client_real_r1
81      MODULE PROCEDURE PMC_Recv_from_Client_real_r2
82      MODULE PROCEDURE PMC_Recv_from_Client_real_r3
83   END INTERFACE PMC_Recv_from_Client
84
85   INTERFACE PMC_Bcast
86      MODULE PROCEDURE PMC_Bcast_INTEGER
87      MODULE PROCEDURE PMC_Bcast_character
88   END INTERFACE PMC_Bcast
89
90   INTERFACE PMC_Inter_Bcast
91      MODULE PROCEDURE PMC_Inter_Bcast_INTEGER_1
92   END INTERFACE PMC_Inter_Bcast
93
94   INTERFACE PMC_Alloc_mem
95      MODULE PROCEDURE PMC_Alloc_mem_INTEGER_1
96      MODULE PROCEDURE PMC_Alloc_mem_Real_1
97   END INTERFACE PMC_Alloc_mem
98
99   INTERFACE PMC_TIME
100      MODULE PROCEDURE PMC_TIME
101   END INTERFACE PMC_TIME
102
103   PUBLIC PMC_Send_to_Server, PMC_Recv_from_Server
104   PUBLIC PMC_Send_to_Client, PMC_Recv_from_Client
105   PUBLIC PMC_Bcast, PMC_Inter_Bcast, PMC_Alloc_mem
106   PUBLIC PMC_TIME
107
108CONTAINS
109
110   SUBROUTINE  PMC_Send_to_Server_INTEGER (buf, n, Server_rank, tag, ierr)
111      IMPLICIT     none
112      INTEGER, DIMENSION(:), INTENT(IN)         :: buf
113      INTEGER, INTENT(IN)                       :: n
114      INTEGER, INTENT(IN)                       :: Server_rank
115      INTEGER, INTENT(IN)                       :: tag
116      INTEGER, INTENT(OUT)                      :: ierr
117   
118      ierr = 0
119      CALL MPI_Send (buf, n, MPI_INTEGER, Server_rank, tag, m_to_server_comm, ierr)
120   
121      return
122   END SUBROUTINE  PMC_Send_to_Server_INTEGER
123
124   SUBROUTINE  PMC_Recv_from_Server_INTEGER (buf, n, Server_rank, tag, ierr)
125      IMPLICIT     none
126      INTEGER, DIMENSION(:), INTENT(OUT)        :: buf
127      INTEGER, INTENT(IN)                       :: n
128      INTEGER, INTENT(IN)                       :: Server_rank
129      INTEGER, INTENT(IN)                       :: tag
130      INTEGER, INTENT(OUT)                      :: ierr
131
132      ierr = 0
133      CALL MPI_Recv (buf, n, MPI_INTEGER, Server_rank, tag, m_to_server_comm, &
134         MPI_STATUS_IGNORE, ierr)
135
136      return
137   END SUBROUTINE  PMC_Recv_from_Server_INTEGER
138
139   SUBROUTINE  PMC_Send_to_Server_INTEGER_2 (buf, n, Server_rank, tag, ierr)
140      IMPLICIT     none
141      INTEGER, DIMENSION(:,:), INTENT(IN)       :: buf
142      INTEGER, INTENT(IN)                       :: n
143      INTEGER, INTENT(IN)                       :: Server_rank
144      INTEGER, INTENT(IN)                       :: tag
145      INTEGER, INTENT(OUT)                      :: ierr
146
147      ierr = 0
148      CALL MPI_Send (buf, n, MPI_INTEGER, Server_rank, tag, m_to_server_comm, ierr)
149
150      return
151   END SUBROUTINE  PMC_Send_to_Server_INTEGER_2
152
153   SUBROUTINE  PMC_Send_to_Server_real_r1 (buf, n, Server_rank, tag, ierr)
[1779]154
[1762]155      IMPLICIT     none
156
[1779]157      REAL(wp), DIMENSION(:), INTENT(IN) ::  buf
158      INTEGER, INTENT(IN)                ::  n
159      INTEGER, INTENT(IN)                ::  Server_rank
160      INTEGER, INTENT(IN)                ::  tag
161      INTEGER, INTENT(OUT)               ::  ierr
162
[1762]163      ierr = 0
[1779]164      CALL MPI_Send (buf, n, MPI_REAL, Server_rank, tag, m_to_server_comm, ierr)
[1762]165
166      return
167   END SUBROUTINE  PMC_Send_to_Server_real_r1
168
169   SUBROUTINE  PMC_Recv_from_Server_real_r1 (buf, n, Server_rank, tag, ierr)
[1779]170
[1762]171      IMPLICIT     none
172
[1779]173      REAL(wp), DIMENSION(:), INTENT(OUT) ::  buf
174      INTEGER, INTENT(IN)                 ::  n
175      INTEGER, INTENT(IN)                 ::  Server_rank
176      INTEGER, INTENT(IN)                 ::  tag
177      INTEGER, INTENT(OUT)                ::  ierr
178
[1762]179      ierr = 0
[1779]180      CALL MPI_Recv (buf, n, MPI_REAL, Server_rank, tag, m_to_server_comm,     &
181                     MPI_STATUS_IGNORE, ierr)
[1762]182
183      return
184   END SUBROUTINE  PMC_Recv_from_Server_real_r1
185
186   SUBROUTINE  PMC_Send_to_Server_real_r2 (buf, n, Server_rank, tag, ierr)
[1779]187
[1762]188      IMPLICIT     none
189
[1779]190      REAL(wp), DIMENSION(:,:), INTENT(IN) ::  buf
191      INTEGER, INTENT(IN)                  ::  n
192      INTEGER, INTENT(IN)                  ::  Server_rank
193      INTEGER, INTENT(IN)                  ::  tag
194      INTEGER, INTENT(OUT)                 ::  ierr
195
[1762]196      ierr = 0
[1779]197      CALL MPI_Send (buf, n, MPI_REAL, Server_rank, tag, m_to_server_comm, ierr)
[1762]198
199      return
200   END SUBROUTINE  PMC_Send_to_Server_real_r2
201
202   SUBROUTINE  PMC_Recv_from_Server_real_r2 (buf, n, Server_rank, tag, ierr)
[1779]203
[1762]204      IMPLICIT     none
205
[1779]206      REAL(wp), DIMENSION(:,:), INTENT(OUT) ::  buf
207      INTEGER, INTENT(IN)                   ::  n
208      INTEGER, INTENT(IN)                   ::  Server_rank
209      INTEGER, INTENT(IN)                   ::  tag
210      INTEGER, INTENT(OUT)                  ::  ierr
211
[1762]212      ierr = 0
[1779]213      CALL MPI_Recv (buf, n, MPI_REAL, Server_rank, tag, m_to_server_comm, &
[1762]214         MPI_STATUS_IGNORE, ierr)
215
216      return
217   END SUBROUTINE  PMC_Recv_from_Server_real_r2
218
219   SUBROUTINE  PMC_Send_to_Server_real_r3 (buf, n, Server_rank, tag, ierr)
[1779]220
[1762]221      IMPLICIT     none
222
[1779]223      REAL(wp), DIMENSION(:,:,:), INTENT(IN) ::  buf
224      INTEGER, INTENT(IN)                    ::  n
225      INTEGER, INTENT(IN)                    ::  Server_rank
226      INTEGER, INTENT(IN)                    ::  tag
227      INTEGER, INTENT(OUT)                   ::  ierr
228
[1762]229      ierr = 0
[1779]230      CALL MPI_Send (buf, n, MPI_REAL, Server_rank, tag, m_to_server_comm, ierr)
[1762]231
232      return
233   END SUBROUTINE  PMC_Send_to_Server_real_r3
234
235   SUBROUTINE  PMC_Recv_from_Server_real_r3 (buf, n, Server_rank, tag, ierr)
[1779]236
[1762]237      IMPLICIT     none
238
[1779]239      REAL(wp), DIMENSION(:,:,:), INTENT(OUT) ::  buf
240      INTEGER, INTENT(IN)                     ::  n
241      INTEGER, INTENT(IN)                     ::  Server_rank
242      INTEGER, INTENT(IN)                     ::  tag
243      INTEGER, INTENT(OUT)                    ::  ierr
244
[1762]245      ierr = 0
[1779]246      CALL MPI_Recv (buf, n, MPI_REAL, Server_rank, tag, m_to_server_comm, &
[1762]247         MPI_STATUS_IGNORE, ierr)
248
249      return
250   END SUBROUTINE  PMC_Recv_from_Server_real_r3
251
252
253   SUBROUTINE  PMC_Send_to_Client_INTEGER (Client_id, buf, n, Client_rank, tag, ierr)
254      IMPLICIT     none
255      INTEGER, INTENT(IN)                       :: Client_id
256      INTEGER, DIMENSION(:), INTENT(IN)         :: buf
257      INTEGER, INTENT(IN)                       :: n
258      INTEGER, INTENT(IN)                       :: Client_rank
259      INTEGER, INTENT(IN)                       :: tag
260      INTEGER, INTENT(OUT)                      :: ierr
261
262      ierr = 0
263      CALL MPI_Send (buf, n, MPI_INTEGER, Client_rank, tag, m_to_client_comm(Client_id), ierr)
264
265      return
266   END SUBROUTINE  PMC_Send_to_Client_INTEGER
267
268   SUBROUTINE  PMC_Recv_from_Client_INTEGER (Client_id, buf, n, Client_rank, tag, ierr)
269      IMPLICIT     none
270      INTEGER, INTENT(IN)                       :: Client_id
271      INTEGER, DIMENSION(:), INTENT(INOUT)      :: buf
272      INTEGER, INTENT(IN)                       :: n
273      INTEGER, INTENT(IN)                       :: Client_rank
274      INTEGER, INTENT(IN)                       :: tag
275      INTEGER, INTENT(OUT)                      :: ierr
276
277      ierr = 0
278      CALL MPI_Recv (buf, n, MPI_INTEGER, Client_rank, tag, m_to_client_comm(Client_id), &
279         MPI_STATUS_IGNORE, ierr)
280
281      return
282   END SUBROUTINE  PMC_Recv_from_Client_INTEGER
283
284   SUBROUTINE  PMC_Recv_from_Client_INTEGER_2 (Client_id, buf, n, Client_rank, tag, ierr)
285      IMPLICIT     none
286      INTEGER, INTENT(IN)                       :: Client_id
287      INTEGER, DIMENSION(:,:), INTENT(OUT)      :: buf
288      INTEGER, INTENT(IN)                       :: n
289      INTEGER, INTENT(IN)                       :: Client_rank
290      INTEGER, INTENT(IN)                       :: tag
291      INTEGER, INTENT(OUT)                      :: ierr
292
293      ierr = 0
294      CALL MPI_Recv (buf, n, MPI_INTEGER, Client_rank, tag, m_to_client_comm(Client_id), &
295         MPI_STATUS_IGNORE, ierr)
296
297      return
298   END SUBROUTINE  PMC_Recv_from_Client_INTEGER_2
299
300   SUBROUTINE  PMC_Send_to_Client_real_r1 (Client_id, buf, n, Client_rank, tag, ierr)
[1779]301
[1762]302      IMPLICIT     none
303
[1779]304      INTEGER, INTENT(IN)                ::  Client_id
305      REAL(wp), DIMENSION(:), INTENT(IN) ::  buf
306      INTEGER, INTENT(IN)                ::  n
307      INTEGER, INTENT(IN)                ::  Client_rank
308      INTEGER, INTENT(IN)                ::  tag
309      INTEGER, INTENT(OUT)               ::  ierr
310
[1762]311      ierr = 0
[1779]312      CALL MPI_Send (buf, n, MPI_REAL, Client_rank, tag, m_to_client_comm(Client_id), &
[1762]313         ierr)
314
315      return
316   END SUBROUTINE  PMC_Send_to_Client_real_r1
317
318   SUBROUTINE  PMC_Recv_from_Client_real_r1 (Client_id, buf, n, Client_rank, tag, ierr)
[1779]319
[1762]320      IMPLICIT     none
321
[1779]322      INTEGER, INTENT(IN)                   ::  Client_id
323      REAL(wp), DIMENSION(:), INTENT(INOUT) ::  buf
324      INTEGER, INTENT(IN)                   ::  n
325      INTEGER, INTENT(IN)                   ::  Client_rank
326      INTEGER, INTENT(IN)                   ::  tag
327      INTEGER, INTENT(OUT)                  ::  ierr
328
[1762]329      ierr = 0
[1779]330      CALL MPI_Recv (buf, n, MPI_REAL, Client_rank, tag, m_to_client_comm(Client_id), &
[1762]331         MPI_STATUS_IGNORE, ierr)
332
333      return
334   END SUBROUTINE  PMC_Recv_from_Client_real_r1
335
336   SUBROUTINE  PMC_Send_to_Client_real_r2 (Client_id, buf, n, Client_rank, tag, ierr)
[1779]337
[1762]338      IMPLICIT     none
339
[1779]340      INTEGER, INTENT(IN)                  ::  Client_id
341      REAL(wp), DIMENSION(:,:), INTENT(IN) ::  buf
342      INTEGER, INTENT(IN)                  ::  n
343      INTEGER, INTENT(IN)                  ::  Client_rank
344      INTEGER, INTENT(IN)                  ::  tag
345      INTEGER, INTENT(OUT)                 ::  ierr
346
[1762]347      ierr = 0
[1779]348      CALL MPI_Send (buf, n, MPI_REAL, Client_rank, tag, m_to_client_comm(Client_id), &
[1762]349         ierr)
350
351      return
352   END SUBROUTINE  PMC_Send_to_Client_real_r2
353
354   SUBROUTINE  PMC_Recv_from_Client_real_r2 (Client_id, buf, n, Client_rank, tag, ierr)
[1779]355
[1762]356      IMPLICIT     none
357
[1779]358      INTEGER, INTENT(IN)                   ::  Client_id
359      REAL(wp), DIMENSION(:,:), INTENT(OUT) ::  buf
360      INTEGER, INTENT(IN)                   ::  n
361      INTEGER, INTENT(IN)                   ::  Client_rank
362      INTEGER, INTENT(IN)                   ::  tag
363      INTEGER, INTENT(OUT)                  ::  ierr
364
[1762]365      ierr = 0
[1779]366      CALL MPI_Recv (buf, n, MPI_REAL, Client_rank, tag, m_to_client_comm(Client_id), &
[1762]367         MPI_STATUS_IGNORE, ierr)
368
369      return
370   END SUBROUTINE  PMC_Recv_from_Client_real_r2
371
372   SUBROUTINE  PMC_Send_to_Client_real_r3 (Client_id, buf, n, Client_rank, tag, ierr)
[1779]373
[1762]374      IMPLICIT     none
375
[1779]376      INTEGER, INTENT(IN)                    ::  Client_id
377      REAL(wp), DIMENSION(:,:,:), INTENT(IN) ::  buf
378      INTEGER, INTENT(IN)                    ::  n
379      INTEGER, INTENT(IN)                    ::  Client_rank
380      INTEGER, INTENT(IN)                    ::  tag
381      INTEGER, INTENT(OUT)                   ::  ierr
382
[1762]383      ierr = 0
[1779]384      CALL MPI_Send (buf, n, MPI_REAL, Client_rank, tag, m_to_client_comm(Client_id), &
[1762]385         ierr)
386
387      return
388   END SUBROUTINE  PMC_Send_to_Client_real_r3
389
390   SUBROUTINE  PMC_Recv_from_Client_real_r3 (Client_id, buf, n, Client_rank, tag, ierr)
[1779]391
[1762]392      IMPLICIT     none
393
[1779]394      INTEGER, INTENT(IN)                     ::  Client_id
395      REAL(wp), DIMENSION(:,:,:), INTENT(OUT) ::  buf
396      INTEGER, INTENT(IN)                     :: n
397      INTEGER, INTENT(IN)                     :: Client_rank
398      INTEGER, INTENT(IN)                     :: tag
399      INTEGER, INTENT(OUT)                    :: ierr
400
[1762]401      ierr = 0
[1779]402      CALL MPI_Recv (buf, n, MPI_REAL, Client_rank, tag, m_to_client_comm(Client_id), &
[1762]403         MPI_STATUS_IGNORE, ierr)
404
405      return
406   END SUBROUTINE  PMC_Recv_from_Client_real_r3
407
408   SUBROUTINE  PMC_Bcast_INTEGER (buf, root_pe, comm, ierr)
409      IMPLICIT     none
410      INTEGER, INTENT(INOUT)                      :: buf
411      INTEGER, INTENT(IN)                         :: root_pe
412      INTEGER, INTENT(IN),optional                :: comm
413      INTEGER, INTENT(OUT),optional               :: ierr
414      !-- local variables
415      INTEGER                                     :: myComm
416      INTEGER                                     :: myErr
417
418      if(present (comm))  then
419         myComm = comm
420      else
421         myComm = m_model_comm
422      end if
423
424      CALL MPI_Bcast (buf, 1, MPI_INTEGER, root_pe, myComm, myErr)
425
426      if(present (ierr))  then
427         ierr = myErr
428      end if
429
430      return
431   END SUBROUTINE  PMC_Bcast_INTEGER
432
433   SUBROUTINE  PMC_Bcast_character (buf, root_pe, comm, ierr)
434      IMPLICIT     none
435      character(len=*), INTENT(INOUT)             :: buf
436      INTEGER, INTENT(IN)                         :: root_pe
437      INTEGER, INTENT(IN),optional                :: comm
438      INTEGER, INTENT(OUT),optional               :: ierr
439      !-- local variables
440      INTEGER                                     :: myComm
441      INTEGER                                     :: myErr
442
443      if(present (comm))  then
444         myComm = comm
445      else
446         myComm = m_model_comm
447      end if
448
449      CALL MPI_Bcast (buf, len(buf), MPI_Character, root_pe, myComm, myErr)
450
451      if(present (ierr))  then
452         ierr = myErr
453      end if
454
455      return
456   END SUBROUTINE  PMC_Bcast_character
457
458   SUBROUTINE  PMC_Inter_Bcast_INTEGER_1 (buf, Client_id, ierr)
459      IMPLICIT     none
460      INTEGER, INTENT(INOUT),DIMENSION(:)         :: buf
461      INTEGER, INTENT(IN),optional                :: Client_id
462      INTEGER, INTENT(OUT),optional               :: ierr
463      !-- local variables
464      INTEGER                                     :: myComm
465      INTEGER                                     :: myErr
466      INTEGER                                     :: root_pe
467
468      !   PE 0 Server Broadcast to all Client PE's
469
470      if(present (Client_id))  then
471         myComm  = m_to_client_comm(Client_id)
472         if(m_model_rank == 0)  then
473            root_pe = MPI_ROOT
474         else
475            root_pe = MPI_PROC_NULL
476         end if
477      else
478         myComm  = m_to_server_comm
479         root_pe = 0
480      end if
481
482      CALL MPI_Bcast (buf, size(buf), MPI_INTEGER, root_pe, myComm, myErr)
483
484      if(present (ierr))  then
485         ierr = myErr
486      end if
487
488      return
489   END SUBROUTINE  PMC_Inter_Bcast_INTEGER_1
490
491!  Allocate  Memory with MPI_Alloc_mem using intermediate C-pointer
492
493   SUBROUTINE  PMC_Alloc_mem_INTEGER_1 (iarray, idim1)
494      IMPLICIT     none
495      INTEGER,DIMENSION(:),POINTER,INTENT(INOUT) :: iarray
496      INTEGER,INTENT(IN)                         :: idim1
497
498      Type(c_ptr)                             :: p_myInd
499      INTEGER,DIMENSION(1)                    :: aShape
500      INTEGER(KIND=MPI_ADDRESS_KIND)          :: WinSize
501      INTEGER                                 :: ierr
502
503      WinSize = idim1*c_sizeof(ierr)                          ! Length of INTEGER
504
505      CALL MPI_Alloc_mem  (WinSize , MPI_INFO_NULL, p_myInd, ierr);
506      aShape(1) = idim1
507      CALL c_f_pointer(p_myInd,iarray,aShape)
508
509      return
510   END SUBROUTINE  PMC_Alloc_mem_INTEGER_1
511
512   SUBROUTINE  PMC_Alloc_mem_Real_1 (array, idim1, base_ptr)
513      IMPLICIT     none
514      REAL(kind=wp),DIMENSION(:),POINTER,INTENT(INOUT) :: array
[1764]515      INTEGER(idp),INTENT(IN)                          :: idim1
[1762]516      Type(c_ptr),INTENT(OUT),optional                 :: base_ptr
517
518
519      Type(c_ptr)                             :: p_myInd
520      INTEGER,DIMENSION(1)                    :: aShape
521      INTEGER(KIND=MPI_ADDRESS_KIND)          :: WinSize
522      INTEGER                                 :: ierr
523
524      WinSize = idim1*wp                          ! Length of INTEGER
525
526      CALL MPI_Alloc_mem  (WinSize , MPI_INFO_NULL, p_myInd, ierr);
527      aShape(1) = idim1
528      CALL c_f_pointer(p_myInd,array,aShape)
529
530      if(present(base_ptr))   then
531         base_ptr = p_myInd
532      end if
533
534      return
535   END SUBROUTINE  PMC_Alloc_mem_Real_1
536
537   FUNCTION PMC_TIME ()
538      REAL(kind=wp)          :: PMC_TIME
539
540      PMC_TIME = MPI_Wtime ()
541
542      return
543
544    END FUNCTION PMC_TIME
545
[1764]546#endif
[1762]547 END MODULE pmc_mpi_wrapper
Note: See TracBrowser for help on using the repository browser.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |