Home

Context Navigation

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

Last change on this file since 4180 was 4180, checked in by scharf, 5 years ago
removed comments in 'Former revisions' section that are older than 01.01.2019
Property svn:keywords set to `Id`
File size: 19.8 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-2019 Leibniz Universitaet Hannover
19	!------------------------------------------------------------------------------!
20	!
21	! Current revisions:
22	! ------------------
23	!
24	!
25	! Former revisions:
26	! -----------------
27	! $Id: pmc_mpi_wrapper_mod.f90 4180 2019-08-21 14:37:54Z scharf $
28	! Extent interface by logical buffer
29	!
30	!
31	! Description:
32	! ------------
33	!
34	! MPI Wrapper of Palm Model Coupler
35	!-------------------------------------------------------------------------------!
36
37	#if defined( __parallel )
38	USE, INTRINSIC :: ISO_C_BINDING
39
40	#if !defined( __mpifh )
41	USE MPI
42	#endif
43
44	USE kinds
45	USE pmc_handle_communicator, &
46	ONLY: m_model_comm, m_model_rank, m_to_parent_comm, m_to_child_comm
47
48	IMPLICIT NONE
49
50	#if defined( __mpifh )
51	INCLUDE "mpif.h"
52	#endif
53
54	PRIVATE
55	SAVE
56
57	INTERFACE pmc_send_to_parent
58	MODULE PROCEDURE pmc_send_to_parent_integer
59	MODULE PROCEDURE pmc_send_to_parent_integer_2
60	MODULE PROCEDURE pmc_send_to_parent_real_r1
61	MODULE PROCEDURE pmc_send_to_parent_real_r2
62	MODULE PROCEDURE pmc_send_to_parent_real_r3
63	END INTERFACE pmc_send_to_parent
64
65	INTERFACE pmc_recv_from_parent
66	MODULE PROCEDURE pmc_recv_from_parent_logical
67	MODULE PROCEDURE pmc_recv_from_parent_integer
68	MODULE PROCEDURE pmc_recv_from_parent_real_r1
69	MODULE PROCEDURE pmc_recv_from_parent_real_r2
70	MODULE PROCEDURE pmc_recv_from_parent_real_r3
71	END INTERFACE pmc_recv_from_parent
72
73	INTERFACE pmc_send_to_child
74	MODULE PROCEDURE pmc_send_to_child_logical
75	MODULE PROCEDURE pmc_send_to_child_integer
76	MODULE PROCEDURE pmc_send_to_child_real_r1
77	MODULE PROCEDURE pmc_send_to_child_real_r2
78	MODULE PROCEDURE pmc_send_to_child_real_r3
79	END INTERFACE pmc_send_to_child
80
81	INTERFACE pmc_recv_from_child
82	MODULE PROCEDURE pmc_recv_from_child_integer
83	MODULE PROCEDURE pmc_recv_from_child_integer_2
84	MODULE PROCEDURE pmc_recv_from_child_real_r1
85	MODULE PROCEDURE pmc_recv_from_child_real_r2
86	MODULE PROCEDURE pmc_recv_from_child_real_r3
87	END INTERFACE pmc_recv_from_child
88
89	INTERFACE pmc_bcast
90	MODULE PROCEDURE pmc_bcast_integer
91	MODULE PROCEDURE pmc_bcast_character
92	END INTERFACE pmc_bcast
93
94	INTERFACE pmc_inter_bcast
95	MODULE PROCEDURE pmc_inter_bcast_integer_1
96	END INTERFACE pmc_inter_bcast
97
98	INTERFACE pmc_alloc_mem
99	MODULE PROCEDURE pmc_alloc_mem_integer_1
100	MODULE PROCEDURE pmc_alloc_mem_Real_1
101	END INTERFACE pmc_alloc_mem
102
103	INTERFACE pmc_time
104	MODULE PROCEDURE pmc_time
105	END INTERFACE pmc_time
106
107	PUBLIC pmc_alloc_mem, pmc_bcast, pmc_inter_bcast, pmc_recv_from_child, &
108	pmc_recv_from_parent, pmc_send_to_child, pmc_send_to_parent, &
109	pmc_time
110
111	CONTAINS
112
113
114	SUBROUTINE pmc_recv_from_parent_logical( buf, n, parent_rank, tag, ierr )
115
116	IMPLICIT NONE
117
118	INTEGER, INTENT(IN) :: n !<
119	INTEGER, INTENT(IN) :: parent_rank !<
120	INTEGER, INTENT(IN) :: tag !<
121	INTEGER, INTENT(OUT) :: ierr !<
122
123	LOGICAL, INTENT(OUT) :: buf !<
124
125	ierr = 0
126	CALL MPI_RECV( buf, n, MPI_LOGICAL, parent_rank, tag, m_to_parent_comm, &
127	MPI_STATUS_IGNORE, ierr )
128
129	END SUBROUTINE pmc_recv_from_parent_logical
130
131	SUBROUTINE pmc_send_to_child_logical( child_id, buf, n, child_rank, tag, &
132	ierr )
133
134	IMPLICIT NONE
135
136	INTEGER, INTENT(IN) :: child_id !<
137	INTEGER, INTENT(IN) :: n !<
138	INTEGER, INTENT(IN) :: child_rank !<
139	INTEGER, INTENT(IN) :: tag !<
140	INTEGER, INTENT(OUT) :: ierr !<
141
142	LOGICAL, INTENT(IN) :: buf !<
143
144	ierr = 0
145	CALL MPI_SEND( buf, n, MPI_LOGICAL, child_rank, tag, &
146	m_to_child_comm(child_id), ierr )
147
148	END SUBROUTINE pmc_send_to_child_logical
149
150
151	SUBROUTINE pmc_send_to_parent_integer( buf, n, parent_rank, tag, ierr )
152
153	IMPLICIT NONE
154
155	INTEGER, DIMENSION(:), INTENT(IN) :: buf !<
156	INTEGER, INTENT(IN) :: n !<
157	INTEGER, INTENT(IN) :: parent_rank !<
158	INTEGER, INTENT(IN) :: tag !<
159	INTEGER, INTENT(OUT) :: ierr !<
160
161
162	ierr = 0
163	CALL MPI_SEND( buf, n, MPI_INTEGER, parent_rank, tag, m_to_parent_comm, &
164	ierr )
165
166	END SUBROUTINE pmc_send_to_parent_integer
167
168
169	SUBROUTINE pmc_recv_from_parent_integer( buf, n, parent_rank, tag, ierr )
170
171	IMPLICIT NONE
172
173	INTEGER, DIMENSION(:), INTENT(OUT) :: buf !<
174	INTEGER, INTENT(IN) :: n !<
175	INTEGER, INTENT(IN) :: parent_rank !<
176	INTEGER, INTENT(IN) :: tag !<
177	INTEGER, INTENT(OUT) :: ierr !<
178
179
180	ierr = 0
181	CALL MPI_RECV( buf, n, MPI_INTEGER, parent_rank, tag, m_to_parent_comm, &
182	MPI_STATUS_IGNORE, ierr )
183
184	END SUBROUTINE pmc_recv_from_parent_integer
185
186
187
188	SUBROUTINE pmc_send_to_parent_integer_2( buf, n, parent_rank, tag, ierr )
189
190	IMPLICIT NONE
191
192	INTEGER, DIMENSION(:,:), INTENT(IN) :: buf !<
193	INTEGER, INTENT(IN) :: n !<
194	INTEGER, INTENT(IN) :: parent_rank !<
195	INTEGER, INTENT(IN) :: tag !<
196	INTEGER, INTENT(OUT) :: ierr !<
197
198
199	ierr = 0
200	CALL MPI_SEND( buf, n, MPI_INTEGER, parent_rank, tag, m_to_parent_comm, &
201	ierr )
202
203	END SUBROUTINE pmc_send_to_parent_integer_2
204
205
206
207	SUBROUTINE pmc_send_to_parent_real_r1( buf, n, parent_rank, tag, ierr )
208
209	IMPLICIT NONE
210
211	REAL(wp), DIMENSION(:), INTENT(IN) :: buf !<
212	INTEGER, INTENT(IN) :: n !<
213	INTEGER, INTENT(IN) :: parent_rank !<
214	INTEGER, INTENT(IN) :: tag !<
215	INTEGER, INTENT(OUT) :: ierr !<
216
217
218	ierr = 0
219	CALL MPI_SEND( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm, ierr )
220
221	END SUBROUTINE pmc_send_to_parent_real_r1
222
223
224
225	SUBROUTINE pmc_recv_from_parent_real_r1( buf, n, parent_rank, tag, ierr )
226
227	IMPLICIT NONE
228
229	REAL(wp), DIMENSION(:), INTENT(OUT) :: buf !<
230	INTEGER, INTENT(IN) :: n !<
231	INTEGER, INTENT(IN) :: parent_rank !<
232	INTEGER, INTENT(IN) :: tag !<
233	INTEGER, INTENT(OUT) :: ierr !<
234
235
236	ierr = 0
237	CALL MPI_RECV( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm, &
238	MPI_STATUS_IGNORE, ierr )
239
240	END SUBROUTINE pmc_recv_from_parent_real_r1
241
242
243
244	SUBROUTINE pmc_send_to_parent_real_r2( buf, n, parent_rank, tag, ierr )
245
246	IMPLICIT NONE
247
248	REAL(wp), DIMENSION(:,:), INTENT(IN) :: buf !<
249	INTEGER, INTENT(IN) :: n !<
250	INTEGER, INTENT(IN) :: parent_rank !<
251	INTEGER, INTENT(IN) :: tag !<
252	INTEGER, INTENT(OUT) :: ierr !<
253
254
255	ierr = 0
256	CALL MPI_SEND( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm, ierr )
257
258	END SUBROUTINE pmc_send_to_parent_real_r2
259
260
261	SUBROUTINE pmc_recv_from_parent_real_r2( buf, n, parent_rank, tag, ierr )
262
263	IMPLICIT NONE
264
265	REAL(wp), DIMENSION(:,:), INTENT(OUT) :: buf !<
266	INTEGER, INTENT(IN) :: n !<
267	INTEGER, INTENT(IN) :: parent_rank !<
268	INTEGER, INTENT(IN) :: tag !<
269	INTEGER, INTENT(OUT) :: ierr !<
270
271	ierr = 0
272	CALL MPI_RECV( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm, &
273	MPI_STATUS_IGNORE, ierr )
274
275	END SUBROUTINE pmc_recv_from_parent_real_r2
276
277
278
279	SUBROUTINE pmc_send_to_parent_real_r3( buf, n, parent_rank, tag, ierr )
280
281	IMPLICIT NONE
282
283	REAL(wp), DIMENSION(:,:,:), INTENT(IN) :: buf !<
284	INTEGER, INTENT(IN) :: n !<
285	INTEGER, INTENT(IN) :: parent_rank !<
286	INTEGER, INTENT(IN) :: tag !<
287	INTEGER, INTENT(OUT) :: ierr !<
288
289
290	ierr = 0
291	CALL MPI_SEND( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm, ierr )
292
293	END SUBROUTINE pmc_send_to_parent_real_r3
294
295
296
297	SUBROUTINE pmc_recv_from_parent_real_r3( buf, n, parent_rank, tag, ierr )
298
299	IMPLICIT NONE
300
301	REAL(wp), DIMENSION(:,:,:), INTENT(OUT) :: buf !<
302	INTEGER, INTENT(IN) :: n !<
303	INTEGER, INTENT(IN) :: parent_rank !<
304	INTEGER, INTENT(IN) :: tag !<
305	INTEGER, INTENT(OUT) :: ierr !<
306
307
308	ierr = 0
309	CALL MPI_RECV( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm, &
310	MPI_STATUS_IGNORE, ierr )
311
312	END SUBROUTINE pmc_recv_from_parent_real_r3
313
314
315	SUBROUTINE pmc_send_to_child_integer( child_id, buf, n, child_rank, tag, &
316	ierr )
317
318	IMPLICIT NONE
319
320	INTEGER, INTENT(IN) :: child_id !<
321	INTEGER, DIMENSION(:), INTENT(IN) :: buf !<
322	INTEGER, INTENT(IN) :: n !<
323	INTEGER, INTENT(IN) :: child_rank !<
324	INTEGER, INTENT(IN) :: tag !<
325	INTEGER, INTENT(OUT) :: ierr !<
326
327
328	ierr = 0
329	CALL MPI_SEND( buf, n, MPI_INTEGER, child_rank, tag, &
330	m_to_child_comm(child_id), ierr )
331
332	END SUBROUTINE pmc_send_to_child_integer
333
334
335
336	SUBROUTINE pmc_recv_from_child_integer( child_id, buf, n, child_rank, tag, &
337	ierr )
338
339	IMPLICIT NONE
340
341	INTEGER, INTENT(IN) :: child_id !<
342	INTEGER, DIMENSION(:), INTENT(INOUT) :: buf !<
343	INTEGER, INTENT(IN) :: n !<
344	INTEGER, INTENT(IN) :: child_rank !<
345	INTEGER, INTENT(IN) :: tag !<
346	INTEGER, INTENT(OUT) :: ierr !<
347
348
349	ierr = 0
350	CALL MPI_RECV( buf, n, MPI_INTEGER, child_rank, tag, &
351	m_to_child_comm(child_id), MPI_STATUS_IGNORE, ierr )
352
353	END SUBROUTINE pmc_recv_from_child_integer
354
355
356
357	SUBROUTINE pmc_recv_from_child_integer_2( child_id, buf, n, child_rank, &
358	tag, ierr )
359
360	IMPLICIT NONE
361
362	INTEGER, INTENT(IN) :: child_id !<
363	INTEGER, DIMENSION(:,:), INTENT(OUT) :: buf !<
364	INTEGER, INTENT(IN) :: n !<
365	INTEGER, INTENT(IN) :: child_rank !<
366	INTEGER, INTENT(IN) :: tag !<
367	INTEGER, INTENT(OUT) :: ierr !<
368
369
370	ierr = 0
371	CALL MPI_RECV( buf, n, MPI_INTEGER, child_rank, tag, &
372	m_to_child_comm(child_id), MPI_STATUS_IGNORE, ierr )
373
374	END SUBROUTINE pmc_recv_from_child_integer_2
375
376
377
378	SUBROUTINE pmc_send_to_child_real_r1( child_id, buf, n, child_rank, tag, &
379	ierr )
380
381	IMPLICIT NONE
382
383	INTEGER, INTENT(IN) :: child_id !<
384	REAL(wp), DIMENSION(:), INTENT(IN) :: buf !<
385	INTEGER, INTENT(IN) :: n !<
386	INTEGER, INTENT(IN) :: child_rank !<
387	INTEGER, INTENT(IN) :: tag !<
388	INTEGER, INTENT(OUT) :: ierr !<
389
390
391	ierr = 0
392	CALL MPI_SEND( buf, n, MPI_REAL, child_rank, tag, &
393	m_to_child_comm(child_id), ierr )
394
395	END SUBROUTINE pmc_send_to_child_real_r1
396
397
398
399	SUBROUTINE pmc_recv_from_child_real_r1( child_id, buf, n, child_rank, tag, &
400	ierr )
401
402	IMPLICIT NONE
403
404	INTEGER, INTENT(IN) :: child_id !<
405	REAL(wp), DIMENSION(:), INTENT(INOUT) :: buf !<
406	INTEGER, INTENT(IN) :: n !<
407	INTEGER, INTENT(IN) :: child_rank !<
408	INTEGER, INTENT(IN) :: tag !<
409	INTEGER, INTENT(OUT) :: ierr !<
410
411
412	ierr = 0
413	CALL MPI_RECV( buf, n, MPI_REAL, child_rank, tag, &
414	m_to_child_comm(child_id), MPI_STATUS_IGNORE, ierr )
415
416	END SUBROUTINE pmc_recv_from_child_real_r1
417
418
419
420	SUBROUTINE pmc_send_to_child_real_r2( child_id, buf, n, child_rank, tag, &
421	ierr )
422
423	IMPLICIT NONE
424
425	INTEGER, INTENT(IN) :: child_id !<
426	REAL(wp), DIMENSION(:,:), INTENT(IN) :: buf !<
427	INTEGER, INTENT(IN) :: n !<
428	INTEGER, INTENT(IN) :: child_rank !<
429	INTEGER, INTENT(IN) :: tag !<
430	INTEGER, INTENT(OUT) :: ierr !<
431
432
433	ierr = 0
434	CALL MPI_SEND( buf, n, MPI_REAL, child_rank, tag, &
435	m_to_child_comm(child_id), ierr )
436
437	END SUBROUTINE pmc_send_to_child_real_r2
438
439
440
441	SUBROUTINE pmc_recv_from_child_real_r2( child_id, buf, n, child_rank, tag, &
442	ierr )
443
444	IMPLICIT NONE
445
446	INTEGER, INTENT(IN) :: child_id !<
447	REAL(wp), DIMENSION(:,:), INTENT(OUT) :: buf !<
448	INTEGER, INTENT(IN) :: n !<
449	INTEGER, INTENT(IN) :: child_rank !<
450	INTEGER, INTENT(IN) :: tag !<
451	INTEGER, INTENT(OUT) :: ierr !<
452
453
454	ierr = 0
455	CALL MPI_RECV( buf, n, MPI_REAL, child_rank, tag, &
456	m_to_child_comm(child_id), MPI_STATUS_IGNORE, ierr )
457
458	END SUBROUTINE pmc_recv_from_child_real_r2
459
460
461
462	SUBROUTINE pmc_send_to_child_real_r3( child_id, buf, n, child_rank, tag, &
463	ierr )
464
465	IMPLICIT NONE
466
467	INTEGER, INTENT(IN) :: child_id !<
468	REAL(wp), DIMENSION(:,:,:), INTENT(IN) :: buf !<
469	INTEGER, INTENT(IN) :: n !<
470	INTEGER, INTENT(IN) :: child_rank !<
471	INTEGER, INTENT(IN) :: tag !<
472	INTEGER, INTENT(OUT) :: ierr !<
473
474
475	ierr = 0
476	CALL MPI_SEND( buf, n, MPI_REAL, child_rank, tag, &
477	m_to_child_comm(child_id), ierr )
478
479	END SUBROUTINE pmc_send_to_child_real_r3
480
481
482
483	SUBROUTINE pmc_recv_from_child_real_r3( child_id, buf, n, child_rank, tag, &
484	ierr )
485
486	IMPLICIT NONE
487
488	INTEGER, INTENT(IN) :: child_id !<
489	REAL(wp), DIMENSION(:,:,:), INTENT(OUT) :: buf !<
490	INTEGER, INTENT(IN) :: n !<
491	INTEGER, INTENT(IN) :: child_rank !<
492	INTEGER, INTENT(IN) :: tag !<
493	INTEGER, INTENT(OUT) :: ierr !<
494
495
496	ierr = 0
497	CALL MPI_RECV( buf, n, MPI_REAL, child_rank, tag, &
498	m_to_child_comm(child_id), MPI_STATUS_IGNORE, ierr )
499
500	END SUBROUTINE pmc_recv_from_child_real_r3
501
502
503
504	SUBROUTINE pmc_bcast_integer( buf, root_pe, comm, ierr )
505
506	IMPLICIT NONE
507
508	INTEGER, INTENT(INOUT) :: buf !<
509	INTEGER, INTENT(IN) :: root_pe !<
510	INTEGER, INTENT(IN), OPTIONAL :: comm !<
511	INTEGER, INTENT(OUT), OPTIONAL :: ierr !<
512
513	INTEGER :: mycomm !<
514	INTEGER :: myerr !<
515
516
517	IF ( PRESENT( comm ) ) THEN
518	mycomm = comm
519	ELSE
520	mycomm = m_model_comm
521	ENDIF
522
523	CALL MPI_BCAST( buf, 1, MPI_INTEGER, root_pe, mycomm, myerr )
524
525	IF ( PRESENT( ierr ) ) THEN
526	ierr = myerr
527	ENDIF
528
529	END SUBROUTINE pmc_bcast_integer
530
531
532
533	SUBROUTINE pmc_bcast_character( buf, root_pe, comm, ierr )
534
535	IMPLICIT NONE
536
537	CHARACTER(LEN=*), INTENT(INOUT) :: buf !<
538	INTEGER, INTENT(IN) :: root_pe !<
539	INTEGER, INTENT(IN), OPTIONAL :: comm !<
540	INTEGER, INTENT(OUT), OPTIONAL :: ierr !<
541
542	INTEGER :: mycomm !<
543	INTEGER :: myerr !<
544
545
546	IF ( PRESENT( comm ) ) THEN
547	mycomm = comm
548	ELSE
549	mycomm = m_model_comm
550	ENDIF
551
552	CALL MPI_BCAST( buf, LEN(buf), MPI_CHARACTER, root_pe, mycomm, myerr )
553
554	IF ( PRESENT( ierr ) ) THEN
555	ierr = myerr
556	ENDIF
557
558	END SUBROUTINE pmc_bcast_character
559
560
561
562	SUBROUTINE pmc_inter_bcast_integer_1( buf, child_id, ierr )
563
564	IMPLICIT NONE
565
566	INTEGER, INTENT(INOUT),DIMENSION(:) :: buf !<
567	INTEGER, INTENT(IN),optional :: child_id !<
568	INTEGER, INTENT(OUT),optional :: ierr !<
569
570	INTEGER :: mycomm !<
571	INTEGER :: myerr !<
572	INTEGER :: root_pe !<
573
574	!
575	!-- Process 0 on parent broadcast to all child processes
576	IF ( PRESENT( child_id ) ) THEN
577
578	mycomm = m_to_child_comm(child_id)
579
580	IF ( m_model_rank == 0 ) THEN
581	root_pe = MPI_ROOT
582	ELSE
583	root_pe = MPI_PROC_NULL
584	ENDIF
585
586	ELSE
587	mycomm = m_to_parent_comm
588	root_pe = 0
589	ENDIF
590
591	CALL MPI_BCAST( buf, SIZE( buf ), MPI_INTEGER, root_pe, mycomm, myerr )
592
593	IF ( PRESENT( ierr ) ) THEN
594	ierr = myerr
595	ENDIF
596
597	END SUBROUTINE pmc_inter_bcast_integer_1
598
599
600
601	SUBROUTINE pmc_alloc_mem_integer_1( iarray, idim1 )
602	!
603	!-- Allocate memory with MPI_ALLOC_MEM using intermediate C-pointer
604
605	IMPLICIT NONE
606
607	INTEGER, DIMENSION(:), POINTER, INTENT(INOUT) :: iarray !<
608	INTEGER, INTENT(IN) :: idim1 !<
609
610	INTEGER, DIMENSION(1) :: ashape !<
611	INTEGER(KIND=MPI_ADDRESS_KIND) :: winsize !<
612	INTEGER :: ierr !<
613
614	TYPE(C_PTR) :: p_myind !<
615
616
617	winsize = idim1 * STORAGE_SIZE( ierr )/8
618
619	CALL MPI_ALLOC_MEM( winsize, MPI_INFO_NULL, p_myind, ierr )
620	ashape(1) = idim1
621	CALL C_F_POINTER( p_myind, iarray, ashape )
622
623	END SUBROUTINE pmc_alloc_mem_integer_1
624
625
626
627	SUBROUTINE pmc_alloc_mem_real_1( array, idim1, base_ptr )
628
629	IMPLICIT NONE
630
631	INTEGER(idp), INTENT(IN) :: idim1 !<
632	REAL(KIND=wp), DIMENSION(:), POINTER, INTENT(INOUT) :: array !<
633	TYPE(C_PTR), INTENT(OUT), OPTIONAL :: base_ptr !<
634
635	INTEGER, DIMENSION(1) :: ashape !<
636	INTEGER(KIND=MPI_ADDRESS_KIND) :: winsize !<
637	INTEGER :: ierr !<
638
639	TYPE(C_PTR) :: p_myind !<
640
641
642	winsize = idim1 * wp
643
644	CALL MPI_ALLOC_MEM( winsize , MPI_INFO_NULL, p_myind, ierr )
645	ashape(1) = idim1
646	CALL C_F_POINTER( p_myind, array, ashape )
647
648	IF ( PRESENT( base_ptr ) ) THEN
649	base_ptr = p_myind
650	ENDIF
651
652	END SUBROUTINE pmc_alloc_mem_Real_1
653
654
655
656	FUNCTION pmc_time()
657
658	REAL(kind=wp) :: pmc_time !<
659
660
661	pmc_time = MPI_WTIME()
662
663	END FUNCTION pmc_time
664
665	#endif
666	END MODULE pmc_mpi_wrapper

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |