Context Navigation

bands.F90 @ 3927

Last change on this file since 3927 was 3826, checked in by ymipsl, 10 years ago

Bug fix. Works now on one proc, but always some problems in parallel.

File size: 13.3 KB

Line
1	!
2	! $Id$
3	!
4	module Bands
5	USE parallel_lmdz
6	integer, parameter :: bands_caldyn=1
7	integer, parameter :: bands_vanleer=2
8	integer, parameter :: bands_dissip=3
9
10	INTEGER,dimension(:),allocatable :: jj_Nb_Caldyn
11	INTEGER,dimension(:),allocatable :: jj_Nb_vanleer
12	INTEGER,dimension(:),allocatable :: jj_Nb_vanleer2
13	INTEGER,dimension(:),allocatable :: jj_Nb_dissip
14	INTEGER,dimension(:),allocatable :: jj_Nb_physic
15	INTEGER,dimension(:),allocatable :: jj_Nb_physic_bis
16
17	TYPE(distrib),SAVE,TARGET :: distrib_Caldyn
18	TYPE(distrib),SAVE,TARGET :: distrib_vanleer
19	TYPE(distrib),SAVE,TARGET :: distrib_vanleer2
20	TYPE(distrib),SAVE,TARGET :: distrib_dissip
21	TYPE(distrib),SAVE,TARGET :: distrib_physic
22	TYPE(distrib),SAVE,TARGET :: distrib_physic_bis
23
24	INTEGER,dimension(:),allocatable :: distrib_phys
25
26	contains
27
28	subroutine AllocateBands
29	USE parallel_lmdz
30	implicit none
31
32	allocate(jj_Nb_Caldyn(0:MPI_Size-1))
33	allocate(jj_Nb_vanleer(0:MPI_Size-1))
34	allocate(jj_Nb_vanleer2(0:MPI_Size-1))
35	allocate(jj_Nb_dissip(0:MPI_Size-1))
36	allocate(jj_Nb_physic(0:MPI_Size-1))
37	allocate(jj_Nb_physic_bis(0:MPI_Size-1))
38	allocate(distrib_phys(0:MPI_Size-1))
39
40	end subroutine AllocateBands
41
42	subroutine Read_distrib
43	USE parallel_lmdz
44	implicit none
45
46	include "dimensions.h"
47	integer :: i,j
48	character (len=4) :: siim,sjjm,sllm,sproc
49	character (len=255) :: filename
50	integer :: unit_number=10
51	integer :: ierr
52
53	call AllocateBands
54	write(siim,'(i3)') iim
55	write(sjjm,'(i3)') jjm
56	write(sllm,'(i3)') llm
57	write(sproc,'(i3)') mpi_size
58	filename='Bands_'//TRIM(ADJUSTL(siim))//'x'//TRIM(ADJUSTL(sjjm))//'x'//TRIM(ADJUSTL(sllm))//'_' &
59	//TRIM(ADJUSTL(sproc))//'prc.dat'
60
61	OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='old',FORM='formatted',IOSTAT=ierr)
62
63	if (ierr==0) then
64
65	do i=0,mpi_size-1
66	read (unit_number,*) j,jj_nb_caldyn(i)
67	enddo
68
69	do i=0,mpi_size-1
70	read (unit_number,*) j,jj_nb_vanleer(i)
71	enddo
72
73	do i=0,mpi_size-1
74	read (unit_number,*) j,jj_nb_dissip(i)
75	enddo
76
77	do i=0,mpi_size-1
78	read (unit_number,*) j,distrib_phys(i)
79	enddo
80
81	CLOSE(unit_number)
82
83	else
84	do i=0,mpi_size-1
85	jj_nb_caldyn(i)=(jjm+1)/mpi_size
86	if (i<MOD(jjm+1,mpi_size)) jj_nb_caldyn(i)=jj_nb_caldyn(i)+1
87	enddo
88
89	jj_nb_vanleer(:)=jj_nb_caldyn(:)
90	jj_nb_dissip(:)=jj_nb_caldyn(:)
91
92	do i=0,mpi_size-1
93	distrib_phys(i)=(iim*(jjm-1)+2)/mpi_size
94	IF (i<MOD(iim*(jjm-1)+2,mpi_size)) distrib_phys(i)=distrib_phys(i)+1
95	enddo
96	endif
97
98	! distrib_phys(:)=jj_nb_caldyn(:)*iim
99	! distrib_phys(0) = distrib_phys(0) - (iim-1)
100	! distrib_phys(mpi_size-1) = distrib_phys(mpi_size-1) - (iim-1)
101
102	end subroutine Read_distrib
103
104
105	SUBROUTINE Set_Bands
106	USE parallel_lmdz
107	IMPLICIT NONE
108	INCLUDE 'dimensions.h'
109	INTEGER :: i, ij
110	INTEGER :: jj_para_begin(0:mpi_size-1)
111	INTEGER :: jj_para_end(0:mpi_size-1)
112
113	do i=0,mpi_size-1
114	jj_nb_vanleer2(i)=(jjm+1)/mpi_size
115	if (i<MOD(jjm+1,mpi_size)) jj_nb_vanleer2(i)=jj_nb_vanleer2(i)+1
116	enddo
117
118	jj_para_begin(0)=1
119	ij=distrib_phys(0)+iim-1
120	jj_para_end(0)=((ij-1)/iim)+1
121
122	DO i=1,mpi_Size-1
123	ij=ij+1
124	jj_para_begin(i)=((ij-1)/iim)+1
125	ij=ij+distrib_phys(i)-1
126	jj_para_end(i)=((ij-1)/iim)+1
127	ENDDO
128
129	do i=0,MPI_Size-1
130	jj_Nb_physic(i)=jj_para_end(i)-jj_para_begin(i)+1
131	if (i/=0) then
132	if (jj_para_begin(i)==jj_para_end(i-1)) then
133	jj_Nb_physic(i-1)=jj_Nb_physic(i-1)-1
134	endif
135	endif
136	enddo
137
138	do i=0,MPI_Size-1
139	jj_Nb_physic_bis(i)=jj_para_end(i)-jj_para_begin(i)+1
140	if (i/=0) then
141	if (jj_para_begin(i)==jj_para_end(i-1)) then
142	jj_Nb_physic_bis(i)=jj_Nb_physic_bis(i)-1
143	else
144	jj_Nb_physic_bis(i-1)=jj_Nb_physic_bis(i-1)+1
145	jj_Nb_physic_bis(i)=jj_Nb_physic_bis(i)-1
146	endif
147	endif
148	enddo
149
150	CALL create_distrib(jj_Nb_Caldyn,distrib_caldyn)
151	CALL create_distrib(jj_Nb_vanleer,distrib_vanleer)
152	CALL create_distrib(jj_Nb_vanleer2,distrib_vanleer2)
153	CALL create_distrib(jj_Nb_dissip,distrib_dissip)
154	CALL create_distrib(jj_Nb_physic,distrib_physic)
155	CALL create_distrib(jj_Nb_physic_bis,distrib_physic_bis)
156
157	distrib_physic_bis%jjb_u=distrib_physic%jjb_u
158	distrib_physic_bis%jje_u=distrib_physic%jje_u
159	distrib_physic_bis%jjnb_u=distrib_physic%jjnb_u
160
161	distrib_physic_bis%ijb_u=distrib_physic%ijb_u
162	distrib_physic_bis%ije_u=distrib_physic%ije_u
163	distrib_physic_bis%ijnb_u=distrib_physic%ijnb_u
164
165	distrib_physic_bis%jjb_v=distrib_physic%jjb_v
166	distrib_physic_bis%jje_v=distrib_physic%jje_v
167	distrib_physic_bis%jjnb_v=distrib_physic%jjnb_v
168
169	distrib_physic_bis%ijb_v=distrib_physic%ijb_v
170	distrib_physic_bis%ije_v=distrib_physic%ije_v
171	distrib_physic_bis%ijnb_v=distrib_physic%ijnb_v
172
173	end subroutine Set_Bands
174
175
176	subroutine AdjustBands_caldyn(new_dist)
177	use times
178	USE parallel_lmdz
179	implicit none
180	TYPE(distrib),INTENT(INOUT) :: new_dist
181
182	real :: minvalue,maxvalue
183	integer :: min_proc,max_proc
184	integer :: i,j
185	real,allocatable,dimension(:) :: value
186	integer,allocatable,dimension(:) :: index
187	real :: tmpvalue
188	integer :: tmpindex
189
190	allocate(value(0:mpi_size-1))
191	allocate(index(0:mpi_size-1))
192
193
194	call allgather_timer_average
195
196	do i=0,mpi_size-1
197	value(i)=timer_average(jj_nb_caldyn(i),timer_caldyn,i)
198	index(i)=i
199	enddo
200
201	do i=0,mpi_size-2
202	do j=i+1,mpi_size-1
203	if (value(i)>value(j)) then
204	tmpvalue=value(i)
205	value(i)=value(j)
206	value(j)=tmpvalue
207
208	tmpindex=index(i)
209	index(i)=index(j)
210	index(j)=tmpindex
211	endif
212	enddo
213	enddo
214
215	maxvalue=value(mpi_size-1)
216	max_proc=index(mpi_size-1)
217
218	do i=0,mpi_size-2
219	minvalue=value(i)
220	min_proc=index(i)
221	if (jj_nb_caldyn(max_proc)>3) then
222	if (timer_iteration(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc)<=1 ) then
223	jj_nb_caldyn(min_proc)=jj_nb_caldyn(min_proc)+1
224	jj_nb_caldyn(max_proc)=jj_nb_caldyn(max_proc)-1
225	exit
226	else
227	if (timer_average(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc) &
228	-timer_delta(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc) < maxvalue) then
229	jj_nb_caldyn(min_proc)=jj_nb_caldyn(min_proc)+1
230	jj_nb_caldyn(max_proc)=jj_nb_caldyn(max_proc)-1
231	exit
232	endif
233	endif
234	endif
235	enddo
236
237	deallocate(value)
238	deallocate(index)
239	CALL create_distrib(jj_nb_caldyn,new_dist)
240
241	end subroutine AdjustBands_caldyn
242
243	subroutine AdjustBands_vanleer(new_dist)
244	use times
245	USE parallel_lmdz
246	implicit none
247	TYPE(distrib),INTENT(INOUT) :: new_dist
248
249	real :: minvalue,maxvalue
250	integer :: min_proc,max_proc
251	integer :: i,j
252	real,allocatable,dimension(:) :: value
253	integer,allocatable,dimension(:) :: index
254	real :: tmpvalue
255	integer :: tmpindex
256
257	allocate(value(0:mpi_size-1))
258	allocate(index(0:mpi_size-1))
259
260
261	call allgather_timer_average
262
263	do i=0,mpi_size-1
264	value(i)=timer_average(jj_nb_vanleer(i),timer_vanleer,i)
265	index(i)=i
266	enddo
267
268	do i=0,mpi_size-2
269	do j=i+1,mpi_size-1
270	if (value(i)>value(j)) then
271	tmpvalue=value(i)
272	value(i)=value(j)
273	value(j)=tmpvalue
274
275	tmpindex=index(i)
276	index(i)=index(j)
277	index(j)=tmpindex
278	endif
279	enddo
280	enddo
281
282	maxvalue=value(mpi_size-1)
283	max_proc=index(mpi_size-1)
284
285	do i=0,mpi_size-2
286	minvalue=value(i)
287	min_proc=index(i)
288
289	if (jj_nb_vanleer(max_proc)>3) then
290	if (timer_average(jj_nb_vanleer(min_proc)+1,timer_vanleer,min_proc)==0. .or. &
291	timer_average(jj_nb_vanleer(max_proc)-1,timer_vanleer,max_proc)==0.) then
292	jj_nb_vanleer(min_proc)=jj_nb_vanleer(min_proc)+1
293	jj_nb_vanleer(max_proc)=jj_nb_vanleer(max_proc)-1
294	exit
295	else
296	if (timer_average(jj_nb_vanleer(min_proc)+1,timer_vanleer,min_proc) < maxvalue) then
297	jj_nb_vanleer(min_proc)=jj_nb_vanleer(min_proc)+1
298	jj_nb_vanleer(max_proc)=jj_nb_vanleer(max_proc)-1
299	exit
300	endif
301	endif
302	endif
303	enddo
304
305	deallocate(value)
306	deallocate(index)
307
308	CALL create_distrib(jj_nb_vanleer,new_dist)
309
310	end subroutine AdjustBands_vanleer
311
312	subroutine AdjustBands_dissip(new_dist)
313	use times
314	USE parallel_lmdz
315	implicit none
316	TYPE(distrib),INTENT(INOUT) :: new_dist
317
318	real :: minvalue,maxvalue
319	integer :: min_proc,max_proc
320	integer :: i,j
321	real,allocatable,dimension(:) :: value
322	integer,allocatable,dimension(:) :: index
323	real :: tmpvalue
324	integer :: tmpindex
325
326	allocate(value(0:mpi_size-1))
327	allocate(index(0:mpi_size-1))
328
329
330	call allgather_timer_average
331
332	do i=0,mpi_size-1
333	value(i)=timer_average(jj_nb_dissip(i),timer_dissip,i)
334	index(i)=i
335	enddo
336
337	do i=0,mpi_size-2
338	do j=i+1,mpi_size-1
339	if (value(i)>value(j)) then
340	tmpvalue=value(i)
341	value(i)=value(j)
342	value(j)=tmpvalue
343
344	tmpindex=index(i)
345	index(i)=index(j)
346	index(j)=tmpindex
347	endif
348	enddo
349	enddo
350
351	maxvalue=value(mpi_size-1)
352	max_proc=index(mpi_size-1)
353
354	do i=0,mpi_size-2
355	minvalue=value(i)
356	min_proc=index(i)
357
358	if (jj_nb_dissip(max_proc)>3) then
359	if (timer_iteration(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc)<=1) then
360	jj_nb_dissip(min_proc)=jj_nb_dissip(min_proc)+1
361	jj_nb_dissip(max_proc)=jj_nb_dissip(max_proc)-1
362	exit
363	else
364	if (timer_average(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc) &
365	- timer_delta(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc) < maxvalue) then
366	jj_nb_dissip(min_proc)=jj_nb_dissip(min_proc)+1
367	jj_nb_dissip(max_proc)=jj_nb_dissip(max_proc)-1
368	exit
369	endif
370	endif
371	endif
372	enddo
373
374	deallocate(value)
375	deallocate(index)
376
377	CALL create_distrib(jj_nb_dissip,new_dist)
378
379	end subroutine AdjustBands_dissip
380
381	subroutine AdjustBands_physic
382	use times
383	#ifdef CPP_PHYS
384	! Ehouarn: what follows is only related to // physics
385	USE mod_phys_lmdz_para, only : klon_mpi_para_nb
386	#endif
387	USE parallel_lmdz
388	implicit none
389
390	integer :: i,Index
391	real,allocatable,dimension(:) :: value
392	integer,allocatable,dimension(:) :: Inc
393	real :: medium
394	integer :: NbTot,sgn
395
396	allocate(value(0:mpi_size-1))
397	allocate(Inc(0:mpi_size-1))
398
399
400	call allgather_timer_average
401
402	medium=0
403	do i=0,mpi_size-1
404	value(i)=timer_average(jj_nb_physic(i),timer_physic,i)
405	medium=medium+value(i)
406	enddo
407
408	medium=medium/mpi_size
409	NbTot=0
410	#ifdef CPP_PHYS
411	do i=0,mpi_size-1
412	Inc(i)=nint(klon_mpi_para_nb(i)*(medium-value(i))/value(i))
413	NbTot=NbTot+Inc(i)
414	enddo
415
416	if (NbTot>=0) then
417	Sgn=1
418	else
419	Sgn=-1
420	NbTot=-NbTot
421	endif
422
423	Index=0
424	do i=1,NbTot
425	Inc(Index)=Inc(Index)-Sgn
426	Index=Index+1
427	if (Index>mpi_size-1) Index=0
428	enddo
429
430	do i=0,mpi_size-1
431	distrib_phys(i)=klon_mpi_para_nb(i)+inc(i)
432	enddo
433	#endif
434
435	end subroutine AdjustBands_physic
436
437	subroutine WriteBands
438	USE parallel_lmdz
439	implicit none
440	include "dimensions.h"
441
442	integer :: i,j
443	character (len=4) :: siim,sjjm,sllm,sproc
444	character (len=255) :: filename
445	integer :: unit_number=10
446	integer :: ierr
447
448	write(siim,'(i3)') iim
449	write(sjjm,'(i3)') jjm
450	write(sllm,'(i3)') llm
451	write(sproc,'(i3)') mpi_size
452
453	filename='Bands_'//TRIM(ADJUSTL(siim))//'x'//TRIM(ADJUSTL(sjjm))//'x'//TRIM(ADJUSTL(sllm))//'_' &
454	//TRIM(ADJUSTL(sproc))//'prc.dat'
455
456	OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='replace',FORM='formatted',IOSTAT=ierr)
457
458	if (ierr==0) then
459
460	! write (unit_number,) ' Bandes caldyn *'
461	do i=0,mpi_size-1
462	write (unit_number,*) i,jj_nb_caldyn(i)
463	enddo
464
465	! write (unit_number,) ' Bandes vanleer *'
466	do i=0,mpi_size-1
467	write (unit_number,*) i,jj_nb_vanleer(i)
468	enddo
469
470	! write (unit_number,) ' Bandes dissip *'
471	do i=0,mpi_size-1
472	write (unit_number,*) i,jj_nb_dissip(i)
473	enddo
474
475	do i=0,mpi_size-1
476	write (unit_number,*) i,distrib_phys(i)
477	enddo
478
479	CLOSE(unit_number)
480	else
481	print *,'probleme lors de l ecriture des bandes'
482	endif
483
484	end subroutine WriteBands
485
486	end module Bands
487
488

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

Download in other formats:

Original Format