Context Navigation

bands.F90 @ 2791

Last change on this file since 2791 was 1279, checked in by Laurent Fairhead, 15 years ago
Merged LMDZ4-dev branch changes r1241:1278 into the trunk Running trunk and LMDZ4-dev in LMDZOR configuration on local machine (sequential) and SX8 (4-proc) yields identical results (restart and restartphy are identical binarily) Log history from r1241 to r1278 is available by switching to source:LMDZ4/branches/LMDZ4-dev-20091210
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 11.5 KB

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

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

Download in other formats:

Original Format