Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |