Context Navigation

bands.F90 @ 782

Last change on this file since 782 was 774, checked in by Laurent Fairhead, 17 years ago
Suite du merge entre la version et la HEAD: quelques modifications de Yann sur le LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 11.1 KB

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

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

Download in other formats:

Original Format