Context Navigation

mod_hallo.F90 @ 5225

Last change on this file since 5225 was 5160, checked in by abarral, 3 months ago
Put .h into modules
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory
File size: 52.4 KB

Rev	Line
[1632]	1	module mod_Hallo
[5159]	2	USE parallel_lmdz
	3	IMPLICIT NONE
	4	logical, save :: use_mpi_alloc
	5	INTEGER, parameter :: MaxProc = 512
	6	INTEGER, parameter :: DefaultMaxBufferSize = 1024 * 1024 * 100
	7	INTEGER, SAVE :: MaxBufferSize = 0
	8	INTEGER, parameter :: ListSize = 1000
[1632]	9
[5159]	10	INTEGER, save :: MaxBufferSize_Used
	11	!$OMP THREADPRIVATE( MaxBufferSize_Used)
[1632]	12
[5159]	13	REAL, SAVE, pointer, DIMENSION(:) :: Buffer
	14	!$OMP THREADPRIVATE(Buffer)
	15
	16	INTEGER, SAVE, DIMENSION(Listsize) :: Buffer_Pos
	17	INTEGER, save :: Index_Pos
	18	!$OMP THREADPRIVATE(Buffer_Pos,Index_pos)
	19
[1632]	20	type Hallo
[5159]	21	REAL, DIMENSION(:, :), pointer :: Field
[5116]	22	INTEGER :: offset
	23	INTEGER :: size
	24	INTEGER :: NbLevel
	25	INTEGER :: Stride
[1632]	26	end type Hallo
[5159]	27
[1632]	28	type request_SR
[5159]	29	INTEGER :: NbRequest = 0
	30	INTEGER :: NbRequestMax = 0
[5116]	31	INTEGER :: BufferSize
	32	INTEGER :: Pos
	33	INTEGER :: Index
[1847]	34	type(Hallo), POINTER :: Hallo(:)
[5116]	35	INTEGER :: MSG_Request
[1632]	36	end type request_SR
	37
	38	type request
[5159]	39	type(request_SR), DIMENSION(0:MaxProc - 1) :: RequestSend
	40	type(request_SR), DIMENSION(0:MaxProc - 1) :: RequestRecv
	41	INTEGER :: tag = 1
[1632]	42	end type request
	43
[5159]	44	TYPE(distrib), SAVE :: distrib_gather
[1632]	45
	46	INTERFACE Register_SwapField_u
[5159]	47	MODULE PROCEDURE Register_SwapField1d_u, Register_SwapField2d_u1d, Register_SwapField3d_u, &
	48	Register_SwapField1d_u_bis, Register_SwapField2d_u1d_bis, Register_SwapField3d_u_bis
[1632]	49	END INTERFACE Register_SwapField_u
	50
	51	INTERFACE Register_SwapField_v
[5159]	52	MODULE PROCEDURE Register_SwapField1d_v, Register_SwapField2d_v1d, Register_SwapField3d_v, &
	53	Register_SwapField1d_v_bis, Register_SwapField2d_v1d_bis, Register_SwapField3d_v_bis
[1632]	54	END INTERFACE Register_SwapField_v
	55
	56	INTERFACE Register_SwapField2d_u
[5159]	57	MODULE PROCEDURE Register_SwapField1d_u2d, Register_SwapField2d_u2d, Register_SwapField3d_u2d, &
	58	Register_SwapField1d_u2d_bis, Register_SwapField2d_u2d_bis, Register_SwapField3d_u2d_bis
[1632]	59	END INTERFACE Register_SwapField2d_u
	60
	61	INTERFACE Register_SwapField2d_v
[5159]	62	MODULE PROCEDURE Register_SwapField1d_v2d, Register_SwapField2d_v2d, Register_SwapField3d_v2d, &
	63	Register_SwapField1d_v2d_bis, Register_SwapField2d_v2d_bis, Register_SwapField3d_v2d_bis
[1632]	64	END INTERFACE Register_SwapField2d_v
	65
[5159]	66	CONTAINS
[1632]	67
[5103]	68	SUBROUTINE Init_mod_hallo
[5159]	69	USE lmdz_dimensions
	70	USE lmdz_paramet
	71	USE IOIPSL
[5113]	72	IMPLICIT NONE
[5159]	73	INTEGER :: jj_nb_gather(0:mpi_size - 1)
	74
	75	Index_Pos = 1
	76	Buffer_Pos(Index_Pos) = 1
	77	MaxBufferSize_Used = 0
	78	!$OMP MASTER
	79	MaxBufferSize = DefaultMaxBufferSize
	80	CALL getin("mpi_buffer_size", MaxBufferSize)
	81	!$OMP END MASTER
	82	!$OMP BARRIER
	83
[1632]	84	IF (use_mpi_alloc .AND. using_mpi) THEN
	85	CALL create_global_mpi_buffer
[5159]	86	ELSE
[1632]	87	CALL create_standard_mpi_buffer
	88	ENDIF
[1847]	89
[5159]	90	!$OMP MASTER
	91	jj_nb_gather(:) = 0
	92	jj_nb_gather(0) = jjp1
	93
	94	CALL create_distrib(jj_nb_gather, distrib_gather)
	95	!$OMP END MASTER
	96	!$OMP BARRIER
	97
[5103]	98	END SUBROUTINE init_mod_hallo
[1632]	99
	100	SUBROUTINE create_standard_mpi_buffer
[5159]	101	IMPLICIT NONE
	102
[1632]	103	ALLOCATE(Buffer(MaxBufferSize))
[5159]	104
[1632]	105	END SUBROUTINE create_standard_mpi_buffer
[5159]	106
[1632]	107	SUBROUTINE create_global_mpi_buffer
[5159]	108	USE lmdz_mpi
	109	IMPLICIT NONE
	110	POINTER (Pbuffer, MPI_Buffer(MaxBufferSize))
[1632]	111	REAL :: MPI_Buffer
[5159]	112	INTEGER(KIND = MPI_ADDRESS_KIND) :: BS
	113	INTEGER :: i, ierr
[1632]	114
[5159]	115	! Allocation du buffer MPI
	116	Bs = 8 * MaxBufferSize
	117	!$OMP CRITICAL (MPI)
	118	CALL MPI_ALLOC_MEM(BS, MPI_INFO_NULL, Pbuffer, ierr)
	119	!$OMP END CRITICAL (MPI)
	120	DO i = 1, MaxBufferSize
	121	MPI_Buffer(i) = i
	122	ENDDO
	123
	124	CALL Associate_buffer(MPI_Buffer)
	125
[1632]	126	CONTAINS
	127
[5159]	128	SUBROUTINE Associate_buffer(MPI_Buffer)
	129	IMPLICIT NONE
	130	REAL, DIMENSION(:), target :: MPI_Buffer
	131
	132	Buffer => MPI_Buffer
	133
	134	END SUBROUTINE Associate_buffer
	135
[1632]	136	END SUBROUTINE create_global_mpi_buffer
[5128]	137
[5159]	138
	139	SUBROUTINE allocate_buffer(Size, Index, Pos)
	140
	141	IMPLICIT NONE
[5116]	142	INTEGER :: Size
	143	INTEGER :: Index
	144	INTEGER :: Pos
[1632]	145
[5159]	146	IF (Buffer_pos(Index_pos) + Size>MaxBufferSize_Used) MaxBufferSize_Used = Buffer_pos(Index_pos) + Size
	147	IF (Buffer_pos(Index_pos) + Size>MaxBufferSize) THEN
[5160]	148	PRINT *, 'STOP :: La taille de MaxBufferSize dans mod_hallo.F90 est trop petite !!!!'
[5159]	149	CALL abort_gcm("mod_hallo", "stopped", 1)
[1632]	150	endif
[5159]	151
[5117]	152	IF (Index_pos>=ListSize) THEN
[5160]	153	PRINT *, 'STOP :: La taille de ListSize dans mod_hallo.F90 est trop petite !!!!'
[5159]	154	CALL abort_gcm("mod_hallo", "stopped", 1)
[1632]	155	endif
[5159]	156
	157	Pos = Buffer_Pos(Index_Pos)
	158	Buffer_Pos(Index_pos + 1) = Buffer_Pos(Index_Pos) + Size
	159	Index_Pos = Index_Pos + 1
	160	Index = Index_Pos
	161
[5103]	162	END SUBROUTINE allocate_buffer
[5159]	163
[5103]	164	SUBROUTINE deallocate_buffer(Index)
[5159]	165	IMPLICIT NONE
[5116]	166	INTEGER :: Index
[5159]	167
	168	Buffer_Pos(Index) = -1
	169
[5158]	170	DO while (Buffer_Pos(Index_Pos)==-1 .AND. Index_Pos>1)
[5159]	171	Index_Pos = Index_Pos - 1
[5086]	172	END DO
[1632]	173
[5103]	174	END SUBROUTINE deallocate_buffer
[5159]	175
	176	SUBROUTINE SetTag(a_request, tag)
	177	IMPLICIT NONE
	178	type(request) :: a_request
[5116]	179	INTEGER :: tag
[5159]	180
	181	a_request%tag = tag
[5103]	182	END SUBROUTINE SetTag
[5159]	183
	184
	185	SUBROUTINE New_Hallo(Field, Stride, NbLevel, offset, size, Ptr_request)
[5116]	186	INTEGER :: Stride
	187	INTEGER :: NbLevel
	188	INTEGER :: size
	189	INTEGER :: offset
[5159]	190	REAL, DIMENSION(Stride, NbLevel), target :: Field
	191	type(request_SR), pointer :: Ptr_request
	192	type(Hallo), POINTER :: NewHallos(:), HalloSwitch(:), NewHallo
	193
	194	Ptr_Request%NbRequest = Ptr_Request%NbRequest + 1
[1847]	195	IF(Ptr_Request%NbRequestMax==0) THEN
[5159]	196	Ptr_Request%NbRequestMax = 10
	197	ALLOCATE(Ptr_Request%Hallo(Ptr_Request%NbRequestMax))
	198	ELSE IF (Ptr_Request%NbRequest > Ptr_Request%NbRequestMax) THEN
	199	Ptr_Request%NbRequestMax = INT(Ptr_Request%NbRequestMax * 1.2)
[1847]	200	ALLOCATE(NewHallos(Ptr_Request%NbRequestMax))
[5159]	201	NewHallos(1:Ptr_Request%NbRequest - 1) = Ptr_Request%hallo(1:Ptr_Request%NbRequest - 1)
	202	HalloSwitch => Ptr_Request%hallo
	203	Ptr_Request%hallo => NewHallos
[1847]	204	DEALLOCATE(HalloSwitch)
	205	ENDIF
