Context Navigation

bands.F90 @ 5295

Last change on this file since 5295 was 5160, checked in by abarral, 3 months ago
Put .h into modules
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.5 KB

Rev	Line
[5099]	1
[1673]	2	! $Id$
[5099]	3
[1632]	4	module Bands
[1823]	5	USE parallel_lmdz
[5117]	6	INTEGER, parameter :: bands_caldyn=1
	7	INTEGER, parameter :: bands_vanleer=2
	8	INTEGER, parameter :: bands_dissip=3
[1632]	9
[5117]	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
[1632]	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
[5117]	24	INTEGER,DIMENSION(:),ALLOCATABLE :: distrib_phys
[1632]	25
[5119]	26	CONTAINS
[1632]	27
[5103]	28	SUBROUTINE AllocateBands
[1823]	29	USE parallel_lmdz
[5113]	30	IMPLICIT NONE
[1632]	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
[5103]	40	END SUBROUTINE AllocateBands
[1632]	41
[5103]	42	SUBROUTINE Read_distrib
[1823]	43	USE parallel_lmdz
[5159]	44	USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
[5113]	45	IMPLICIT NONE
[1632]	46
[5159]	47
[5116]	48	INTEGER :: i,j
[5117]	49	CHARACTER (LEN=4) :: siim,sjjm,sllm,sproc
	50	CHARACTER (LEN=255) :: filename
[5116]	51	INTEGER :: unit_number=10
	52	INTEGER :: ierr
[1632]	53
[5101]	54	CALL AllocateBands
[5116]	55	WRITE(siim,'(i3)') iim
	56	WRITE(sjjm,'(i3)') jjm
	57	WRITE(sllm,'(i3)') llm
	58	WRITE(sproc,'(i3)') mpi_size
[1632]	59	filename='Bands_'//TRIM(ADJUSTL(siim))//'x'//TRIM(ADJUSTL(sjjm))//'x'//TRIM(ADJUSTL(sllm))//'_' &
	60	//TRIM(ADJUSTL(sproc))//'prc.dat'
	61
	62	OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='old',FORM='formatted',IOSTAT=ierr)
	63
[5117]	64	IF (ierr==0) THEN
[5158]	65	DO i=0,mpi_size-1
[1632]	66	read (unit_number,*) j,jj_nb_caldyn(i)
	67	enddo
	68
[5158]	69	DO i=0,mpi_size-1
[1632]	70	read (unit_number,*) j,jj_nb_vanleer(i)
	71	enddo
	72
[5158]	73	DO i=0,mpi_size-1
[1632]	74	read (unit_number,*) j,jj_nb_dissip(i)
	75	enddo
	76
[5158]	77	DO i=0,mpi_size-1
[1632]	78	read (unit_number,*) j,distrib_phys(i)
	79	enddo
[5158]	80
	81	CLOSE(unit_number)
[1632]	82
	83	else
[5158]	84	DO i=0,mpi_size-1
[1632]	85	jj_nb_caldyn(i)=(jjm+1)/mpi_size
[5158]	86	IF (i<MOD(jjm+1,mpi_size)) jj_nb_caldyn(i)=jj_nb_caldyn(i)+1
[1632]	87	enddo
	88
	89	jj_nb_vanleer(:)=jj_nb_caldyn(:)
	90	jj_nb_dissip(:)=jj_nb_caldyn(:)
	91
[5158]	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
[1632]	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
[5103]	102	END SUBROUTINE Read_distrib
[1632]	103
	104
	105	SUBROUTINE Set_Bands
[1823]	106	USE parallel_lmdz
[5159]	107	USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
[1632]	108	IMPLICIT NONE
[5159]	109
[2351]	110	INTEGER :: i, ij
	111	INTEGER :: jj_para_begin(0:mpi_size-1)
	112	INTEGER :: jj_para_end(0:mpi_size-1)
[1632]	113
[5158]	114	DO i=0,mpi_size-1
[1632]	115	jj_nb_vanleer2(i)=(jjm+1)/mpi_size
[5158]	116	IF (i<MOD(jjm+1,mpi_size)) jj_nb_vanleer2(i)=jj_nb_vanleer2(i)+1
[1632]	117	enddo
	118
[2351]	119	jj_para_begin(0)=1
	120	ij=distrib_phys(0)+iim-1
	121	jj_para_end(0)=((ij-1)/iim)+1
	122
	123	DO i=1,mpi_Size-1
	124	ij=ij+1
	125	jj_para_begin(i)=((ij-1)/iim)+1
	126	ij=ij+distrib_phys(i)-1
	127	jj_para_end(i)=((ij-1)/iim)+1
	128	ENDDO
	129
[5158]	130	DO i=0,MPI_Size-1
[1632]	131	jj_Nb_physic(i)=jj_para_end(i)-jj_para_begin(i)+1
[5117]	132	IF (i/=0) THEN
	133	IF (jj_para_begin(i)==jj_para_end(i-1)) THEN
[1632]	134	jj_Nb_physic(i-1)=jj_Nb_physic(i-1)-1
	135	endif
	136	endif
	137	enddo
	138
[5158]	139	DO i=0,MPI_Size-1
[1632]	140	jj_Nb_physic_bis(i)=jj_para_end(i)-jj_para_begin(i)+1
[5117]	141	IF (i/=0) THEN
	142	IF (jj_para_begin(i)==jj_para_end(i-1)) THEN
[1632]	143	jj_Nb_physic_bis(i)=jj_Nb_physic_bis(i)-1
	144	else
[5158]	145	jj_Nb_physic_bis(i-1)=jj_Nb_physic_bis(i-1)+1
	146	jj_Nb_physic_bis(i)=jj_Nb_physic_bis(i)-1
	147	ENDIF
[1632]	148	endif
	149	enddo
[2351]	150
[1632]	151	CALL create_distrib(jj_Nb_Caldyn,distrib_caldyn)
	152	CALL create_distrib(jj_Nb_vanleer,distrib_vanleer)
	153	CALL create_distrib(jj_Nb_vanleer2,distrib_vanleer2)
	154	CALL create_distrib(jj_Nb_dissip,distrib_dissip)
	155	CALL create_distrib(jj_Nb_physic,distrib_physic)
	156	CALL create_distrib(jj_Nb_physic_bis,distrib_physic_bis)
	157
	158	distrib_physic_bis%jjb_u=distrib_physic%jjb_u
	159	distrib_physic_bis%jje_u=distrib_physic%jje_u
	160	distrib_physic_bis%jjnb_u=distrib_physic%jjnb_u
	161
	162	distrib_physic_bis%ijb_u=distrib_physic%ijb_u
	163	distrib_physic_bis%ije_u=distrib_physic%ije_u
	164	distrib_physic_bis%ijnb_u=distrib_physic%ijnb_u
	165
	166	distrib_physic_bis%jjb_v=distrib_physic%jjb_v
	167	distrib_physic_bis%jje_v=distrib_physic%jje_v
	168	distrib_physic_bis%jjnb_v=distrib_physic%jjnb_v
	169
	170	distrib_physic_bis%ijb_v=distrib_physic%ijb_v
	171	distrib_physic_bis%ije_v=distrib_physic%ije_v
	172	distrib_physic_bis%ijnb_v=distrib_physic%ijnb_v
	173
[5103]	174	END SUBROUTINE Set_Bands
[1632]	175
	176
[5103]	177	SUBROUTINE AdjustBands_caldyn(new_dist)
[5117]	178	USE times
[1823]	179	USE parallel_lmdz
[5113]	180	IMPLICIT NONE
[1632]	181	TYPE(distrib),INTENT(INOUT) :: new_dist
	182
[5116]	183	REAL :: minvalue,maxvalue
	184	INTEGER :: min_proc,max_proc
	185	INTEGER :: i,j
[5117]	186	REAL,ALLOCATABLE,DIMENSION(:) :: value
	187	INTEGER,ALLOCATABLE,DIMENSION(:) :: index
[5116]	188	REAL :: tmpvalue
	189	INTEGER :: tmpindex
[1632]	190
	191	allocate(value(0:mpi_size-1))
	192	allocate(index(0:mpi_size-1))
	193
	194
