Context Navigation

mod_phys_lmdz_omp_transfert.F90 @ 5005

Last change on this file since 5005 was 1935, checked in by jghattas, 11 years ago
Merged bug corrections done in rev 1905 on the trunk. These corrections makes it possible to run in OpenMP mode coupled to ORCHIDEE.
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 24.2 KB

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

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

Download in other formats:

Original Format