[5159]	206
	207	NewHallo => Ptr_Request%hallo(Ptr_Request%NbRequest)
	208
	209	NewHallo%Field => Field
	210	NewHallo%Stride = Stride
	211	NewHallo%NbLevel = NbLevel
	212	NewHallo%size = size
	213	NewHallo%offset = offset
	214
[5103]	215	END SUBROUTINE New_Hallo
[1632]	216
[5159]	217	SUBROUTINE Register_SendField(Field, ij, ll, offset, size, target, a_request)
	218	USE lmdz_dimensions
	219	USE lmdz_paramet
	220	IMPLICIT NONE
[1632]	221
[5159]	222	INTEGER :: ij, ll, offset, size, target
	223	REAL, DIMENSION(ij, ll) :: Field
	224	type(request), target :: a_request
	225	type(request_SR), pointer :: Ptr_request
[1847]	226
[5159]	227	Ptr_Request => a_request%RequestSend(target)
[1632]	228
[5159]	229	CALL New_Hallo(Field, ij, ll, offset, size, Ptr_request)
[1632]	230
[5159]	231	END SUBROUTINE Register_SendField
[1632]	232
[5159]	233	SUBROUTINE Register_RecvField(Field, ij, ll, offset, size, target, a_request)
	234	USE lmdz_dimensions
	235	USE lmdz_paramet
	236	IMPLICIT NONE
[1632]	237
[5159]	238	INTEGER :: ij, ll, offset, size, target
	239	REAL, DIMENSION(ij, ll) :: Field
	240	type(request), target :: a_request
	241	type(request_SR), pointer :: Ptr_request
	242
	243	Ptr_Request => a_request%RequestRecv(target)
	244
	245	CALL New_Hallo(Field, ij, ll, offset, size, Ptr_request)
	246
	247	END SUBROUTINE Register_RecvField
	248
	249	SUBROUTINE Register_SwapField(FieldS, FieldR, ij, ll, jj_Nb_New, a_request)
	250	USE lmdz_dimensions
	251	USE lmdz_paramet
	252	IMPLICIT NONE
	253
	254	INTEGER :: ij, ll
	255	REAL, DIMENSION(ij, ll) :: FieldS
	256	REAL, DIMENSION(ij, ll) :: FieldR
[1632]	257	type(request) :: a_request
[5159]	258	INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Nb_New
	259	INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Begin_New, jj_End_New
	260
	261	INTEGER :: i, jje, jjb
	262
	263	jj_begin_New(0) = 1
	264	jj_End_New(0) = jj_Nb_New(0)
	265	DO i = 1, MPI_Size - 1
	266	jj_begin_New(i) = jj_end_New(i - 1) + 1
	267	jj_end_New(i) = jj_begin_new(i) + jj_Nb_New(i) - 1
[1632]	268	enddo
[5159]	269
	270	DO i = 0, MPI_Size - 1
[5117]	271	IF (i /= MPI_Rank) THEN
[5159]	272	jjb = max(jj_begin_new(i), jj_begin)
	273	jje = min(jj_end_new(i), jj_end)
	274
	275	IF (ij==ip1jm .AND. jje==jjp1) jje = jjm
	276
[5117]	277	IF (jje >= jjb) THEN
[5159]	278	CALL Register_SendField(FieldS, ij, ll, jjb, jje - jjb + 1, i, a_request)
[1632]	279	endif
[5159]	280
	281	jjb = max(jj_begin_new(MPI_Rank), jj_begin_Para(i))
	282	jje = min(jj_end_new(MPI_Rank), jj_end_Para(i))
	283
	284	IF (ij==ip1jm .AND. jje==jjp1) jje = jjm
	285
[5117]	286	IF (jje >= jjb) THEN
[5159]	287	CALL Register_RecvField(FieldR, ij, ll, jjb, jje - jjb + 1, i, a_request)
[1632]	288	endif
[5159]	289
[1632]	290	endif
	291	enddo
[5159]	292
[5103]	293	END SUBROUTINE Register_SwapField
[1632]	294
[5159]	295
	296	SUBROUTINE Register_SwapFieldHallo(FieldS, FieldR, ij, ll, jj_Nb_New, Up, Down, a_request)
	297	USE lmdz_dimensions
	298	USE lmdz_paramet
	299
	300	IMPLICIT NONE
	301
	302	INTEGER :: ij, ll, Up, Down
	303	REAL, DIMENSION(ij, ll) :: FieldS
	304	REAL, DIMENSION(ij, ll) :: FieldR
[1632]	305	type(request) :: a_request
[5159]	306	INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Nb_New
	307	INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Begin_New, jj_End_New
	308
	309	INTEGER :: i, jje, jjb
	310
	311	jj_begin_New(0) = 1
	312	jj_End_New(0) = jj_Nb_New(0)
	313	DO i = 1, MPI_Size - 1
	314	jj_begin_New(i) = jj_end_New(i - 1) + 1
	315	jj_end_New(i) = jj_begin_new(i) + jj_Nb_New(i) - 1
[1632]	316	enddo
[5159]	317
	318	DO i = 0, MPI_Size - 1
	319	jj_begin_New(i) = max(1, jj_begin_New(i) - Up)
	320	jj_end_New(i) = min(jjp1, jj_end_new(i) + Down)
[1632]	321	enddo
[5159]	322
	323	DO i = 0, MPI_Size - 1
[5117]	324	IF (i /= MPI_Rank) THEN
[5159]	325	jjb = max(jj_begin_new(i), jj_begin)
	326	jje = min(jj_end_new(i), jj_end)
	327
	328	IF (ij==ip1jm .AND. jje==jjp1) jje = jjm
	329
[5117]	330	IF (jje >= jjb) THEN
[5159]	331	CALL Register_SendField(FieldS, ij, ll, jjb, jje - jjb + 1, i, a_request)
[1632]	332	endif
[5159]	333
	334	jjb = max(jj_begin_new(MPI_Rank), jj_begin_Para(i))
	335	jje = min(jj_end_new(MPI_Rank), jj_end_Para(i))
	336
	337	IF (ij==ip1jm .AND. jje==jjp1) jje = jjm
	338
[5117]	339	IF (jje >= jjb) THEN
[5159]	340	CALL Register_RecvField(FieldR, ij, ll, jjb, jje - jjb + 1, i, a_request)
[1632]	341	endif
[5159]	342
[1632]	343	endif
	344	enddo
[5159]	345
[5103]	346	END SUBROUTINE Register_SwapFieldHallo
[1632]	347
	348
[5159]	349	SUBROUTINE Register_SwapField1d_u(FieldS, FieldR, new_dist, a_request, up, down)
	350	USE parallel_lmdz
	351	USE lmdz_dimensions
	352	USE lmdz_paramet
	353	IMPLICIT NONE
[1632]	354
[5159]	355	TYPE(distrib), INTENT(IN) :: new_dist
	356	REAL, DIMENSION(current_dist%ijb_u:), INTENT(IN) :: FieldS
	357	REAL, DIMENSION(new_dist%ijb_u:), INTENT(OUT) :: FieldR
	358	INTEGER, OPTIONAL, INTENT(IN) :: up
	359	INTEGER, OPTIONAL, INTENT(IN) :: down
	360	TYPE(request), INTENT(INOUT) :: a_request
[1632]	361
[5159]	362	INTEGER :: halo_up
	363	INTEGER :: halo_down
[1632]	364
[5159]	365	halo_up = 0
	366	halo_down = 0
	367	IF (PRESENT(up)) halo_up = up
	368	IF (PRESENT(down)) halo_down = down
[1632]	369
[5159]	370	CALL Register_SwapField_gen_u(FieldS, FieldR, 1, current_dist, new_dist, halo_up, halo_down, a_request)
[1632]	371
[5159]	372	END SUBROUTINE Register_SwapField1d_u
[2436]	373
[5159]	374	SUBROUTINE Register_SwapField1d_u_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
	375	USE parallel_lmdz
	376	USE lmdz_dimensions
	377	USE lmdz_paramet
	378	IMPLICIT NONE
[2436]	379
[5159]	380	TYPE(distrib), INTENT(IN) :: new_dist
	381	TYPE(distrib), INTENT(IN) :: old_dist
	382	REAL, DIMENSION(old_dist%ijb_u:), INTENT(IN) :: FieldS
	383	REAL, DIMENSION(new_dist%ijb_u:), INTENT(OUT) :: FieldR
	384	INTEGER, OPTIONAL, INTENT(IN) :: up
	385	INTEGER, OPTIONAL, INTENT(IN) :: down
	386	TYPE(request), INTENT(INOUT) :: a_request
[2436]	387
[5159]	388	INTEGER :: halo_up
	389	INTEGER :: halo_down
	390
	391	halo_up = 0
	392	halo_down = 0
	393	IF (PRESENT(up)) halo_up = up
	394	IF (PRESENT(down)) halo_down = down
	395
	396	CALL Register_SwapField_gen_u(FieldS, FieldR, 1, old_dist, new_dist, halo_up, halo_down, a_request)
	397
	398	END SUBROUTINE Register_SwapField1d_u_bis
	399
	400
	401	SUBROUTINE Register_SwapField2d_u1d(FieldS, FieldR, new_dist, a_request, up, down)
	402	USE parallel_lmdz
	403	USE lmdz_dimensions
	404	USE lmdz_paramet
[1632]	405	IMPLICIT NONE
	406
[5159]	407	TYPE(distrib), INTENT(IN) :: new_dist
	408	REAL, DIMENSION(current_dist%ijb_u:, :), INTENT(IN) :: FieldS
	409	REAL, DIMENSION(new_dist%ijb_u:, :), INTENT(OUT) :: FieldR
	410	INTEGER, OPTIONAL, INTENT(IN) :: up
	411	INTEGER, OPTIONAL, INTENT(IN) :: down
	412	TYPE(request), INTENT(INOUT) :: a_request
	413
	414	INTEGER :: halo_up
	415	INTEGER :: halo_down
	416	INTEGER :: ll
	417
	418	halo_up = 0
	419	halo_down = 0
	420	IF (PRESENT(up)) halo_up = up
	421	IF (PRESENT(down)) halo_down = down
	422
	423	ll = size(FieldS, 2)
	424
	425	CALL Register_SwapField_gen_u(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)
	426
[1632]	427	END SUBROUTINE Register_SwapField2d_u1d
[2436]	428
[5159]	429	SUBROUTINE Register_SwapField2d_u1d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
	430	USE parallel_lmdz
	431	USE lmdz_dimensions
	432	USE lmdz_paramet
[2436]	433	IMPLICIT NONE
	434
[5159]	435	TYPE(distrib), INTENT(IN) :: new_dist
	436	TYPE(distrib), INTENT(IN) :: old_dist
	437	REAL, DIMENSION(old_dist%ijb_u:, :), INTENT(IN) :: FieldS
	438	REAL, DIMENSION(new_dist%ijb_u:, :), INTENT(OUT) :: FieldR
	439	INTEGER, OPTIONAL, INTENT(IN) :: up
	440	INTEGER, OPTIONAL, INTENT(IN) :: down
	441	TYPE(request), INTENT(INOUT) :: a_request
	442
	443	INTEGER :: halo_up
	444	INTEGER :: halo_down
	445	INTEGER :: ll
	446
	447	halo_up = 0
	448	halo_down = 0
	449	IF (PRESENT(up)) halo_up = up
	450	IF (PRESENT(down)) halo_down = down
	451
	452	ll = size(FieldS, 2)
	453
	454	CALL Register_SwapField_gen_u(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)
	455
[2436]	456	END SUBROUTINE Register_SwapField2d_u1d_bis
[1632]	457
	458
[5159]	459	SUBROUTINE Register_SwapField3d_u(FieldS, FieldR, new_dist, a_request, up, down)
	460	USE parallel_lmdz
	461	USE lmdz_dimensions
	462	USE lmdz_paramet
	463	IMPLICIT NONE
[2436]	464
[5159]	465	TYPE(distrib), INTENT(IN) :: new_dist
	466	REAL, DIMENSION(current_dist%ijb_u:, :, :), INTENT(IN) :: FieldS
	467	REAL, DIMENSION(new_dist%ijb_u:, :, :), INTENT(OUT) :: FieldR
	468	INTEGER, OPTIONAL, INTENT(IN) :: up
	469	INTEGER, OPTIONAL, INTENT(IN) :: down
	470	TYPE(request), INTENT(INOUT) :: a_request
[2436]	471
[5159]	472	INTEGER :: halo_up
	473	INTEGER :: halo_down
	474	INTEGER :: ll
[1632]	475
[5159]	476	halo_up = 0
	477	halo_down = 0
	478	IF (PRESENT(up)) halo_up = up
	479	IF (PRESENT(down)) halo_down = down
[1632]	480
[5159]	481	ll = size(FieldS, 2) * size(FieldS, 3)
[1632]	482
[5159]	483	CALL Register_SwapField_gen_u(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)
[2436]	484
[5159]	485	END SUBROUTINE Register_SwapField3d_u
[1632]	486
[5159]	487	SUBROUTINE Register_SwapField3d_u_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
	488	USE parallel_lmdz
	489	USE lmdz_dimensions
	490	USE lmdz_paramet
	491	IMPLICIT NONE
[1632]	492
[5159]	493	TYPE(distrib), INTENT(IN) :: new_dist
	494	TYPE(distrib), INTENT(IN) :: old_dist
	495	REAL, DIMENSION(old_dist%ijb_u:, :, :), INTENT(IN) :: FieldS
	496	REAL, DIMENSION(new_dist%ijb_u:, :, :), INTENT(OUT) :: FieldR
	497	INTEGER, OPTIONAL, INTENT(IN) :: up
	498	INTEGER, OPTIONAL, INTENT(IN) :: down
	499	TYPE(request), INTENT(INOUT) :: a_request
[1632]	500
[5159]	501	INTEGER :: halo_up
	502	INTEGER :: halo_down
	503	INTEGER :: ll
[1632]	504
[5159]	505	halo_up = 0
	506	halo_down = 0
	507	IF (PRESENT(up)) halo_up = up
	508	IF (PRESENT(down)) halo_down = down
[2436]	509
[5159]	510	ll = size(FieldS, 2) * size(FieldS, 3)
[2436]	511
[5159]	512	CALL Register_SwapField_gen_u(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)
[2436]	513
[5159]	514	END SUBROUTINE Register_SwapField3d_u_bis
[2436]	515
	516
[5159]	517	SUBROUTINE Register_SwapField1d_u2d(FieldS, FieldR, new_dist, a_request, up, down)
	518	USE parallel_lmdz
	519	USE lmdz_dimensions
	520	USE lmdz_paramet
[1632]	521
[5159]	522	IMPLICIT NONE
[1632]	523
[5159]	524	TYPE(distrib), INTENT(IN) :: new_dist !LF
	525	REAL, DIMENSION(current_dist%jjb_u:, :), INTENT(IN) :: FieldS
	526	REAL, DIMENSION(new_dist%jjb_u:, :), INTENT(OUT) :: FieldR
	527	INTEGER, OPTIONAL, INTENT(IN) :: up
	528	INTEGER, OPTIONAL, INTENT(IN) :: down
	529	TYPE(request), INTENT(INOUT) :: a_request
	530
	531	INTEGER :: halo_up
	532	INTEGER :: halo_down
	533
	534	halo_up = 0
	535	halo_down = 0
	536	IF (PRESENT(up)) halo_up = up
	537	IF (PRESENT(down)) halo_down = down
	538
	539	CALL Register_SwapField_gen_u(FieldS, FieldR, 1, current_dist, new_dist, halo_up, halo_down, a_request)
	540
	541	END SUBROUTINE Register_SwapField1d_u2d
	542
	543	SUBROUTINE Register_SwapField1d_u2d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
	544	USE parallel_lmdz
	545	USE lmdz_dimensions
	546	USE lmdz_paramet
	547
	548	IMPLICIT NONE
	549
	550	TYPE(distrib), INTENT(IN) :: new_dist !LF
	551	TYPE(distrib), INTENT(IN) :: old_dist
	552	REAL, DIMENSION(old_dist%jjb_u:, :), INTENT(IN) :: FieldS
	553	REAL, DIMENSION(new_dist%jjb_u:, :), INTENT(OUT) :: FieldR
	554	INTEGER, OPTIONAL, INTENT(IN) :: up
	555	INTEGER, OPTIONAL, INTENT(IN) :: down
	556	TYPE(request), INTENT(INOUT) :: a_request
	557
	558	INTEGER :: halo_up
	559	INTEGER :: halo_down
	560
	561	halo_up = 0
	562	halo_down = 0
	563	IF (PRESENT(up)) halo_up = up
	564	IF (PRESENT(down)) halo_down = down
	565
	566	CALL Register_SwapField_gen_u(FieldS, FieldR, 1, old_dist, new_dist, halo_up, halo_down, a_request)
	567
	568	END SUBROUTINE Register_SwapField1d_u2d_bis
	569
	570
	571	SUBROUTINE Register_SwapField2d_u2d(FieldS, FieldR, new_dist, a_request, up, down)
	572	USE parallel_lmdz
	573	USE lmdz_dimensions
	574	USE lmdz_paramet
	575
	576	IMPLICIT NONE
	577
	578	TYPE(distrib), INTENT(IN) :: new_dist
	579	REAL, DIMENSION(current_dist%jjb_u:, :, :), INTENT(IN) :: FieldS
	580	REAL, DIMENSION(new_dist%jjb_u:, :, :), INTENT(OUT) :: FieldR
	581	INTEGER, OPTIONAL, INTENT(IN) :: up
	582	INTEGER, OPTIONAL, INTENT(IN) :: down
	583	TYPE(request), INTENT(INOUT) :: a_request
	584
	585	INTEGER :: halo_up
	586	INTEGER :: halo_down
	587	INTEGER :: ll
	588
	589	halo_up = 0
	590	halo_down = 0
	591	IF (PRESENT(up)) halo_up = up
	592	IF (PRESENT(down)) halo_down = down
	593
	594	ll = size(FieldS, 3)
	595
	596	CALL Register_SwapField_gen_u(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)
	597
[1632]	598	END SUBROUTINE Register_SwapField2d_u2d
[2436]	599
[5159]	600	SUBROUTINE Register_SwapField2d_u2d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
	601	USE parallel_lmdz
	602	USE lmdz_dimensions
	603	USE lmdz_paramet
[2436]	604
[5159]	605	IMPLICIT NONE
[2436]	606
[5159]	607	TYPE(distrib), INTENT(IN) :: new_dist
	608	TYPE(distrib), INTENT(IN) :: old_dist
	609	REAL, DIMENSION(old_dist%jjb_u:, :, :), INTENT(IN) :: FieldS
	610	REAL, DIMENSION(new_dist%jjb_u:, :, :), INTENT(OUT) :: FieldR
	611	INTEGER, OPTIONAL, INTENT(IN) :: up
	612	INTEGER, OPTIONAL, INTENT(IN) :: down
	613	TYPE(request), INTENT(INOUT) :: a_request
	614
	615	INTEGER :: halo_up
	616	INTEGER :: halo_down
	617	INTEGER :: ll
	618
	619	halo_up = 0
	620	halo_down = 0
	621	IF (PRESENT(up)) halo_up = up
	622	IF (PRESENT(down)) halo_down = down
	623
	624	ll = size(FieldS, 3)
	625
	626	CALL Register_SwapField_gen_u(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)
	627
[2436]	628	END SUBROUTINE Register_SwapField2d_u2d_bis
[1632]	629
	630
[5159]	631	SUBROUTINE Register_SwapField3d_u2d(FieldS, FieldR, new_dist, a_request, up, down)
	632	USE parallel_lmdz
	633	USE lmdz_dimensions
	634	USE lmdz_paramet
	635	IMPLICIT NONE
[1632]	636
[5159]	637	TYPE(distrib), INTENT(IN) :: new_dist
	638	REAL, DIMENSION(current_dist%jjb_u:, :, :, :), INTENT(IN) :: FieldS
	639	REAL, DIMENSION(new_dist%jjb_u:, :, :, :), INTENT(OUT) :: FieldR
	640	INTEGER, OPTIONAL, INTENT(IN) :: up
	641	INTEGER, OPTIONAL, INTENT(IN) :: down
	642	TYPE(request), INTENT(INOUT) :: a_request
[1632]	643
[5159]	644	INTEGER :: halo_up
	645	INTEGER :: halo_down
	646	INTEGER :: ll
[1632]	647
[5159]	648	halo_up = 0
	649	halo_down = 0
	650	IF (PRESENT(up)) halo_up = up
	651	IF (PRESENT(down)) halo_down = down
[1632]	652
[5159]	653	ll = size(FieldS, 3) * size(FieldS, 4)
[1632]	654
[5159]	655	CALL Register_SwapField_gen_u(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)
[1632]	656
[5159]	657	END SUBROUTINE Register_SwapField3d_u2d
[1632]	658
[5159]	659	SUBROUTINE Register_SwapField3d_u2d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
	660	USE parallel_lmdz
	661	USE lmdz_dimensions
	662	USE lmdz_paramet
	663	IMPLICIT NONE
[2436]	664
[5159]	665	TYPE(distrib), INTENT(IN) :: new_dist
	666	TYPE(distrib), INTENT(IN) :: old_dist
	667	REAL, DIMENSION(old_dist%jjb_u:, :, :, :), INTENT(IN) :: FieldS
	668	REAL, DIMENSION(new_dist%jjb_u:, :, :, :), INTENT(OUT) :: FieldR
	669	INTEGER, OPTIONAL, INTENT(IN) :: up
	670	INTEGER, OPTIONAL, INTENT(IN) :: down
	671	TYPE(request), INTENT(INOUT) :: a_request
[2436]	672
[5159]	673	INTEGER :: halo_up
	674	INTEGER :: halo_down
	675	INTEGER :: ll
[1632]	676
[5159]	677	halo_up = 0
	678	halo_down = 0
	679	IF (PRESENT(up)) halo_up = up
	680	IF (PRESENT(down)) halo_down = down
[1632]	681
[5159]	682	ll = size(FieldS, 3) * size(FieldS, 4)
[1632]	683
[5159]	684	CALL Register_SwapField_gen_u(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)
[1632]	685
[5159]	686	END SUBROUTINE Register_SwapField3d_u2d_bis
[2436]	687
	688
[5159]	689	SUBROUTINE Register_SwapField1d_v(FieldS, FieldR, new_dist, a_request, up, down)
	690	USE parallel_lmdz
	691	USE lmdz_dimensions
	692	USE lmdz_paramet
	693	IMPLICIT NONE
[2436]	694
[5159]	695	TYPE(distrib), INTENT(IN) :: new_dist
	696	REAL, DIMENSION(current_dist%ijb_v:), INTENT(IN) :: FieldS
	697	REAL, DIMENSION(new_dist%ijb_v:), INTENT(OUT) :: FieldR
	698	INTEGER, OPTIONAL, INTENT(IN) :: up
	699	INTEGER, OPTIONAL, INTENT(IN) :: down
	700	TYPE(request), INTENT(INOUT) :: a_request
[1632]	701
[5159]	702	INTEGER :: halo_up
	703	INTEGER :: halo_down
	704
	705	halo_up = 0
	706	halo_down = 0
	707	IF (PRESENT(up)) halo_up = up
	708	IF (PRESENT(down)) halo_down = down
	709
	710	CALL Register_SwapField_gen_v(FieldS, FieldR, 1, current_dist, new_dist, halo_up, halo_down, a_request)
	711
	712	END SUBROUTINE Register_SwapField1d_v
	713
	714	SUBROUTINE Register_SwapField1d_v_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
	715	USE parallel_lmdz
	716	USE lmdz_dimensions
	717	USE lmdz_paramet
	718	IMPLICIT NONE
	719
	720	TYPE(distrib), INTENT(IN) :: new_dist
	721	TYPE(distrib), INTENT(IN) :: old_dist
	722	REAL, DIMENSION(old_dist%ijb_v:), INTENT(IN) :: FieldS
	723	REAL, DIMENSION(new_dist%ijb_v:), INTENT(OUT) :: FieldR
	724	INTEGER, OPTIONAL, INTENT(IN) :: up
	725	INTEGER, OPTIONAL, INTENT(IN) :: down
	726	TYPE(request), INTENT(INOUT) :: a_request
	727
	728	INTEGER :: halo_up
	729	INTEGER :: halo_down
	730
	731	halo_up = 0
	732	halo_down = 0
	733	IF (PRESENT(up)) halo_up = up
	734	IF (PRESENT(down)) halo_down = down
	735
	736	CALL Register_SwapField_gen_v(FieldS, FieldR, 1, old_dist, new_dist, halo_up, halo_down, a_request)
	737
	738	END SUBROUTINE Register_SwapField1d_v_bis
	739
	740
	741	SUBROUTINE Register_SwapField2d_v1d(FieldS, FieldR, new_dist, a_request, up, down)
	742	USE parallel_lmdz
	743	USE lmdz_dimensions
	744	USE lmdz_paramet
	745	IMPLICIT NONE
	746
	747	TYPE(distrib), INTENT(IN) :: new_dist
	748	REAL, DIMENSION(current_dist%ijb_v:, :), INTENT(IN) :: FieldS
	749	REAL, DIMENSION(new_dist%ijb_v:, :), INTENT(OUT) :: FieldR
	750	INTEGER, OPTIONAL, INTENT(IN) :: up
	751	INTEGER, OPTIONAL, INTENT(IN) :: down
	752	TYPE(request), INTENT(INOUT) :: a_request
	753
	754	INTEGER :: halo_up
	755	INTEGER :: halo_down
	756	INTEGER :: ll
	757
	758	halo_up = 0
	759	halo_down = 0
	760	IF (PRESENT(up)) halo_up = up
	761	IF (PRESENT(down)) halo_down = down
	762
	763	ll = size(FieldS, 2)
	764
	765	CALL Register_SwapField_gen_v(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)
	766
[1632]	767	END SUBROUTINE Register_SwapField2d_v1d
	768
[5159]	769	SUBROUTINE Register_SwapField2d_v1d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
	770	USE parallel_lmdz
	771	USE lmdz_dimensions
	772	USE lmdz_paramet
	773	IMPLICIT NONE
	774
	775	TYPE(distrib), INTENT(IN) :: new_dist
	776	TYPE(distrib), INTENT(IN) :: old_dist
	777	REAL, DIMENSION(old_dist%ijb_v:, :), INTENT(IN) :: FieldS
	778	REAL, DIMENSION(new_dist%ijb_v:, :), INTENT(OUT) :: FieldR
	779	INTEGER, OPTIONAL, INTENT(IN) :: up
	780	INTEGER, OPTIONAL, INTENT(IN) :: down
	781	TYPE(request), INTENT(INOUT) :: a_request
	782
	783	INTEGER :: halo_up
	784	INTEGER :: halo_down
	785	INTEGER :: ll
	786
	787	halo_up = 0
	788	halo_down = 0
	789	IF (PRESENT(up)) halo_up = up
	790	IF (PRESENT(down)) halo_down = down
	791
	792	ll = size(FieldS, 2)
	793
	794	CALL Register_SwapField_gen_v(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)
	795
[2436]	796	END SUBROUTINE Register_SwapField2d_v1d_bis
	797
[1632]	798
[5159]	799	SUBROUTINE Register_SwapField3d_v(FieldS, FieldR, new_dist, a_request, up, down)
	800	USE parallel_lmdz
	801	USE lmdz_dimensions
	802	USE lmdz_paramet
	803	IMPLICIT NONE
[1632]	804
[5159]	805	TYPE(distrib), INTENT(IN) :: new_dist
	806	REAL, DIMENSION(current_dist%ijb_v:, :, :), INTENT(IN) :: FieldS
	807	REAL, DIMENSION(new_dist%ijb_v:, :, :), INTENT(OUT) :: FieldR
	808	INTEGER, OPTIONAL, INTENT(IN) :: up
	809	INTEGER, OPTIONAL, INTENT(IN) :: down
	810	TYPE(request), INTENT(INOUT) :: a_request
[1632]	811
[5159]	812	INTEGER :: halo_up
	813	INTEGER :: halo_down
	814	INTEGER :: ll
[1632]	815
[5159]	816	halo_up = 0
	817	halo_down = 0
	818	IF (PRESENT(up)) halo_up = up
	819	IF (PRESENT(down)) halo_down = down
[1632]	820
[5159]	821	ll = size(FieldS, 2) * size(FieldS, 3)
[2436]	822
[5159]	823	CALL Register_SwapField_gen_v(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)
[2436]	824
[5159]	825	END SUBROUTINE Register_SwapField3d_v
[1632]	826
[5159]	827	SUBROUTINE Register_SwapField3d_v_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
	828	USE parallel_lmdz
	829	USE lmdz_dimensions
	830	USE lmdz_paramet
	831	IMPLICIT NONE
[1632]	832
[5159]	833	TYPE(distrib), INTENT(IN) :: new_dist
	834	TYPE(distrib), INTENT(IN) :: old_dist
	835	REAL, DIMENSION(old_dist%ijb_v:, :, :), INTENT(IN) :: FieldS
	836	REAL, DIMENSION(new_dist%ijb_v:, :, :), INTENT(OUT) :: FieldR
	837	INTEGER, OPTIONAL, INTENT(IN) :: up
	838	INTEGER, OPTIONAL, INTENT(IN) :: down
	839	TYPE(request), INTENT(INOUT) :: a_request
	840
	841	INTEGER :: halo_up
	842	INTEGER :: halo_down
	843	INTEGER :: ll
	844
	845	halo_up = 0
	846	halo_down = 0
	847	IF (PRESENT(up)) halo_up = up
	848	IF (PRESENT(down)) halo_down = down
	849
	850	ll = size(FieldS, 2) * size(FieldS, 3)
	851
	852	CALL Register_SwapField_gen_v(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)
	853
	854	END SUBROUTINE Register_SwapField3d_v_bis
	855
	856
	857	SUBROUTINE Register_SwapField1d_v2d(FieldS, FieldR, new_dist, a_request, up, down)
	858	USE parallel_lmdz
	859	USE lmdz_dimensions
	860	USE lmdz_paramet
	861	IMPLICIT NONE
	862
	863	TYPE(distrib), INTENT(IN) :: new_dist !LF
	864	REAL, DIMENSION(current_dist%jjb_v:, :), INTENT(IN) :: FieldS
	865	REAL, DIMENSION(new_dist%jjb_v:, :), INTENT(OUT) :: FieldR
	866	INTEGER, OPTIONAL, INTENT(IN) :: up
	867	INTEGER, OPTIONAL, INTENT(IN) :: down
	868	TYPE(request), INTENT(INOUT) :: a_request
	869
	870	INTEGER :: halo_up
	871	INTEGER :: halo_down
	872
	873	halo_up = 0
	874	halo_down = 0
	875	IF (PRESENT(up)) halo_up = up
	876	IF (PRESENT(down)) halo_down = down
	877
	878	CALL Register_SwapField_gen_v(FieldS, FieldR, 1, current_dist, new_dist, halo_up, halo_down, a_request)
	879
[1632]	880	END SUBROUTINE Register_SwapField1d_v2d
	881
[5159]	882	SUBROUTINE Register_SwapField1d_v2d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
	883	USE parallel_lmdz
	884	USE lmdz_dimensions
	885	USE lmdz_paramet
	886	IMPLICIT NONE
[1632]	887
[5159]	888	TYPE(distrib), INTENT(IN) :: new_dist !LF
	889	TYPE(distrib), INTENT(IN) :: old_dist
	890	REAL, DIMENSION(old_dist%jjb_v:, :), INTENT(IN) :: FieldS
	891	REAL, DIMENSION(new_dist%jjb_v:, :), INTENT(OUT) :: FieldR
	892	INTEGER, OPTIONAL, INTENT(IN) :: up
	893	INTEGER, OPTIONAL, INTENT(IN) :: down
	894	TYPE(request), INTENT(INOUT) :: a_request
