Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |