Context Navigation

bands.F90 @ 2057

Last change on this file since 2057 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

Rev	Line
[1279]	1	!
	2	! $Id: bands.F90 1279 2009-12-10 09:02:56Z emillour $
	3	!
[630]	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
[774]	16	INTEGER,dimension(:),allocatable :: distrib_phys
[630]	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))
[774]	30	allocate(distrib_phys(0:MPI_Size-1))
[630]	31
	32	end subroutine AllocateBands
	33
[774]	34	subroutine Read_distrib
[630]	35	use parallel
	36	implicit none
	37
[792]	38	include "dimensions.h"
[630]	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
[774]	70	read (unit_number,*) j,distrib_phys(i)
[630]	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(:)
[774]	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
[630]	91
[774]	92
	93	SUBROUTINE Set_Bands
	94	USE parallel
[1279]	95	#ifdef CPP_EARTH
	96	! Ehouarn: what follows is only related to // physics; for now only for Earth
[774]	97	USE mod_phys_lmdz_para, ONLY : jj_para_begin,jj_para_end
[1279]	98	#endif
[774]	99	IMPLICIT NONE
[792]	100	INCLUDE 'dimensions.h'
[774]	101	INTEGER :: i
	102
[630]	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
[1279]	108	#ifdef CPP_EARTH
	109	! Ehouarn: what follows is only related to // physics; for now only for Earth
[630]	110	do i=0,MPI_Size-1
[774]	111	jj_Nb_physic(i)=jj_para_end(i)-jj_para_begin(i)+1
[630]	112	if (i/=0) then
[774]	113	if (jj_para_begin(i)==jj_para_end(i-1)) then
[630]	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
[774]	120	jj_Nb_physic_bis(i)=jj_para_end(i)-jj_para_begin(i)+1
[630]	121	if (i/=0) then
[774]	122	if (jj_para_begin(i)==jj_para_end(i-1)) then
[630]	123	jj_Nb_physic_bis(i)=jj_Nb_physic_bis(i)-1
[764]	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
[630]	128	endif
	129	enddo
[1279]	130	#endif
[630]	131
[774]	132	end subroutine Set_Bands
[630]	133
[774]	134
[630]	135	subroutine AdjustBands_caldyn
	136	use times
[774]	137	use parallel
[630]	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
[774]	202	use parallel
[630]	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
[774]	268	use parallel
[630]	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
[1279]	334	#ifdef CPP_EARTH
	335	! Ehouarn: what follows is only related to // physics; for now only for Earth
[774]	336	USE mod_phys_lmdz_para, only : klon_mpi_para_nb
[1279]	337	#endif
[774]	338	USE parallel
[630]	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
[1279]	361	#ifdef CPP_EARTH
	362	! Ehouarn: what follows is only related to // physics; for now only for Earth
[630]	363	do i=0,mpi_size-1
[774]	364	Inc(i)=nint(klon_mpi_para_nb(i)*(medium-value(i))/value(i))
[630]	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
[774]	383	distrib_phys(i)=klon_mpi_para_nb(i)+inc(i)
[630]	384	enddo
[1279]	385	#endif
[630]	386	end subroutine AdjustBands_physic
	387
	388	subroutine WriteBands
	389	USE parallel
	390	implicit none
[792]	391	include "dimensions.h"
[630]	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
[774]	427	write (unit_number,*) i,distrib_phys(i)
[630]	428	enddo
	429
	430	CLOSE(unit_number)
	431	else
[764]	432	print *,'probleme lors de l ecriture des bandes'
[630]	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