[2436]	895
[5159]	896	INTEGER :: halo_up
	897	INTEGER :: halo_down
	898
	899	halo_up = 0
	900	halo_down = 0
	901	IF (PRESENT(up)) halo_up = up
	902	IF (PRESENT(down)) halo_down = down
	903
	904	CALL Register_SwapField_gen_v(FieldS, FieldR, 1, old_dist, new_dist, halo_up, halo_down, a_request)
	905
[2436]	906	END SUBROUTINE Register_SwapField1d_v2d_bis
	907
	908
[5159]	909	SUBROUTINE Register_SwapField2d_v2d(FieldS, FieldR, new_dist, a_request, up, down)
	910	USE parallel_lmdz
	911	USE lmdz_dimensions
	912	USE lmdz_paramet
	913	IMPLICIT NONE
[1632]	914
[5159]	915	TYPE(distrib), INTENT(IN) :: new_dist
	916	REAL, DIMENSION(current_dist%jjb_v:, :, :), INTENT(IN) :: FieldS
	917	REAL, DIMENSION(new_dist%jjb_v:, :, :), INTENT(OUT) :: FieldR
	918	INTEGER, OPTIONAL, INTENT(IN) :: up
	919	INTEGER, OPTIONAL, INTENT(IN) :: down
	920	TYPE(request), INTENT(INOUT) :: a_request
	921
	922	INTEGER :: halo_up
	923	INTEGER :: halo_down
	924	INTEGER :: ll
	925
	926	halo_up = 0
	927	halo_down = 0
	928	IF (PRESENT(up)) halo_up = up
	929	IF (PRESENT(down)) halo_down = down
	930
	931	ll = size(FieldS, 3)
	932
	933	CALL Register_SwapField_gen_v(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)
	934
[1632]	935	END SUBROUTINE Register_SwapField2d_v2d
	936
[5159]	937	SUBROUTINE Register_SwapField2d_v2d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
	938	USE parallel_lmdz
	939	USE lmdz_dimensions
	940	USE lmdz_paramet
	941	IMPLICIT NONE
	942
	943	TYPE(distrib), INTENT(IN) :: new_dist
	944	TYPE(distrib), INTENT(IN) :: old_dist
	945	REAL, DIMENSION(old_dist%jjb_v:, :, :), INTENT(IN) :: FieldS
	946	REAL, DIMENSION(new_dist%jjb_v:, :, :), INTENT(OUT) :: FieldR
	947	INTEGER, OPTIONAL, INTENT(IN) :: up
	948	INTEGER, OPTIONAL, INTENT(IN) :: down
	949	TYPE(request), INTENT(INOUT) :: a_request
	950
	951	INTEGER :: halo_up
	952	INTEGER :: halo_down
	953	INTEGER :: ll
	954
	955	halo_up = 0
	956	halo_down = 0
	957	IF (PRESENT(up)) halo_up = up
	958	IF (PRESENT(down)) halo_down = down
	959
	960	ll = size(FieldS, 3)
	961
	962	CALL Register_SwapField_gen_v(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)
	963
[2436]	964	END SUBROUTINE Register_SwapField2d_v2d_bis
	965
[1632]	966
[5159]	967	SUBROUTINE Register_SwapField3d_v2d(FieldS, FieldR, new_dist, a_request, up, down)
	968	USE parallel_lmdz
	969	USE lmdz_dimensions
	970	USE lmdz_paramet
	971	IMPLICIT NONE
[2436]	972
[5159]	973	TYPE(distrib), INTENT(IN) :: new_dist
	974	REAL, DIMENSION(current_dist%jjb_v:, :, :, :), INTENT(IN) :: FieldS
	975	REAL, DIMENSION(new_dist%jjb_v:, :, :, :), INTENT(OUT) :: FieldR
	976	INTEGER, OPTIONAL, INTENT(IN) :: up
	977	INTEGER, OPTIONAL, INTENT(IN) :: down
	978	TYPE(request), INTENT(INOUT) :: a_request
[1632]	979
[5159]	980	INTEGER :: halo_up
	981	INTEGER :: halo_down
	982	INTEGER :: ll
	983
	984	halo_up = 0
	985	halo_down = 0
	986	IF (PRESENT(up)) halo_up = up
	987	IF (PRESENT(down)) halo_down = down
	988
	989	ll = size(FieldS, 3) * size(FieldS, 4)
	990
	991	CALL Register_SwapField_gen_v(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)
	992
	993	END SUBROUTINE Register_SwapField3d_v2d
	994
	995	SUBROUTINE Register_SwapField3d_v2d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
	996	USE parallel_lmdz
	997	USE lmdz_dimensions
	998	USE lmdz_paramet
	999	IMPLICIT NONE
	1000
	1001	TYPE(distrib), INTENT(IN) :: new_dist
	1002	TYPE(distrib), INTENT(IN) :: old_dist
	1003	REAL, DIMENSION(old_dist%jjb_v:, :, :, :), INTENT(IN) :: FieldS
	1004	REAL, DIMENSION(new_dist%jjb_v:, :, :, :), INTENT(OUT) :: FieldR
	1005	INTEGER, OPTIONAL, INTENT(IN) :: up
	1006	INTEGER, OPTIONAL, INTENT(IN) :: down
	1007	TYPE(request), INTENT(INOUT) :: a_request
	1008
	1009	INTEGER :: halo_up
	1010	INTEGER :: halo_down
	1011	INTEGER :: ll
	1012
	1013	halo_up = 0
	1014	halo_down = 0
	1015	IF (PRESENT(up)) halo_up = up
	1016	IF (PRESENT(down)) halo_down = down
	1017
	1018	ll = size(FieldS, 3) * size(FieldS, 4)
	1019
	1020	CALL Register_SwapField_gen_v(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)
	1021
	1022	END SUBROUTINE Register_SwapField3d_v2d_bis
	1023
	1024
	1025	SUBROUTINE Register_SwapField_gen_u(FieldS, FieldR, ll, old_dist, new_dist, Up, Down, a_request)
	1026	USE parallel_lmdz
	1027	USE lmdz_dimensions
	1028	USE lmdz_paramet
	1029	IMPLICIT NONE
	1030
	1031	INTEGER :: ll, Up, Down
	1032	TYPE(distrib) :: old_dist
	1033	TYPE(distrib) :: new_dist
	1034	REAL, DIMENSION(old_dist%ijb_u:old_dist%ije_u, ll) :: FieldS
	1035	REAL, DIMENSION(new_dist%ijb_u:new_dist%ije_u, ll) :: FieldR
[1632]	1036	TYPE(request) :: a_request
[5159]	1037	INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Nb_New
	1038	INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Begin_New, jj_End_New
	1039
	1040	INTEGER :: i, l, jje, jjb, ijb, ije
	1041
	1042	DO i = 0, MPI_Size - 1
	1043	jj_begin_New(i) = max(1, new_dist%jj_begin_para(i) - Up)
	1044	jj_end_New(i) = min(jjp1, new_dist%jj_end_para(i) + Down)
[1632]	1045	ENDDO
[5159]	1046
	1047	DO i = 0, MPI_Size - 1
[1632]	1048	IF (i /= MPI_Rank) THEN
[5159]	1049	jjb = max(jj_begin_new(i), old_dist%jj_begin)
	1050	jje = min(jj_end_new(i), old_dist%jj_end)
	1051
[1632]	1052	IF (jje >= jjb) THEN
[5159]	1053	CALL Register_SendField(FieldS, old_dist%ijnb_u, ll, jjb - old_dist%jjb_u + 1, jje - jjb + 1, i, a_request)
[1632]	1054	ENDIF
[5159]	1055
	1056	jjb = max(jj_begin_new(MPI_Rank), old_dist%jj_begin_Para(i))
	1057	jje = min(jj_end_new(MPI_Rank), old_dist%jj_end_Para(i))
	1058
[1632]	1059	IF (jje >= jjb) THEN
[5159]	1060	CALL Register_RecvField(FieldR, new_dist%ijnb_u, ll, jjb - new_dist%jjb_u + 1, jje - jjb + 1, i, a_request)
[1632]	1061	ENDIF
	1062	ELSE
[5159]	1063	jjb = max(jj_begin_new(i), old_dist%jj_begin)
	1064	jje = min(jj_end_new(i), old_dist%jj_end)
	1065	ijb = (jjb - 1) * iip1 + 1
	1066	ije = jje * iip1
	1067	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1068	DO l = 1, ll
	1069	FieldR(ijb:ije, l) = FieldS(ijb:ije, l)
[1632]	1070	ENDDO
[5159]	1071	!$OMP END DO NOWAIT
[1632]	1072	ENDIF
	1073	ENDDO
[5159]	1074
[1632]	1075	END SUBROUTINE Register_SwapField_gen_u
	1076
	1077
[5159]	1078	SUBROUTINE Register_SwapField_gen_v(FieldS, FieldR, ll, old_dist, new_dist, Up, Down, a_request)
	1079	USE parallel_lmdz
	1080	USE lmdz_dimensions
	1081	USE lmdz_paramet
	1082	IMPLICIT NONE
[1632]	1083
[5159]	1084	INTEGER :: ll, Up, Down
	1085	TYPE(distrib) :: old_dist
	1086	TYPE(distrib) :: new_dist
	1087	REAL, DIMENSION(old_dist%ijb_v:old_dist%ije_v, ll) :: FieldS
	1088	REAL, DIMENSION(new_dist%ijb_v:new_dist%ije_v, ll) :: FieldR
[1632]	1089	TYPE(request) :: a_request
[5159]	1090	INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Nb_New
	1091	INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Begin_New, jj_End_New
	1092
	1093	INTEGER :: i, l, jje, jjb, ijb, ije
	1094
	1095	DO i = 0, MPI_Size - 1
	1096	jj_begin_New(i) = max(1, new_dist%jj_begin_para(i) - Up)
	1097	jj_end_New(i) = min(jjp1, new_dist%jj_end_para(i) + Down)
[1632]	1098	ENDDO
[5159]	1099
	1100	DO i = 0, MPI_Size - 1
[1632]	1101	IF (i /= MPI_Rank) THEN
[5159]	1102	jjb = max(jj_begin_new(i), old_dist%jj_begin)
	1103	jje = min(jj_end_new(i), old_dist%jj_end)
[1632]	1104
[5159]	1105	IF (jje==jjp1) jje = jjm
[1632]	1106
	1107	IF (jje >= jjb) THEN
[5159]	1108	CALL Register_SendField(FieldS, old_dist%ijnb_v, ll, jjb - old_dist%jjb_v + 1, jje - jjb + 1, i, a_request)
[1632]	1109	ENDIF
	1110
[5159]	1111	jjb = max(jj_begin_new(MPI_Rank), old_dist%jj_begin_Para(i))
	1112	jje = min(jj_end_new(MPI_Rank), old_dist%jj_end_Para(i))
	1113
	1114	IF (jje==jjp1) jje = jjm
	1115