[5101]	195	CALL allgather_timer_average
[1632]	196
[5158]	197	DO i=0,mpi_size-1
[1632]	198	value(i)=timer_average(jj_nb_caldyn(i),timer_caldyn,i)
[5158]	199	index(i)=i
[1632]	200	enddo
	201
[5158]	202	DO i=0,mpi_size-2
	203	DO j=i+1,mpi_size-1
	204	IF (value(i)>value(j)) THEN
	205	tmpvalue=value(i)
	206	value(i)=value(j)
	207	value(j)=tmpvalue
	208
	209	tmpindex=index(i)
	210	index(i)=index(j)
	211	index(j)=tmpindex
	212	endif
	213	enddo
[1632]	214	enddo
	215
	216	maxvalue=value(mpi_size-1)
	217	max_proc=index(mpi_size-1)
	218
[5158]	219	DO i=0,mpi_size-2
[1632]	220	minvalue=value(i)
	221	min_proc=index(i)
[5117]	222	IF (jj_nb_caldyn(max_proc)>2) THEN
	223	IF (timer_iteration(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc)<=1 ) THEN
[1632]	224	jj_nb_caldyn(min_proc)=jj_nb_caldyn(min_proc)+1
	225	jj_nb_caldyn(max_proc)=jj_nb_caldyn(max_proc)-1
[5158]	226	exit
[1632]	227	else
[5117]	228	IF (timer_average(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc) &
[5158]	229	-timer_delta(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc) < maxvalue) THEN
[1632]	230	jj_nb_caldyn(min_proc)=jj_nb_caldyn(min_proc)+1
	231	jj_nb_caldyn(max_proc)=jj_nb_caldyn(max_proc)-1
	232	exit
[5158]	233	endif
[1632]	234	endif
	235	endif
	236	enddo
	237
	238	deallocate(value)
	239	deallocate(index)
	240	CALL create_distrib(jj_nb_caldyn,new_dist)
	241
[5103]	242	END SUBROUTINE AdjustBands_caldyn
[1632]	243
[5103]	244	SUBROUTINE AdjustBands_vanleer(new_dist)
[5117]	245	USE times
[1823]	246	USE parallel_lmdz
[5113]	247	IMPLICIT NONE
[1632]	248	TYPE(distrib),INTENT(INOUT) :: new_dist
	249
[5116]	250	REAL :: minvalue,maxvalue
	251	INTEGER :: min_proc,max_proc
	252	INTEGER :: i,j
[5117]	253	REAL,ALLOCATABLE,DIMENSION(:) :: value
	254	INTEGER,ALLOCATABLE,DIMENSION(:) :: index
[5116]	255	REAL :: tmpvalue
	256	INTEGER :: tmpindex
[1632]	257
	258	allocate(value(0:mpi_size-1))
	259	allocate(index(0:mpi_size-1))
	260
	261
[5101]	262	CALL allgather_timer_average
[1632]	263
[5158]	264	DO i=0,mpi_size-1
[1632]	265	value(i)=timer_average(jj_nb_vanleer(i),timer_vanleer,i)
[5158]	266	index(i)=i
[1632]	267	enddo
	268
[5158]	269	DO i=0,mpi_size-2
	270	DO j=i+1,mpi_size-1
	271	IF (value(i)>value(j)) THEN
	272	tmpvalue=value(i)
	273	value(i)=value(j)
	274	value(j)=tmpvalue
	275
	276	tmpindex=index(i)
	277	index(i)=index(j)
	278	index(j)=tmpindex
	279	endif
	280	enddo
[1632]	281	enddo
	282
	283	maxvalue=value(mpi_size-1)
	284	max_proc=index(mpi_size-1)
	285
[5158]	286	DO i=0,mpi_size-2
[1632]	287	minvalue=value(i)
	288	min_proc=index(i)
	289
[5117]	290	IF (jj_nb_vanleer(max_proc)>2) THEN
	291	IF (timer_average(jj_nb_vanleer(min_proc)+1,timer_vanleer,min_proc)==0. .OR. &
[5116]	292	timer_average(jj_nb_vanleer(max_proc)-1,timer_vanleer,max_proc)==0.) THEN
[1632]	293	jj_nb_vanleer(min_proc)=jj_nb_vanleer(min_proc)+1
	294	jj_nb_vanleer(max_proc)=jj_nb_vanleer(max_proc)-1
[5158]	295	exit
[1632]	296	else
[5117]	297	IF (timer_average(jj_nb_vanleer(min_proc)+1,timer_vanleer,min_proc) < maxvalue) THEN
[1632]	298	jj_nb_vanleer(min_proc)=jj_nb_vanleer(min_proc)+1
	299	jj_nb_vanleer(max_proc)=jj_nb_vanleer(max_proc)-1
	300	exit
[5158]	301	endif
[1632]	302	endif
	303	endif
	304	enddo
	305
	306	deallocate(value)
	307	deallocate(index)
	308
	309	CALL create_distrib(jj_nb_vanleer,new_dist)
	310
[5103]	311	END SUBROUTINE AdjustBands_vanleer
[1632]	312
[5103]	313	SUBROUTINE AdjustBands_dissip(new_dist)
[5117]	314	USE times
[1823]	315	USE parallel_lmdz
[5113]	316	IMPLICIT NONE
[1632]	317	TYPE(distrib),INTENT(INOUT) :: new_dist
	318
[5116]	319	REAL :: minvalue,maxvalue
	320	INTEGER :: min_proc,max_proc
	321	INTEGER :: i,j
[5117]	322	REAL,ALLOCATABLE,DIMENSION(:) :: value
	323	INTEGER,ALLOCATABLE,DIMENSION(:) :: index
[5116]	324	REAL :: tmpvalue
	325	INTEGER :: tmpindex
[1632]	326
	327	allocate(value(0:mpi_size-1))
	328	allocate(index(0:mpi_size-1))
	329
	330
[5101]	331	CALL allgather_timer_average
[1632]	332
[5158]	333	DO i=0,mpi_size-1
[1632]	334	value(i)=timer_average(jj_nb_dissip(i),timer_dissip,i)
[5158]	335	index(i)=i
[1632]	336	enddo
	337
[5158]	338	DO i=0,mpi_size-2
	339	DO j=i+1,mpi_size-1
	340	IF (value(i)>value(j)) THEN
	341	tmpvalue=value(i)
	342	value(i)=value(j)
	343	value(j)=tmpvalue
	344
	345	tmpindex=index(i)
	346	index(i)=index(j)
	347	index(j)=tmpindex
	348	endif
	349	enddo
[1632]	350	enddo
	351
	352	maxvalue=value(mpi_size-1)
	353	max_proc=index(mpi_size-1)
	354
[5158]	355	DO i=0,mpi_size-2
[1632]	356	minvalue=value(i)
	357	min_proc=index(i)
	358
[5117]	359	IF (jj_nb_dissip(max_proc)>3) THEN
	360	IF (timer_iteration(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc)<=1) THEN
[1632]	361	jj_nb_dissip(min_proc)=jj_nb_dissip(min_proc)+1
	362	jj_nb_dissip(max_proc)=jj_nb_dissip(max_proc)-1
[5158]	363	exit
[1632]	364	else
[5117]	365	IF (timer_average(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc) &
[5158]	366	- timer_delta(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc) < maxvalue) THEN
[1632]	367	jj_nb_dissip(min_proc)=jj_nb_dissip(min_proc)+1
	368	jj_nb_dissip(max_proc)=jj_nb_dissip(max_proc)-1
	369	exit
[5158]	370	endif
[1632]	371	endif
	372	endif
	373	enddo
	374
	375	deallocate(value)
	376	deallocate(index)
	377
	378	CALL create_distrib(jj_nb_dissip,new_dist)
	379
[5103]	380	END SUBROUTINE AdjustBands_dissip
[1632]	381
[5103]	382	SUBROUTINE AdjustBands_physic
[5117]	383	USE times
[5090]	384
	385	! Ehouarn: what follows is only related to // physics
	386	USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_PHYS
[5110]	387	USE lmdz_phys_para, ONLY: klon_mpi_para_nb
[5090]	388
[1823]	389	USE parallel_lmdz
[5113]	390	IMPLICIT NONE
[1632]	391
[5116]	392	INTEGER :: i,Index
[5117]	393	REAL,ALLOCATABLE,DIMENSION(:) :: value
	394	INTEGER,ALLOCATABLE,DIMENSION(:) :: Inc
