Context Navigation

mod_phys_lmdz_omp_transfert.F90 @ 1373

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

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

Download in other formats:

Original Format