[1632]	1116	IF (jje >= jjb) THEN
[5159]	1117	CALL Register_RecvField(FieldR, new_dist%ijnb_v, ll, jjb - new_dist%jjb_v + 1, jje - jjb + 1, i, a_request)
[1632]	1118	ENDIF
	1119	ELSE
[5159]	1120	jjb = max(jj_begin_new(i), old_dist%jj_begin)
	1121	jje = min(jj_end_new(i), old_dist%jj_end)
	1122	IF (jje==jjp1) jje = jjm
	1123	ijb = (jjb - 1) * iip1 + 1
	1124	ije = jje * iip1
	1125	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1126	DO l = 1, ll
	1127	FieldR(ijb:ije, l) = FieldS(ijb:ije, l)
	1128	ENDDO
	1129	!$OMP END DO NOWAIT
[1632]	1130	ENDIF
	1131	ENDDO
[5159]	1132
[1632]	1133	END SUBROUTINE Register_SwapField_gen_v
	1134
	1135
[5159]	1136	SUBROUTINE Register_Hallo(Field, ij, ll, RUp, Rdown, SUp, SDown, a_request)
	1137	USE lmdz_dimensions
	1138	USE lmdz_paramet
	1139	USE lmdz_mpi
	1140	IMPLICIT NONE
[1632]	1141
[5159]	1142	INTEGER :: ij, ll
	1143	REAL, DIMENSION(ij, ll) :: Field
	1144	INTEGER :: Sup, Sdown, rup, rdown
	1145	type(request) :: a_request
	1146	type(Hallo), pointer :: PtrHallo
	1147	LOGICAL :: SendUp, SendDown
	1148	LOGICAL :: RecvUp, RecvDown
[1632]	1149
[5159]	1150	SendUp = .TRUE.
	1151	SendDown = .TRUE.
	1152	RecvUp = .TRUE.
	1153	RecvDown = .TRUE.
[1632]	1154
[5159]	1155	IF (pole_nord) THEN
	1156	SendUp = .FALSE.
	1157	RecvUp = .FALSE.
	1158	ENDIF
[1632]	1159
[5159]	1160	IF (pole_sud) THEN
	1161	SendDown = .FALSE.
	1162	RecvDown = .FALSE.
	1163	ENDIF
[1632]	1164
[5159]	1165	IF (Sup==0) THEN
	1166	SendUp = .FALSE.
	1167	endif
[1632]	1168
[5159]	1169	IF (Sdown==0) THEN
	1170	SendDown = .FALSE.
	1171	endif
[1632]	1172
[5159]	1173	IF (Rup==0) THEN
	1174	RecvUp = .FALSE.
	1175	endif
[1632]	1176
[5159]	1177	IF (Rdown==0) THEN
	1178	RecvDown = .FALSE.
	1179	endif
	1180
	1181	IF (SendUp) THEN
	1182	CALL Register_SendField(Field, ij, ll, jj_begin, SUp, MPI_Rank - 1, a_request)
	1183	ENDIF
	1184
	1185	IF (SendDown) THEN
	1186	CALL Register_SendField(Field, ij, ll, jj_end - SDown + 1, SDown, MPI_Rank + 1, a_request)
	1187	ENDIF
	1188
	1189	IF (RecvUp) THEN
	1190	CALL Register_RecvField(Field, ij, ll, jj_begin - Rup, RUp, MPI_Rank - 1, a_request)
	1191	ENDIF
	1192
	1193	IF (RecvDown) THEN
	1194	CALL Register_RecvField(Field, ij, ll, jj_end + 1, RDown, MPI_Rank + 1, a_request)
	1195	ENDIF
	1196
	1197	END SUBROUTINE Register_Hallo
	1198
	1199
	1200	SUBROUTINE Register_Hallo_u(Field, ll, RUp, Rdown, SUp, SDown, a_request)
	1201	USE lmdz_dimensions
	1202	USE lmdz_paramet
[4600]	1203	USE lmdz_mpi
[5159]	1204	IMPLICIT NONE
	1205	INTEGER :: ll
	1206	REAL, DIMENSION(ijb_u:ije_u, ll) :: Field
	1207	INTEGER :: Sup, Sdown, rup, rdown
	1208	type(request) :: a_request
	1209	type(Hallo), pointer :: PtrHallo
	1210	LOGICAL :: SendUp, SendDown
	1211	LOGICAL :: RecvUp, RecvDown
[1632]	1212
[5159]	1213	SendUp = .TRUE.
	1214	SendDown = .TRUE.
	1215	RecvUp = .TRUE.
	1216	RecvDown = .TRUE.
[1632]	1217
[5159]	1218	IF (pole_nord) THEN
	1219	SendUp = .FALSE.
	1220	RecvUp = .FALSE.
	1221	ENDIF
[1632]	1222
[5159]	1223	IF (pole_sud) THEN
	1224	SendDown = .FALSE.
	1225	RecvDown = .FALSE.
	1226	ENDIF
	1227
	1228	IF (Sup==0) THEN
	1229	SendUp = .FALSE.
	1230	endif
	1231
	1232	IF (Sdown==0) THEN
	1233	SendDown = .FALSE.
	1234	endif
	1235
	1236	IF (Rup==0) THEN
	1237	RecvUp = .FALSE.
	1238	endif
	1239
	1240	IF (Rdown==0) THEN
	1241	RecvDown = .FALSE.
	1242	endif
	1243
	1244	IF (SendUp) THEN
	1245	CALL Register_SendField(Field, ijnb_u, ll, jj_begin - jjb_u + 1, SUp, MPI_Rank - 1, a_request)
	1246	ENDIF
	1247
	1248	IF (SendDown) THEN
	1249	CALL Register_SendField(Field, ijnb_u, ll, jj_end - SDown + 1 - jjb_u + 1, SDown, MPI_Rank + 1, a_request)
	1250	ENDIF
	1251
	1252	IF (RecvUp) THEN
	1253	CALL Register_RecvField(Field, ijnb_u, ll, jj_begin - Rup - jjb_u + 1, RUp, MPI_Rank - 1, a_request)
	1254	ENDIF
	1255
	1256	IF (RecvDown) THEN
	1257	CALL Register_RecvField(Field, ijnb_u, ll, jj_end + 1 - jjb_u + 1, RDown, MPI_Rank + 1, a_request)
	1258	ENDIF
	1259
	1260	END SUBROUTINE Register_Hallo_u
	1261
	1262	SUBROUTINE Register_Hallo_v(Field, ll, RUp, Rdown, SUp, SDown, a_request)
	1263	USE lmdz_dimensions
	1264	USE lmdz_paramet
	1265	USE lmdz_mpi
	1266	IMPLICIT NONE
	1267	INTEGER :: ll
	1268	REAL, DIMENSION(ijb_v:ije_v, ll) :: Field
	1269	INTEGER :: Sup, Sdown, rup, rdown
	1270	type(request) :: a_request
	1271	type(Hallo), pointer :: PtrHallo
	1272	LOGICAL :: SendUp, SendDown
	1273	LOGICAL :: RecvUp, RecvDown
	1274
	1275	SendUp = .TRUE.
	1276	SendDown = .TRUE.
	1277	RecvUp = .TRUE.
	1278	RecvDown = .TRUE.
	1279
	1280	IF (pole_nord) THEN
	1281	SendUp = .FALSE.
	1282	RecvUp = .FALSE.
	1283	ENDIF
	1284
	1285	IF (pole_sud) THEN
	1286	SendDown = .FALSE.
	1287	RecvDown = .FALSE.
	1288	ENDIF
	1289
	1290	IF (Sup==0) THEN
	1291	SendUp = .FALSE.
	1292	endif
	1293
	1294	IF (Sdown==0) THEN
	1295	SendDown = .FALSE.
	1296	endif
	1297
	1298	IF (Rup==0) THEN
	1299	RecvUp = .FALSE.
	1300	endif
	1301
	1302	IF (Rdown==0) THEN
	1303	RecvDown = .FALSE.
	1304	endif
	1305
	1306	IF (SendUp) THEN
	1307	CALL Register_SendField(Field, ijnb_v, ll, jj_begin - jjb_v + 1, SUp, MPI_Rank - 1, a_request)
	1308	ENDIF
	1309
	1310	IF (SendDown) THEN
	1311	CALL Register_SendField(Field, ijnb_v, ll, jj_end - SDown + 1 - jjb_v + 1, SDown, MPI_Rank + 1, a_request)
	1312	ENDIF
	1313
	1314	IF (RecvUp) THEN
	1315	CALL Register_RecvField(Field, ijnb_v, ll, jj_begin - Rup - jjb_v + 1, RUp, MPI_Rank - 1, a_request)
	1316	ENDIF
	1317
	1318	IF (RecvDown) THEN
	1319	CALL Register_RecvField(Field, ijnb_v, ll, jj_end + 1 - jjb_v + 1, RDown, MPI_Rank + 1, a_request)
	1320	ENDIF
	1321
	1322	END SUBROUTINE Register_Hallo_v
	1323
	1324	SUBROUTINE SendRequest(a_Request)
	1325	USE lmdz_dimensions
	1326	USE lmdz_paramet
	1327	USE lmdz_mpi
	1328	IMPLICIT NONE
	1329
	1330	type(request), target :: a_request
	1331	type(request_SR), pointer :: Req
	1332	type(Hallo), pointer :: PtrHallo
	1333	INTEGER :: SizeBuffer
	1334	INTEGER :: i, rank, l, ij, Pos, ierr
	1335	INTEGER :: offset
	1336	REAL, DIMENSION(:, :), pointer :: Field
	1337	INTEGER :: Nb
	1338
	1339	DO rank = 0, MPI_SIZE - 1
	1340
	1341	Req => a_Request%RequestSend(rank)
	1342
	1343	SizeBuffer = 0
	1344	DO i = 1, Req%NbRequest
	1345	PtrHallo => Req%Hallo(i)
	1346	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1347	DO l = 1, PtrHallo%NbLevel
	1348	SizeBuffer = SizeBuffer + PtrHallo%size * iip1
	1349	ENDDO
	1350	!$OMP ENDDO NOWAIT
	1351	enddo
	1352
	1353	Req%BufferSize = SizeBuffer
	1354	IF (Req%NbRequest>0) THEN
	1355	CALL allocate_buffer(SizeBuffer, Req%Index, Req%pos)
	1356
	1357	Pos = Req%Pos
	1358	DO i = 1, Req%NbRequest
	1359	PtrHallo => Req%Hallo(i)
	1360	offset = (PtrHallo%offset - 1) * iip1 + 1
	1361	Nb = iip1 * PtrHallo%size - 1
	1362	Field => PtrHallo%Field
	1363
	1364	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1365	DO l = 1, PtrHallo%NbLevel
	1366	!cdir NODEP
	1367	DO ij = 0, Nb
	1368	Buffer(Pos + ij) = Field(Offset + ij, l)
