Home

Context Navigation

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

Last change on this file since 2789 was 2718, checked in by maronga, 7 years ago
deleting of deprecated files; headers updated where needed
Property svn:keywords set to `Id`
File size: 19.3 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |