Context Navigation

mod_phys_lmdz_omp_transfert.F90 @ 3888

Last change on this file since 3888 was 3888, checked in by emillour, 4 months ago
Common physics: Update, following what is done for the Earth LMDZ6 GCM, of the way some OpenMP transfers are done (less memory-hungry). EM
File size: 25.7 KB

Line
1	!
2	!$Header$
3	!
4	MODULE mod_phys_lmdz_omp_transfert
5
6	PRIVATE
7
8	REAL,PARAMETER :: grow_factor=1.5
9	INTEGER,PARAMETER :: size_min=1024
10
11	CHARACTER(LEN=size_min),SAVE :: buffer_c
12	! INTEGER,SAVE :: size_c=0
13	INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: buffer_i
14	INTEGER,SAVE :: size_i=0
15	REAL,SAVE,ALLOCATABLE,DIMENSION(:) :: buffer_r
16	INTEGER,SAVE :: size_r=0
17	LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: buffer_l
18	INTEGER,SAVE :: size_l=0
19
20
21
22
23	INTERFACE bcast_omp
24	MODULE PROCEDURE bcast_omp_c, &
25	bcast_omp_i,bcast_omp_i1,bcast_omp_i2,bcast_omp_i3,bcast_omp_i4,bcast_omp_i5,bcast_omp_i6, &
26	bcast_omp_r,bcast_omp_r1,bcast_omp_r2,bcast_omp_r3,bcast_omp_r4,bcast_omp_r5,bcast_omp_r6, &
27	bcast_omp_l,bcast_omp_l1,bcast_omp_l2,bcast_omp_l3,bcast_omp_l4,bcast_omp_l5,bcast_omp_l6
28	END INTERFACE
29
30	INTERFACE scatter_omp
31	MODULE PROCEDURE scatter_omp_i,scatter_omp_i1,scatter_omp_i2,scatter_omp_i3, &
32	scatter_omp_r,scatter_omp_r1,scatter_omp_r2,scatter_omp_r3, &
33	scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3
34	END INTERFACE
35
36
37	INTERFACE gather_omp
38	MODULE PROCEDURE gather_omp_i,gather_omp_i1,gather_omp_i2,gather_omp_i3, &
39	gather_omp_r,gather_omp_r1,gather_omp_r2,gather_omp_r3, &
40	gather_omp_l,gather_omp_l1,gather_omp_l2,gather_omp_l3
41	END INTERFACE
42
43
44	INTERFACE reduce_sum_omp
45	MODULE PROCEDURE reduce_sum_omp_i,reduce_sum_omp_i1,reduce_sum_omp_i2,reduce_sum_omp_i3,reduce_sum_omp_i4, &
46	reduce_sum_omp_r,reduce_sum_omp_r1,reduce_sum_omp_r2,reduce_sum_omp_r3,reduce_sum_omp_r4
47	END INTERFACE
48
49
50	PUBLIC bcast_omp,scatter_omp,gather_omp,reduce_sum_omp, omp_barrier
51
52	CONTAINS
53
54	SUBROUTINE omp_barrier
55	IMPLICIT NONE
56
57	!$OMP BARRIER
58
59	END SUBROUTINE omp_barrier
60
61	SUBROUTINE check_buffer_i(buff_size)
62	IMPLICIT NONE
63	INTEGER :: buff_size
64
65	!$OMP BARRIER
66	!$OMP MASTER
67	IF (buff_size>size_i) THEN
68	IF (ALLOCATED(buffer_i)) DEALLOCATE(buffer_i)
69	size_i=MAX(size_min,INT(grow_factor*buff_size))
70	ALLOCATE(buffer_i(size_i))
71	ENDIF
72	!$OMP END MASTER
73	!$OMP BARRIER
74
75	END SUBROUTINE check_buffer_i
76
77	SUBROUTINE check_buffer_r(buff_size)
78	IMPLICIT NONE
79	INTEGER :: buff_size
80
81	!$OMP BARRIER
82	!$OMP MASTER
83	IF (buff_size>size_r) THEN
84	IF (ALLOCATED(buffer_r)) DEALLOCATE(buffer_r)
85	size_r=MAX(size_min,INT(grow_factor*buff_size))
86	ALLOCATE(buffer_r(size_r))
87	ENDIF
88	!$OMP END MASTER
89	!$OMP BARRIER
90
91	END SUBROUTINE check_buffer_r
92
93	SUBROUTINE check_buffer_l(buff_size)
94	IMPLICIT NONE
95	INTEGER :: buff_size
96
97	!$OMP BARRIER
98	! Ehouarn: weirdly enough, despite the BARRIER above and after
99	! tests in debug show that if the task is done by the MASTER
100	! sometimes the buffer is not allocated (yet) but used by threads
101	! whereas things go more smoothly if the task is done via SINGLE
102	!$OMP SINGLE
103	IF (buff_size>size_l) THEN
104	IF (ALLOCATED(buffer_l)) DEALLOCATE(buffer_l)
105	size_l=MAX(size_min,INT(grow_factor*buff_size))
106	ALLOCATE(buffer_l(size_l))
107	ENDIF
108	!$OMP END SINGLE
109	!$OMP BARRIER
110
111	END SUBROUTINE check_buffer_l
112
113	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
114	!! Definition of Broadcasts --> 4D !!
115	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
116
117	!! -- For strings -- !!
118
119	SUBROUTINE bcast_omp_c(var)
120	IMPLICIT NONE
121	CHARACTER(LEN=*),INTENT(INOUT) :: Var
122
123	CALL bcast_omp_cgen(Var,len(Var),buffer_c)
124
125	END SUBROUTINE bcast_omp_c
126
127	!! -- For integers -- !!
128
129	SUBROUTINE bcast_omp_i(var)
130	IMPLICIT NONE
131	INTEGER,INTENT(INOUT) :: Var
132	INTEGER :: Var_tmp(1)
133
134	Var_tmp(1)=Var
135	CALL check_buffer_i(1)
136	CALL bcast_omp_igen(Var_tmp,1,buffer_i)
137	Var=Var_tmp(1)
138
139	END SUBROUTINE bcast_omp_i
140
141
142	SUBROUTINE bcast_omp_i1(var)
143	IMPLICIT NONE
144	INTEGER,INTENT(INOUT) :: Var(:)
145
146	CALL check_buffer_i(size(Var))
147	CALL bcast_omp_igen(Var,size(Var),buffer_i)
148
149	END SUBROUTINE bcast_omp_i1
150
151
152	SUBROUTINE bcast_omp_i2(var)
153	IMPLICIT NONE
154	INTEGER,INTENT(INOUT) :: Var(:,:)
155
156	CALL check_buffer_i(size(Var))
157	CALL bcast_omp_igen(Var,size(Var),buffer_i)
158
159	END SUBROUTINE bcast_omp_i2
160
161
162	SUBROUTINE bcast_omp_i3(var)
163	IMPLICIT NONE
164	INTEGER,INTENT(INOUT) :: Var(:,:,:)
165
166	CALL check_buffer_i(size(Var))
167	CALL bcast_omp_igen(Var,size(Var),buffer_i)
168
169	END SUBROUTINE bcast_omp_i3
170
171
172	SUBROUTINE bcast_omp_i4(var)
173	IMPLICIT NONE
174	INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
175
176	CALL check_buffer_i(size(Var))
177	CALL bcast_omp_igen(Var,size(Var),buffer_i)
178
179	END SUBROUTINE bcast_omp_i4
180
181
182	SUBROUTINE bcast_omp_i5(var)
183	IMPLICIT NONE
184	INTEGER,INTENT(INOUT) :: Var(:,:,:,:,:)
185
186	CALL check_buffer_i(size(Var))
187	CALL bcast_omp_igen(Var,size(Var),buffer_i)
188
189	END SUBROUTINE bcast_omp_i5
190
191
192	SUBROUTINE bcast_omp_i6(var)
193	IMPLICIT NONE
194	INTEGER,INTENT(INOUT) :: Var(:,:,:,:,:,:)
195
196	CALL check_buffer_i(size(Var))
197	CALL bcast_omp_igen(Var,size(Var),buffer_i)
198
199	END SUBROUTINE bcast_omp_i6
200
201
202	!! -- For reals -- !!
203
204	SUBROUTINE bcast_omp_r(var)
205	IMPLICIT NONE
206	REAL,INTENT(INOUT) :: Var
207	REAL :: Var_tmp(1)
208
209	Var_tmp(1)=Var
210	CALL check_buffer_r(1)
211	CALL bcast_omp_rgen(Var_tmp,1,buffer_r)
212	Var=Var_tmp(1)
213
214	END SUBROUTINE bcast_omp_r
215
216
217	SUBROUTINE bcast_omp_r1(var)
218	IMPLICIT NONE
219	REAL,INTENT(INOUT) :: Var(:)
220
221	CALL check_buffer_r(size(Var))
222	CALL bcast_omp_rgen(Var,size(Var),buffer_r)
223
224	END SUBROUTINE bcast_omp_r1
225
226
227	SUBROUTINE bcast_omp_r2(var)
228	IMPLICIT NONE
229	REAL,INTENT(INOUT) :: Var(:,:)
230
231	CALL check_buffer_r(size(Var))
232	CALL bcast_omp_rgen(Var,size(Var),buffer_r)
233
234	END SUBROUTINE bcast_omp_r2
235
236
237	SUBROUTINE bcast_omp_r3(var)
238	IMPLICIT NONE
239	REAL,INTENT(INOUT) :: Var(:,:,:)
240
241	CALL check_buffer_r(size(Var))
242	CALL bcast_omp_rgen(Var,size(Var),buffer_r)
243
244	END SUBROUTINE bcast_omp_r3
245
246
247	SUBROUTINE bcast_omp_r4(var)
248	IMPLICIT NONE
249	REAL,INTENT(INOUT) :: Var(:,:,:,:)
250
251	CALL check_buffer_r(size(Var))
252	CALL bcast_omp_rgen(Var,size(Var),buffer_r)
253
254	END SUBROUTINE bcast_omp_r4
255
256
257	SUBROUTINE bcast_omp_r5(var)
258	IMPLICIT NONE
259	REAL,INTENT(INOUT) :: Var(:,:,:,:,:)
260
261	CALL check_buffer_r(size(Var))
262	CALL bcast_omp_rgen(Var,size(Var),buffer_r)
263
264	END SUBROUTINE bcast_omp_r5
265
266
267	SUBROUTINE bcast_omp_r6(var)
268	IMPLICIT NONE
269	REAL,INTENT(INOUT) :: Var(:,:,:,:,:,:)
270
271	CALL check_buffer_r(size(Var))
272	CALL bcast_omp_rgen(Var,size(Var),buffer_r)
273
274	END SUBROUTINE bcast_omp_r6
275
276
277	!! -- For logicals -- !!
278
279	SUBROUTINE bcast_omp_l(var)
280	IMPLICIT NONE
281	LOGICAL,INTENT(INOUT) :: Var
282	LOGICAL :: Var_tmp(1)
283
284	Var_tmp(1)=Var
285	CALL check_buffer_l(1)
286	CALL bcast_omp_lgen(Var_tmp,1,buffer_l)
287	Var=Var_tmp(1)
288
289	END SUBROUTINE bcast_omp_l
290
291
292	SUBROUTINE bcast_omp_l1(var)
293	IMPLICIT NONE
294	LOGICAL,INTENT(INOUT) :: Var(:)
295
296	CALL check_buffer_l(size(Var))
297	CALL bcast_omp_lgen(Var,size(Var),buffer_l)
298
299	END SUBROUTINE bcast_omp_l1
300
301
302	SUBROUTINE bcast_omp_l2(var)
303	IMPLICIT NONE
304	LOGICAL,INTENT(INOUT) :: Var(:,:)
305
306	CALL check_buffer_l(size(Var))
307	CALL bcast_omp_lgen(Var,size(Var),buffer_l)
308
309	END SUBROUTINE bcast_omp_l2
310
311
312	SUBROUTINE bcast_omp_l3(var)
313	IMPLICIT NONE
314	LOGICAL,INTENT(INOUT) :: Var(:,:,:)
315
316	CALL check_buffer_l(size(Var))
317	CALL bcast_omp_lgen(Var,size(Var),buffer_l)
318
319	END SUBROUTINE bcast_omp_l3
320
321
322	SUBROUTINE bcast_omp_l4(var)
323	IMPLICIT NONE
324	LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
325
326	CALL check_buffer_l(size(Var))
327	CALL bcast_omp_lgen(Var,size(Var),buffer_l)
328
329	END SUBROUTINE bcast_omp_l4
330
331
332	SUBROUTINE bcast_omp_l5(var)
333	IMPLICIT NONE
334	LOGICAL,INTENT(INOUT) :: Var(:,:,:,:,:)
335
336	CALL check_buffer_l(size(Var))
337	CALL bcast_omp_lgen(Var,size(Var),buffer_l)
338
339	END SUBROUTINE bcast_omp_l5
340
341
342	SUBROUTINE bcast_omp_l6(var)
343	IMPLICIT NONE
344	LOGICAL,INTENT(INOUT) :: Var(:,:,:,:,:,:)
345
346	CALL check_buffer_l(size(Var))
347	CALL bcast_omp_lgen(Var,size(Var),buffer_l)
348
349	END SUBROUTINE bcast_omp_l6
350
351
352	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
353	!! Definition for Scatter --> 4D !!
354	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
355
356	SUBROUTINE scatter_omp_i(VarIn, VarOut)
357	IMPLICIT NONE
358
359	INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
360	INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
361
362	CALL Check_buffer_i(size(VarIn))
363	CALL scatter_omp_igen(VarIn,Varout,1,buffer_i)
364
365	END SUBROUTINE scatter_omp_i
366
367
368	SUBROUTINE scatter_omp_i1(VarIn, VarOut)
369	IMPLICIT NONE
370
371	INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
372	INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
373
374	CALL Check_buffer_i(size(VarIn))
375	CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2),buffer_i)
376
377	END SUBROUTINE scatter_omp_i1
378
379
380	SUBROUTINE scatter_omp_i2(VarIn, VarOut)
381	IMPLICIT NONE
382
383	INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
384	INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
385
386	CALL Check_buffer_i(size(VarIn))
387	CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_i)
388
389	END SUBROUTINE scatter_omp_i2
390
391
392	SUBROUTINE scatter_omp_i3(VarIn, VarOut)
393	IMPLICIT NONE
394
395	INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
396	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
397
398	CALL Check_buffer_i(size(VarIn))
399	CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)Size(VarOut,3)Size(VarOut,4),buffer_i)
400
401	END SUBROUTINE scatter_omp_i3
402
403
404
405
406	SUBROUTINE scatter_omp_r(VarIn, VarOut)
407	IMPLICIT NONE
408
409	REAL,INTENT(IN),DIMENSION(:) :: VarIn
410	REAL,INTENT(OUT),DIMENSION(:) :: VarOut
411
412	CALL Check_buffer_r(size(VarIn))
413	CALL scatter_omp_rgen(VarIn,Varout,1,buffer_r)
414
415	END SUBROUTINE scatter_omp_r
416
417
418	SUBROUTINE scatter_omp_r1(VarIn, VarOut)
419	IMPLICIT NONE
420
421	REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
422	REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
423
424	CALL Check_buffer_r(size(VarIn))
425	CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2),buffer_r)
426
427	END SUBROUTINE scatter_omp_r1
428
429
430	SUBROUTINE scatter_omp_r2(VarIn, VarOut)
431	IMPLICIT NONE
432
433	REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
434	REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
435
436	CALL Check_buffer_r(size(VarIn))
437	CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_r)
438
439	END SUBROUTINE scatter_omp_r2
440
441
442	SUBROUTINE scatter_omp_r3(VarIn, VarOut)
443	IMPLICIT NONE
444
445	REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
446	REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
447
448	CALL Check_buffer_r(size(VarIn))
449	CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)Size(VarOut,3)Size(VarOut,4),buffer_r)
450
451	END SUBROUTINE scatter_omp_r3
452
453
454
455	SUBROUTINE scatter_omp_l(VarIn, VarOut)
456	IMPLICIT NONE
457
458	LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
459	LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
460
461	CALL Check_buffer_l(size(VarIn))
462	CALL scatter_omp_lgen(VarIn,Varout,1,buffer_l)
463
464	END SUBROUTINE scatter_omp_l
465
466
467	SUBROUTINE scatter_omp_l1(VarIn, VarOut)
468	IMPLICIT NONE
469
470	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
471	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
472
473	CALL Check_buffer_l(size(VarIn))
474	CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2),buffer_l)
475
476	END SUBROUTINE scatter_omp_l1
477
478
479	SUBROUTINE scatter_omp_l2(VarIn, VarOut)
480	IMPLICIT NONE
481
482	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
483	LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
484
485	CALL Check_buffer_l(size(VarIn))
486	CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_l)
487
488	END SUBROUTINE scatter_omp_l2
489
490
491	SUBROUTINE scatter_omp_l3(VarIn, VarOut)
492	IMPLICIT NONE
493
494	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
495	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
496
497	CALL Check_buffer_l(size(VarIn))
498	CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)Size(VarOut,3)Size(VarOut,4),buffer_l)
499
500	END SUBROUTINE scatter_omp_l3
501
502
503	SUBROUTINE gather_omp_i(VarIn, VarOut)
504	IMPLICIT NONE
505
506	INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
507	INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
508
509	CALL Check_buffer_i(size(VarOut))
510	CALL gather_omp_igen(VarIn,Varout,1,buffer_i)
511
512	END SUBROUTINE gather_omp_i
513
514
515	SUBROUTINE gather_omp_i1(VarIn, VarOut)
516	IMPLICIT NONE
517
518	INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
519	INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
520
521	CALL Check_buffer_i(size(VarOut))
522	CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2),buffer_i)
523
524	END SUBROUTINE gather_omp_i1
525
526
527	SUBROUTINE gather_omp_i2(VarIn, VarOut)
528	IMPLICIT NONE
529
530	INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
531	INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
532
533	CALL Check_buffer_i(size(VarOut))
534	CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_i)
535
536	END SUBROUTINE gather_omp_i2
537
538
539	SUBROUTINE gather_omp_i3(VarIn, VarOut)
540	IMPLICIT NONE
541
542	INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
543	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
544
545	CALL Check_buffer_i(size(VarOut))
546	CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)Size(VarIn,3)Size(VarIn,4),buffer_i)
547
548	END SUBROUTINE gather_omp_i3
549
550
551
552	SUBROUTINE gather_omp_r(VarIn, VarOut)
553	IMPLICIT NONE
554
555	REAL,INTENT(IN),DIMENSION(:) :: VarIn
556	REAL,INTENT(OUT),DIMENSION(:) :: VarOut
557
558	CALL Check_buffer_r(size(VarOut))
559	CALL gather_omp_rgen(VarIn,Varout,1)
560
561	END SUBROUTINE gather_omp_r
562
563
564	SUBROUTINE gather_omp_r1(VarIn, VarOut)
565	IMPLICIT NONE
566
567	REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
568	REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
569
570	CALL Check_buffer_r(size(VarOut))
571	CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2))
572
573	END SUBROUTINE gather_omp_r1
574
575
576	SUBROUTINE gather_omp_r2(VarIn, VarOut)
577	IMPLICIT NONE
578
579	REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
580	REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
581
582	CALL Check_buffer_r(size(VarOut))
583	CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3))
584
585	END SUBROUTINE gather_omp_r2
586
587
588	SUBROUTINE gather_omp_r3(VarIn, VarOut)
589	IMPLICIT NONE
590
591	REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
592	REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
593
594	CALL Check_buffer_r(size(VarOut))
595	CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)Size(VarIn,3)Size(VarIn,4))
596
597	END SUBROUTINE gather_omp_r3
598
599
600	SUBROUTINE gather_omp_l(VarIn, VarOut)
601	IMPLICIT NONE
602
603	LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
604	LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
605
606	CALL Check_buffer_l(size(VarOut))
607	CALL gather_omp_lgen(VarIn,Varout,1,buffer_l)
608
609	END SUBROUTINE gather_omp_l
610
611
612	SUBROUTINE gather_omp_l1(VarIn, VarOut)
613	IMPLICIT NONE
614
615	LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
616	LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
617
618	CALL Check_buffer_l(size(VarOut))
619	CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2),buffer_l)
620
621	END SUBROUTINE gather_omp_l1
622
623
624	SUBROUTINE gather_omp_l2(VarIn, VarOut)
625	IMPLICIT NONE
626
627	LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
628	LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
629
630	CALL Check_buffer_l(size(VarOut))
631	CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_l)
632
633	END SUBROUTINE gather_omp_l2
634
635
636	SUBROUTINE gather_omp_l3(VarIn, VarOut)
637	IMPLICIT NONE
638
639	LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
640	LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
641
642	CALL Check_buffer_l(size(VarOut))
643	CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)Size(VarIn,3)Size(VarIn,4),buffer_l)
644
645	END SUBROUTINE gather_omp_l3
646
647
648
649
650	SUBROUTINE reduce_sum_omp_i(VarIn, VarOut)
651	IMPLICIT NONE
652
653	INTEGER,INTENT(IN) :: VarIn
654	INTEGER,INTENT(OUT) :: VarOut
655	INTEGER :: VarIn_tmp(1)
656	INTEGER :: VarOut_tmp(1)
657
658	VarIn_tmp(1)=VarIn
659	CALL Check_buffer_i(1)
660	CALL reduce_sum_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i)
661	VarOut=VarOut_tmp(1)
662
663	END SUBROUTINE reduce_sum_omp_i
664
665	SUBROUTINE reduce_sum_omp_i1(VarIn, VarOut)
666	IMPLICIT NONE
667
668	INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
669	INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
670
671	CALL Check_buffer_i(size(VarIn))
672	CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
673
674	END SUBROUTINE reduce_sum_omp_i1
675
676
677	SUBROUTINE reduce_sum_omp_i2(VarIn, VarOut)
678	IMPLICIT NONE
679
680	INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
681	INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
682
683	CALL Check_buffer_i(size(VarIn))
684	CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
685
686	END SUBROUTINE reduce_sum_omp_i2
687
688
689	SUBROUTINE reduce_sum_omp_i3(VarIn, VarOut)
690	IMPLICIT NONE
691
692	INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
693	INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
694
695	CALL Check_buffer_i(size(VarIn))
696	CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
697
698	END SUBROUTINE reduce_sum_omp_i3
699
700
701	SUBROUTINE reduce_sum_omp_i4(VarIn, VarOut)
702	IMPLICIT NONE
703
704	INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
705	INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
706
707	CALL Check_buffer_i(size(VarIn))
708	CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
709
710	END SUBROUTINE reduce_sum_omp_i4
711
712
713	SUBROUTINE reduce_sum_omp_r(VarIn, VarOut)
714	IMPLICIT NONE
715
716	REAL,INTENT(IN) :: VarIn
717	REAL,INTENT(OUT) :: VarOut
718	REAL :: VarIn_tmp(1)
719	REAL :: VarOut_tmp(1)
720
721	VarIn_tmp(1)=VarIn
722	CALL Check_buffer_r(1)
723	CALL reduce_sum_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r)
724	VarOut=VarOut_tmp(1)
725
726	END SUBROUTINE reduce_sum_omp_r
727
728	SUBROUTINE reduce_sum_omp_r1(VarIn, VarOut)
729	IMPLICIT NONE
730
731	REAL,INTENT(IN),DIMENSION(:) :: VarIn
732	REAL,INTENT(OUT),DIMENSION(:) :: VarOut
733
734	CALL Check_buffer_r(size(VarIn))
735	CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
736
737	END SUBROUTINE reduce_sum_omp_r1
738
739
740	SUBROUTINE reduce_sum_omp_r2(VarIn, VarOut)
741	IMPLICIT NONE
742
743	REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
744	REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
745
746	CALL Check_buffer_r(size(VarIn))
747	CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
748
749	END SUBROUTINE reduce_sum_omp_r2
750
751
752	SUBROUTINE reduce_sum_omp_r3(VarIn, VarOut)
753	IMPLICIT NONE
754
755	REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
756	REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
757
758	CALL Check_buffer_r(size(VarIn))
759	CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
760
761	END SUBROUTINE reduce_sum_omp_r3
762
763
764	SUBROUTINE reduce_sum_omp_r4(VarIn, VarOut)
765	IMPLICIT NONE
766
767	REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
768	REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
769
770	CALL Check_buffer_r(size(VarIn))
771	CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
772
773	END SUBROUTINE reduce_sum_omp_r4
774
775	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
776	! GENERIC ROUTINES !
777	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
778
779	SUBROUTINE bcast_omp_cgen(Var,Nb,Buff)
780	IMPLICIT NONE
781
782	CHARACTER(LEN=*),INTENT(INOUT) :: Var
783	CHARACTER(LEN=*),INTENT(INOUT) :: Buff
784	INTEGER,INTENT(IN) :: Nb
785
786	INTEGER :: i
787
788	!$OMP MASTER
789	Buff=Var
790	!$OMP END MASTER
791	!$OMP BARRIER
792
793	DO i=1,Nb
794	Var=Buff
795	ENDDO
796	!$OMP BARRIER
797
798	END SUBROUTINE bcast_omp_cgen
799
800
801
802	SUBROUTINE bcast_omp_igen(Var,Nb,Buff)
803	IMPLICIT NONE
804
805	INTEGER,INTENT(IN) :: Nb
806	INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
807	INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff
808
809	INTEGER :: i
810
811	!$OMP MASTER
812	DO i=1,Nb
813	Buff(i)=Var(i)
814	ENDDO
815	!$OMP END MASTER
816	!$OMP BARRIER
817
818	DO i=1,Nb
819	Var(i)=Buff(i)
820	ENDDO
821	!$OMP BARRIER
822
823	END SUBROUTINE bcast_omp_igen
824
825
826	SUBROUTINE bcast_omp_rgen(Var,Nb,Buff)
827	IMPLICIT NONE
828
829	INTEGER,INTENT(IN) :: Nb
830	REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
831	REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
832
833	INTEGER :: i
834
835	!$OMP MASTER
836	DO i=1,Nb
837	Buff(i)=Var(i)
838	ENDDO
839	!$OMP END MASTER
840	!$OMP BARRIER
841
842	DO i=1,Nb
843	Var(i)=Buff(i)
844	ENDDO
845	!$OMP BARRIER
846
847	END SUBROUTINE bcast_omp_rgen
848
849	SUBROUTINE bcast_omp_lgen(Var,Nb,Buff)
850	IMPLICIT NONE
851
852	INTEGER,INTENT(IN) :: Nb
853	LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
854	LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
855
856	INTEGER :: i
857
858	!$OMP MASTER
859	DO i=1,Nb
860	Buff(i)=Var(i)
861	ENDDO
862	!$OMP END MASTER
863	!$OMP BARRIER
864
865	DO i=1,Nb
866	Var(i)=Buff(i)
867	ENDDO
868	!$OMP BARRIER
869
870	END SUBROUTINE bcast_omp_lgen
871
872
873	SUBROUTINE scatter_omp_igen(VarIn,VarOut,dimsize,Buff)
874	USE mod_phys_lmdz_omp_data
875	USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
876	IMPLICIT NONE
877
878	INTEGER,INTENT(IN) :: dimsize
879	INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
880	INTEGER,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
881	INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
882
883	INTEGER :: i,ij
884
885	!$OMP MASTER
886	DO i=1,dimsize
887	DO ij=1,klon_mpi
888	Buff(ij,i)=VarIn(ij,i)
889	ENDDO
890	ENDDO
891	!$OMP END MASTER
892	!$OMP BARRIER
893
894	DO i=1,dimsize
895	DO ij=1,klon_omp
896	VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
897	ENDDO
898	ENDDO
899	!$OMP BARRIER
900
901	END SUBROUTINE scatter_omp_igen
902
903
904	SUBROUTINE scatter_omp_rgen(VarIn,VarOut,dimsize,Buff)
905	USE mod_phys_lmdz_omp_data
906	USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
907	IMPLICIT NONE
908
909	INTEGER,INTENT(IN) :: dimsize
910	REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
911	REAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
912	REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
913
914	INTEGER :: i,ij
915
916	!$OMP MASTER
917	DO i=1,dimsize
918	DO ij=1,klon_mpi
919	Buff(ij,i)=VarIn(ij,i)
920	ENDDO
921	ENDDO
922	!$OMP END MASTER
923	!$OMP BARRIER
924
925	DO i=1,dimsize
926	DO ij=1,klon_omp
927	VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
928	ENDDO
929	ENDDO
930	!$OMP BARRIER
931
932	END SUBROUTINE scatter_omp_rgen
933
934
935	SUBROUTINE scatter_omp_lgen(VarIn,VarOut,dimsize,Buff)
936	USE mod_phys_lmdz_omp_data
937	USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
938	IMPLICIT NONE
939
940	INTEGER,INTENT(IN) :: dimsize
941	LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
942	LOGICAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
943	LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
944
945	INTEGER :: i,ij
946
947	!$OMP MASTER
948	DO i=1,dimsize
949	DO ij=1,klon_mpi
950	Buff(ij,i)=VarIn(ij,i)
951	ENDDO
952	ENDDO
953	!$OMP END MASTER
954	!$OMP BARRIER
955
956	DO i=1,dimsize
957	DO ij=1,klon_omp
958	VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
959	ENDDO
960	ENDDO
961	!$OMP BARRIER
962
963	END SUBROUTINE scatter_omp_lgen
964
965
966
967
968
969	SUBROUTINE gather_omp_igen(VarIn,VarOut,dimsize,Buff)
970	USE mod_phys_lmdz_omp_data
971	USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
972	IMPLICIT NONE
973
974	INTEGER,INTENT(IN) :: dimsize
975	INTEGER,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
976	INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
977	INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
978
979	INTEGER :: i,ij
980
981	DO i=1,dimsize
982	DO ij=1,klon_omp
983	Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
984	ENDDO
985	ENDDO
986	!$OMP BARRIER
987
988
989	!$OMP MASTER
990	DO i=1,dimsize
991	DO ij=1,klon_mpi
992	VarOut(ij,i)=Buff(ij,i)
993	ENDDO
994	ENDDO
995	!$OMP END MASTER
996	!$OMP BARRIER
997
998	END SUBROUTINE gather_omp_igen
999
1000
1001	SUBROUTINE gather_omp_rgen(VarIn,VarOut,dimsize)
1002	USE mod_phys_lmdz_omp_data
1003	USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
1004	IMPLICIT NONE
1005
1006	INTEGER,INTENT(IN) :: dimsize
1007	REAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
1008	REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize),TARGET :: VarOut
1009
1010	REAL, POINTER, SAVE :: Varout_ptr(:,:) ! Shared between threads NOT THREADPRIVATE
1011
1012	INTEGER :: i,ij
1013
1014	!$OMP MASTER
1015	Varout_ptr => VarOut
1016	!$OMP END MASTER
1017	!$OMP BARRIER
1018
1019	DO i=1,dimsize
1020	DO ij=1,klon_omp
1021	Varout_ptr(klon_omp_begin-1+ij,i)=VarIn(ij,i)
1022	ENDDO
1023	ENDDO
1024	!$OMP BARRIER
1025
1026	END SUBROUTINE gather_omp_rgen
1027
1028
1029	SUBROUTINE gather_omp_lgen(VarIn,VarOut,dimsize,Buff)
1030	USE mod_phys_lmdz_omp_data
1031	USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
1032	IMPLICIT NONE
1033
1034	INTEGER,INTENT(IN) :: dimsize
1035	LOGICAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
1036	LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
1037	LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
1038
1039	INTEGER :: i,ij
1040
1041	DO i=1,dimsize
1042	DO ij=1,klon_omp
1043	Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
1044	ENDDO
1045	ENDDO
1046	!$OMP BARRIER
1047
1048
1049	!$OMP MASTER
1050	DO i=1,dimsize
1051	DO ij=1,klon_mpi
1052	VarOut(ij,i)=Buff(ij,i)
1053	ENDDO
1054	ENDDO
1055	!$OMP END MASTER
1056	!$OMP BARRIER
1057
1058	END SUBROUTINE gather_omp_lgen
1059
1060
1061	SUBROUTINE reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
1062	IMPLICIT NONE
1063
1064	INTEGER,INTENT(IN) :: dimsize
1065	INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
1066	INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
1067	INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
1068
1069	INTEGER :: i
1070
1071	!$OMP MASTER
1072	Buff(:)=0
1073	!$OMP END MASTER
1074	!$OMP BARRIER
1075
1076	!$OMP CRITICAL
1077	DO i=1,dimsize
1078	Buff(i)=Buff(i)+VarIn(i)
1079	ENDDO
1080	!$OMP END CRITICAL
1081	!$OMP BARRIER
1082
1083	!$OMP MASTER
1084	DO i=1,dimsize
1085	VarOut(i)=Buff(i)
1086	ENDDO
1087	!$OMP END MASTER
1088	!$OMP BARRIER
1089
1090	END SUBROUTINE reduce_sum_omp_igen
1091
1092	SUBROUTINE reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
1093	IMPLICIT NONE
1094
1095	INTEGER,INTENT(IN) :: dimsize
1096	REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
1097	REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
1098	REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
1099
1100	INTEGER :: i
1101
1102	!$OMP MASTER
1103	Buff(:)=0
1104	!$OMP END MASTER
1105	!$OMP BARRIER
1106
1107	!$OMP CRITICAL
1108	DO i=1,dimsize
1109	Buff(i)=Buff(i)+VarIn(i)
1110	ENDDO
1111	!$OMP END CRITICAL
1112	!$OMP BARRIER
1113
1114	!$OMP MASTER
1115	DO i=1,dimsize
1116	VarOut(i)=Buff(i)
1117	ENDDO
1118	!$OMP END MASTER
1119	!$OMP BARRIER
1120
1121	END SUBROUTINE reduce_sum_omp_rgen
1122
1123	END MODULE mod_phys_lmdz_omp_transfert

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

Download in other formats:

Original Format