[1632]	1369	enddo
[5159]	1370
	1371	Pos = Pos + Nb + 1
[1632]	1372	enddo
[5159]	1373	!$OMP END DO NOWAIT
	1374	enddo
	1375
	1376	IF (SizeBuffer>0) THEN
	1377	!$OMP CRITICAL (MPI)
	1378
	1379	CALL MPI_ISEND(Buffer(req%Pos), SizeBuffer, MPI_REAL_LMDZ, rank, a_request%tag + 1000 * omp_rank, &
	1380	COMM_LMDZ, Req%MSG_Request, ierr)
	1381	IF (.NOT.using_mpi) THEN
	1382	PRINT *, 'Erreur, echange MPI en mode sequentiel !!!'
	1383	CALL abort_gcm("mod_hallo", "stopped", 1)
	1384	ENDIF
	1385	! PRINT *,"-------------------------------------------------------------------"
	1386	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->"
	1387	! PRINT ,"Requete envoye au proc :",rank,"tag :",a_request%tag+1000omp_rank
	1388	! PRINT *,"Taille du message :",SizeBuffer,"requete no :",Req%MSG_Request
	1389	! PRINT *,"-------------------------------------------------------------------"
	1390	!$OMP END CRITICAL (MPI)
[1632]	1391	endif
[5159]	1392	endif
[1632]	1393	enddo
	1394
[5159]	1395	DO rank = 0, MPI_SIZE - 1
[1632]	1396
[5159]	1397	Req => a_Request%RequestRecv(rank)
	1398	SizeBuffer = 0
[4600]	1399
[5159]	1400	DO i = 1, Req%NbRequest
	1401	PtrHallo => Req%Hallo(i)
[1632]	1402
[5159]	1403	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1404	DO l = 1, PtrHallo%NbLevel
	1405	SizeBuffer = SizeBuffer + PtrHallo%size * iip1
	1406	ENDDO
	1407	!$OMP ENDDO NOWAIT
	1408	enddo
[1632]	1409
[5159]	1410	Req%BufferSize = SizeBuffer
	1411
	1412	IF (Req%NbRequest>0) THEN
	1413	CALL allocate_buffer(SizeBuffer, Req%Index, Req%Pos)
	1414
	1415	IF (SizeBuffer>0) THEN
	1416	!$OMP CRITICAL (MPI)
	1417
	1418	CALL MPI_IRECV(Buffer(Req%Pos), SizeBuffer, MPI_REAL_LMDZ, rank, a_request%tag + 1000 * omp_rank, &
	1419	COMM_LMDZ, Req%MSG_Request, ierr)
	1420
	1421	IF (.NOT.using_mpi) THEN
	1422	PRINT *, 'Erreur, echange MPI en mode sequentiel !!!'
	1423	CALL abort_gcm("mod_hallo", "stopped", 1)
	1424	ENDIF
	1425
	1426	! PRINT *,"-------------------------------------------------------------------"
	1427	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->"
	1428	! PRINT ,"Requete en attente du proc :",rank,"tag :",a_request%tag+1000omp_rank
	1429	! PRINT *,"Taille du message :",SizeBuffer,"requete no :",Req%MSG_Request
	1430	! PRINT *,"-------------------------------------------------------------------"
	1431
	1432	!$OMP END CRITICAL (MPI)
[1632]	1433	endif
	1434	endif
	1435
[5159]	1436	enddo
	1437
	1438	END SUBROUTINE SendRequest
	1439
	1440	SUBROUTINE WaitRequest(a_Request)
	1441	USE lmdz_dimensions
	1442	USE lmdz_paramet
	1443	USE lmdz_mpi
	1444	IMPLICIT NONE
	1445
	1446	type(request), target :: a_request
	1447	type(request_SR), pointer :: Req
	1448	type(Hallo), pointer :: PtrHallo
	1449	INTEGER, DIMENSION(2 * mpi_size) :: TabRequest
	1450	INTEGER, DIMENSION(MPI_STATUS_SIZE, 2 * mpi_size) :: TabStatus
	1451	INTEGER :: NbRequest
	1452	INTEGER :: i, rank, pos, ij, l, ierr
	1453	INTEGER :: offset
	1454	INTEGER :: Nb
	1455
	1456	NbRequest = 0
	1457	DO rank = 0, MPI_SIZE - 1
	1458	Req => a_request%RequestSend(rank)
	1459	IF (Req%NbRequest>0 .AND. Req%BufferSize > 0) THEN
	1460	NbRequest = NbRequest + 1
	1461	TabRequest(NbRequest) = Req%MSG_Request
	1462	endif
	1463	enddo
	1464
	1465	DO rank = 0, MPI_SIZE - 1
	1466	Req => a_request%RequestRecv(rank)
	1467	IF (Req%NbRequest>0 .AND. Req%BufferSize > 0) THEN
	1468	NbRequest = NbRequest + 1
	1469	TabRequest(NbRequest) = Req%MSG_Request
	1470	endif
	1471	enddo
	1472
	1473	IF (NbRequest>0) THEN
	1474	!$OMP CRITICAL (MPI)
	1475	! PRINT *,"-------------------------------------------------------------------"
	1476	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
	1477	! PRINT *,"No des requetes :",TabRequest(1:NbRequest)
	1478	CALL MPI_WAITALL(NbRequest, TabRequest, TabStatus, ierr)
	1479	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
	1480	! PRINT *,"-------------------------------------------------------------------"
	1481	!$OMP END CRITICAL (MPI)
	1482	endif
	1483	DO rank = 0, MPI_Size - 1
	1484	Req => a_request%RequestRecv(rank)
	1485	IF (Req%NbRequest>0) THEN
	1486	Pos = Req%Pos
	1487	DO i = 1, Req%NbRequest
	1488	PtrHallo => Req%Hallo(i)
	1489	offset = (PtrHallo%offset - 1) * iip1 + 1
	1490	Nb = iip1 * PtrHallo%size - 1
	1491
	1492	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1493	DO l = 1, PtrHallo%NbLevel
	1494	!cdir NODEP
	1495	DO ij = 0, Nb
	1496	PtrHallo%Field(offset + ij, l) = Buffer(Pos + ij)
	1497	enddo
	1498
	1499	Pos = Pos + Nb + 1
[5158]	1500	enddo
[5159]	1501	!$OMP ENDDO NOWAIT
[5158]	1502	enddo
[5159]	1503	endif
	1504	enddo
[1632]	1505
[5159]	1506	DO rank = 0, MPI_SIZE - 1
	1507	Req => a_request%RequestSend(rank)
	1508	IF (Req%NbRequest>0) THEN
	1509	CALL deallocate_buffer(Req%Index)
	1510	Req%NbRequest = 0
	1511	endif
	1512	enddo
[1632]	1513
[5159]	1514	DO rank = 0, MPI_SIZE - 1
	1515	Req => a_request%RequestRecv(rank)
	1516	IF (Req%NbRequest>0) THEN
	1517	CALL deallocate_buffer(Req%Index)
	1518	Req%NbRequest = 0
[1632]	1519	endif
[5159]	1520	enddo
	1521
	1522	a_request%tag = 1
	1523	END SUBROUTINE WaitRequest
	1524
	1525	SUBROUTINE WaitSendRequest(a_Request)
	1526	USE lmdz_mpi
	1527	USE lmdz_dimensions
	1528	USE lmdz_paramet
	1529	IMPLICIT NONE
	1530
	1531	type(request), target :: a_request
	1532	type(request_SR), pointer :: Req
	1533	type(Hallo), pointer :: PtrHallo
	1534	INTEGER, DIMENSION(mpi_size) :: TabRequest
	1535	INTEGER, DIMENSION(MPI_STATUS_SIZE, mpi_size) :: TabStatus
	1536	INTEGER :: NbRequest
	1537	INTEGER :: i, rank, pos, ij, l, ierr
	1538	INTEGER :: offset
	1539
	1540	NbRequest = 0
	1541	DO rank = 0, MPI_SIZE - 1
	1542	Req => a_request%RequestSend(rank)
	1543	IF (Req%NbRequest>0) THEN
	1544	NbRequest = NbRequest + 1
	1545	TabRequest(NbRequest) = Req%MSG_Request
	1546	endif
	1547	enddo
	1548
	1549	IF (NbRequest>0 .AND. Req%BufferSize > 0) THEN
	1550	!$OMP CRITICAL (MPI)
	1551	! PRINT *,"-------------------------------------------------------------------"
	1552	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
	1553	! PRINT *,"No des requetes :",TabRequest(1:NbRequest)
	1554	CALL MPI_WAITALL(NbRequest, TabRequest, TabStatus, ierr)
	1555	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
	1556	! PRINT *,"-------------------------------------------------------------------"
	1557
	1558	!$OMP END CRITICAL (MPI)
	1559	endif
	1560
	1561	DO rank = 0, MPI_SIZE - 1
	1562	Req => a_request%RequestSend(rank)
	1563	IF (Req%NbRequest>0) THEN
	1564	CALL deallocate_buffer(Req%Index)
	1565	Req%NbRequest = 0
	1566	endif
	1567	enddo
	1568
	1569	a_request%tag = 1
	1570	END SUBROUTINE WaitSendRequest
	1571
	1572	SUBROUTINE WaitRecvRequest(a_Request)
	1573	USE lmdz_dimensions
	1574	USE lmdz_paramet
	1575	USE lmdz_mpi
	1576	IMPLICIT NONE
	1577	type(request), target :: a_request
	1578	type(request_SR), pointer :: Req
	1579	type(Hallo), pointer :: PtrHallo
	1580	INTEGER, DIMENSION(mpi_size) :: TabRequest
	1581	INTEGER, DIMENSION(MPI_STATUS_SIZE, mpi_size) :: TabStatus
	1582	INTEGER :: NbRequest
	1583	INTEGER :: i, rank, pos, ij, l, ierr
	1584	INTEGER :: offset, Nb
	1585
	1586	NbRequest = 0
	1587
	1588	DO rank = 0, MPI_SIZE - 1
	1589	Req => a_request%RequestRecv(rank)
	1590	IF (Req%NbRequest>0 .AND. Req%BufferSize > 0) THEN
	1591	NbRequest = NbRequest + 1
	1592	TabRequest(NbRequest) = Req%MSG_Request
	1593	endif
	1594	enddo
	1595
	1596	IF (NbRequest>0) THEN
	1597	!$OMP CRITICAL (MPI)
	1598	! PRINT *,"-------------------------------------------------------------------"
	1599	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
	1600	! PRINT *,"No des requetes :",TabRequest(1:NbRequest)
	1601	CALL MPI_WAITALL(NbRequest, TabRequest, TabStatus, ierr)
	1602	! PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
	1603	! PRINT *,"-------------------------------------------------------------------"
	1604	!$OMP END CRITICAL (MPI)
	1605	endif
	1606
	1607	DO rank = 0, MPI_Size - 1
	1608	Req => a_request%RequestRecv(rank)
	1609	IF (Req%NbRequest>0) THEN
	1610	Pos = Req%Pos
	1611	DO i = 1, Req%NbRequest
	1612	PtrHallo => Req%Hallo(i)
	1613	offset = (PtrHallo%offset - 1) * iip1 + 1
	1614	Nb = iip1 * PtrHallo%size - 1
	1615	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1616	DO l = 1, PtrHallo%NbLevel
	1617	!cdir NODEP
	1618	DO ij = 0, Nb
	1619	PtrHallo%Field(offset + ij, l) = Buffer(Pos + ij)