[5116]	395	REAL :: medium
	396	INTEGER :: NbTot,sgn
[1632]	397
	398	allocate(value(0:mpi_size-1))
	399	allocate(Inc(0:mpi_size-1))
	400
	401
[5101]	402	CALL allgather_timer_average
[1632]	403
	404	medium=0
[5158]	405	DO i=0,mpi_size-1
[1632]	406	value(i)=timer_average(jj_nb_physic(i),timer_physic,i)
[5158]	407	medium=medium+value(i)
[1632]	408	enddo
	409
	410	medium=medium/mpi_size
	411	NbTot=0
[5090]	412	IF (CPPKEY_PHYS) THEN
[5158]	413	DO i=0,mpi_size-1
[1632]	414	Inc(i)=nint(klon_mpi_para_nb(i)*(medium-value(i))/value(i))
	415	NbTot=NbTot+Inc(i)
	416	enddo
	417
[5117]	418	IF (NbTot>=0) THEN
[1632]	419	Sgn=1
	420	else
	421	Sgn=-1
[5158]	422	NbTot=-NbTot
[1632]	423	endif
	424
	425	Index=0
[5158]	426	DO i=1,NbTot
[1632]	427	Inc(Index)=Inc(Index)-Sgn
[5158]	428	Index=Index+1
	429	IF (Index>mpi_size-1) Index=0
[1632]	430	enddo
	431
[5158]	432	DO i=0,mpi_size-1
[1632]	433	distrib_phys(i)=klon_mpi_para_nb(i)+inc(i)
	434	enddo
[5090]	435	END IF
[1632]	436
[5103]	437	END SUBROUTINE AdjustBands_physic
[1632]	438
[5103]	439	SUBROUTINE WriteBands
[1823]	440	USE parallel_lmdz
[5159]	441	USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
[5113]	442	IMPLICIT NONE
[1632]	443
[5159]	444
[5116]	445	INTEGER :: i,j
[5117]	446	CHARACTER (LEN=4) :: siim,sjjm,sllm,sproc
	447	CHARACTER (LEN=255) :: filename
[5116]	448	INTEGER :: unit_number=10
	449	INTEGER :: ierr
[1632]	450
[5116]	451	WRITE(siim,'(i3)') iim
	452	WRITE(sjjm,'(i3)') jjm
	453	WRITE(sllm,'(i3)') llm
	454	WRITE(sproc,'(i3)') mpi_size
[1632]	455
	456	filename='Bands_'//TRIM(ADJUSTL(siim))//'x'//TRIM(ADJUSTL(sjjm))//'x'//TRIM(ADJUSTL(sllm))//'_' &
	457	//TRIM(ADJUSTL(sproc))//'prc.dat'
	458
	459	OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='replace',FORM='formatted',IOSTAT=ierr)
	460
[5117]	461	IF (ierr==0) THEN
[5158]	462	! write (unit_number,) ' Bandes caldyn *'
	463	DO i=0,mpi_size-1
[1632]	464	write (unit_number,*) i,jj_nb_caldyn(i)
	465	enddo
	466
[5158]	467	! write (unit_number,) ' Bandes vanleer *'
	468	DO i=0,mpi_size-1
[1632]	469	write (unit_number,*) i,jj_nb_vanleer(i)
	470	enddo
	471
	472	! write (unit_number,) ' Bandes dissip *'
[5158]	473	DO i=0,mpi_size-1
[1632]	474	write (unit_number,*) i,jj_nb_dissip(i)
	475	enddo
	476
[5158]	477	DO i=0,mpi_size-1
[1632]	478	write (unit_number,*) i,distrib_phys(i)
	479	enddo
[5158]	480
[1632]	481	CLOSE(unit_number)
	482	else
[5160]	483	PRINT *,'probleme lors de l ecriture des bandes'
[1632]	484	endif
	485
[5103]	486	END SUBROUTINE WriteBands
[1632]	487
[5119]	488	END MODULE Bands
[1632]	489
	490
[2351]	491

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

Download in other formats:

Original Format