Context Navigation

bands.F90 @ 5133

Last change on this file since 5133 was 5119, checked in by abarral, 5 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