Context Navigation

bands.F90 @ 5133

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

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

Download in other formats:

Original Format