[1632]	1620	enddo
[5159]	1621	Pos = Pos + Nb + 1
[1632]	1622	enddo
[5159]	1623	!$OMP END DO NOWAIT
	1624	enddo
	1625	endif
[1632]	1626	enddo
	1627
[5159]	1628	DO rank = 0, MPI_SIZE - 1
	1629	Req => a_request%RequestRecv(rank)
	1630	IF (Req%NbRequest>0) THEN
	1631	CALL deallocate_buffer(Req%Index)
	1632	Req%NbRequest = 0
	1633	endif
	1634	enddo
	1635
	1636	a_request%tag = 1
	1637	END SUBROUTINE WaitRecvRequest
	1638
	1639
	1640	SUBROUTINE CopyField(FieldS, FieldR, ij, ll, jj_Nb_New)
	1641	USE lmdz_dimensions
	1642	USE lmdz_paramet
	1643
	1644	IMPLICIT NONE
	1645
	1646	INTEGER :: ij, ll, l
	1647	REAL, DIMENSION(ij, ll) :: FieldS
	1648	REAL, DIMENSION(ij, ll) :: FieldR
	1649	INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Nb_New
	1650	INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Begin_New, jj_End_New
	1651
	1652	INTEGER :: i, jje, jjb, ijb, ije
	1653
	1654	jj_begin_New(0) = 1
	1655	jj_End_New(0) = jj_Nb_New(0)
	1656	DO i = 1, MPI_Size - 1
	1657	jj_begin_New(i) = jj_end_New(i - 1) + 1
	1658	jj_end_New(i) = jj_begin_new(i) + jj_Nb_New(i) - 1
	1659	enddo
	1660
	1661	jjb = max(jj_begin, jj_begin_new(MPI_Rank))
	1662	jje = min(jj_end, jj_end_new(MPI_Rank))
	1663	IF (ij==ip1jm) jje = min(jje, jjm)
	1664
[5117]	1665	IF (jje >= jjb) THEN
[5159]	1666	ijb = (jjb - 1) * iip1 + 1
	1667	ije = jje * iip1
[1632]	1668
[5159]	1669	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1670	DO l = 1, ll
	1671	FieldR(ijb:ije, l) = FieldS(ijb:ije, l)
[1632]	1672	enddo
[5159]	1673	!$OMP ENDDO NOWAIT
[1632]	1674	endif
	1675
[5103]	1676	END SUBROUTINE CopyField
[1632]	1677
[5159]	1678	SUBROUTINE CopyFieldHallo(FieldS, FieldR, ij, ll, jj_Nb_New, Up, Down)
	1679	USE lmdz_dimensions
	1680	USE lmdz_paramet
[1632]	1681
[5159]	1682	IMPLICIT NONE
[1632]	1683
[5159]	1684	INTEGER :: ij, ll, Up, Down
	1685	REAL, DIMENSION(ij, ll) :: FieldS
	1686	REAL, DIMENSION(ij, ll) :: FieldR
	1687	INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Nb_New
	1688	INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Begin_New, jj_End_New
	1689
	1690	INTEGER :: i, jje, jjb, ijb, ije, l
	1691
	1692	jj_begin_New(0) = 1
	1693	jj_End_New(0) = jj_Nb_New(0)
	1694	DO i = 1, MPI_Size - 1
	1695	jj_begin_New(i) = jj_end_New(i - 1) + 1
	1696	jj_end_New(i) = jj_begin_new(i) + jj_Nb_New(i) - 1
[1632]	1697	enddo
	1698
[5159]	1699	jjb = max(jj_begin, jj_begin_new(MPI_Rank) - Up)
	1700	jje = min(jj_end, jj_end_new(MPI_Rank) + Down)
	1701	IF (ij==ip1jm) jje = min(jje, jjm)
	1702
[5117]	1703	IF (jje >= jjb) THEN
[5159]	1704	ijb = (jjb - 1) * iip1 + 1
	1705	ije = jje * iip1
[1632]	1706
[5159]	1707	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1708	DO l = 1, ll
	1709	FieldR(ijb:ije, l) = FieldS(ijb:ije, l)
[1632]	1710	enddo
[5159]	1711	!$OMP ENDDO NOWAIT
[1632]	1712
	1713	endif
[5159]	1714	END SUBROUTINE CopyFieldHallo
[1632]	1715
[5159]	1716	SUBROUTINE Gather_field_u(field_loc, field_glo, ll)
	1717	USE lmdz_dimensions
	1718	USE lmdz_paramet
	1719	IMPLICIT NONE
	1720	INTEGER :: ll
	1721	REAL :: field_loc(ijb_u:ije_u, ll)
	1722	REAL :: field_glo(ip1jmp1, ll)
	1723	type(request) :: request_gather
	1724	INTEGER :: l
[1632]	1725
	1726
[5159]	1727	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1728	DO l = 1, ll
	1729	field_glo(ij_begin:ij_end, l) = field_loc(ij_begin:ij_end, l)
	1730	ENDDO
[1632]	1731
[5159]	1732	CALL register_SwapField(field_glo, field_glo, ip1jmp1, ll, distrib_gather%jj_nb_para, request_gather)
	1733	CALL SendRequest(request_gather)
	1734	!$OMP BARRIER
	1735	CALL WaitRequest(request_gather)
	1736	!$OMP BARRIER
[1632]	1737
[5159]	1738	END SUBROUTINE Gather_field_u
[1632]	1739
[5159]	1740	SUBROUTINE Gather_field_v(field_loc, field_glo, ll)
	1741	USE lmdz_dimensions
	1742	USE lmdz_paramet
	1743	IMPLICIT NONE
	1744	INTEGER :: ll
	1745	REAL :: field_loc(ijb_v:ije_v, ll)
	1746	REAL :: field_glo(ip1jm, ll)
	1747	type(request) :: request_gather
	1748	INTEGER :: ijb, ije
	1749	INTEGER :: l
[1632]	1750
[5159]	1751	ijb = ij_begin
	1752	ije = ij_end
	1753	IF (pole_sud) ije = ij_end - iip1
[1632]	1754
[5159]	1755	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1756	DO l = 1, ll
	1757	field_glo(ijb:ije, l) = field_loc(ijb:ije, l)
	1758	ENDDO
[1632]	1759
[5159]	1760	CALL register_SwapField(field_glo, field_glo, ip1jm, ll, distrib_gather%jj_nb_para, request_gather)
	1761	CALL SendRequest(request_gather)
	1762	!$OMP BARRIER
	1763	CALL WaitRequest(request_gather)
	1764	!$OMP BARRIER
[1632]	1765
[5159]	1766	END SUBROUTINE Gather_field_v
	1767
	1768	SUBROUTINE Scatter_field_u(field_glo, field_loc, ll)
	1769	USE lmdz_dimensions
	1770	USE lmdz_paramet
	1771	IMPLICIT NONE
	1772	INTEGER :: ll
	1773	REAL :: field_glo(ip1jmp1, ll)
	1774	REAL :: field_loc(ijb_u:ije_u, ll)
	1775	type(request) :: request_gather
	1776	TYPE(distrib) :: distrib_swap
	1777	INTEGER :: l
	1778
	1779	!$OMP BARRIER
	1780	!$OMP MASTER
	1781	CALL get_current_distrib(distrib_swap)
	1782	CALL set_Distrib(distrib_gather)
	1783	!$OMP END MASTER
	1784	!$OMP BARRIER
	1785
	1786	CALL register_SwapField(field_glo, field_glo, ip1jmp1, ll, distrib_swap%jj_nb_para, request_gather)
	1787	CALL SendRequest(request_gather)
	1788	!$OMP BARRIER
	1789	CALL WaitRequest(request_gather)
	1790	!$OMP BARRIER
	1791	!$OMP MASTER
	1792	CALL set_Distrib(distrib_swap)
	1793	!$OMP END MASTER
	1794	!$OMP BARRIER
	1795
	1796	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1797	DO l = 1, ll
	1798	field_loc(ij_begin:ij_end, l) = field_glo(ij_begin:ij_end, l)
	1799	ENDDO
	1800
	1801	END SUBROUTINE Scatter_field_u
	1802
	1803	SUBROUTINE Scatter_field_v(field_glo, field_loc, ll)
	1804	USE lmdz_dimensions
	1805	USE lmdz_paramet
	1806	IMPLICIT NONE
	1807	INTEGER :: ll
	1808	REAL :: field_glo(ip1jmp1, ll)
	1809	REAL :: field_loc(ijb_v:ije_v, ll)
	1810	type(request) :: request_gather
	1811	TYPE(distrib) :: distrib_swap
	1812	INTEGER :: ijb, ije, l
	1813
	1814
	1815	!$OMP BARRIER
	1816	!$OMP MASTER
	1817	CALL get_current_distrib(distrib_swap)
	1818	CALL set_Distrib(distrib_gather)
	1819	!$OMP END MASTER
	1820	!$OMP BARRIER
	1821	CALL register_SwapField(field_glo, field_glo, ip1jm, ll, distrib_swap%jj_nb_para, request_gather)
	1822	CALL SendRequest(request_gather)
	1823	!$OMP BARRIER
	1824	CALL WaitRequest(request_gather)
	1825	!$OMP BARRIER
	1826	!$OMP MASTER
	1827	CALL set_Distrib(distrib_swap)
	1828	!$OMP END MASTER
	1829	!$OMP BARRIER
	1830	ijb = ij_begin
	1831	ije = ij_end
	1832	IF (pole_sud) ije = ij_end - iip1
	1833
	1834	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1835	DO l = 1, ll
	1836	field_loc(ijb:ije, l) = field_glo(ijb:ije, l)
	1837	ENDDO
	1838
	1839	END SUBROUTINE Scatter_field_v
	1840
[5119]	1841	END MODULE mod_Hallo
[1632]	1842

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

Download in other formats:

Original Format