Context Navigation

bands.F90 @ 3855

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

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

Download in other formats:

Original Format