Context Navigation

bands.F90 @ 2641

Last change on this file since 2641 was 2408, checked in by Laurent Fairhead, 9 years ago
Merged trunk changes r2298:2396 into testing branch
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory
File size: 13.3 KB

Rev	Line
[1632]	1	!
[1707]	2	! $Id$
[1632]	3	!
	4	module Bands
[1864]	5	USE parallel_lmdz
[1632]	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
[1864]	29	USE parallel_lmdz
[1632]	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
[1864]	43	USE parallel_lmdz
[1632]	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
[1864]	106	USE parallel_lmdz
[1632]	107	IMPLICIT NONE
	108	INCLUDE 'dimensions.h'
[2408]	109	INTEGER :: i, ij
	110	INTEGER :: jj_para_begin(0:mpi_size-1)
	111	INTEGER :: jj_para_end(0:mpi_size-1)
[1632]	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
[2408]	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
[1632]	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
[2408]	149
[1632]	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
[1864]	178	USE parallel_lmdz
[1632]	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
[1864]	245	USE parallel_lmdz
[1632]	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
[1864]	314	USE parallel_lmdz
[1632]	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
[1707]	383	#ifdef CPP_PHYS
	384	! Ehouarn: what follows is only related to // physics
[1632]	385	USE mod_phys_lmdz_para, only : klon_mpi_para_nb
	386	#endif
[1864]	387	USE parallel_lmdz
[1632]	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
[1707]	410	#ifdef CPP_PHYS
[1632]	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
[1864]	438	USE parallel_lmdz
[1632]	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
[2408]	489

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

Download in other formats:

Original Format