source: LMDZ5/trunk/libf/bands.F90 @ 1630

Last change on this file since 1630 was 1630, checked in by Laurent Fairhead, 12 years ago

Importation initiale du répertoire dyn3dmem


Initial import of dyn3dmem directory

File size: 13.3 KB
Line 
1!
2! $Id: bands.F90 1279 2009-12-10 09:02:56Z fairhead $
3!
4  module Bands
5  USE parallel
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
29    use parallel
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
43    use parallel
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
106     USE parallel
107#ifdef CPP_EARTH
108! Ehouarn: what follows is only related to // physics; for now only for Earth
109     USE mod_phys_lmdz_para, ONLY : jj_para_begin,jj_para_end
110#endif
111     IMPLICIT NONE
112     INCLUDE 'dimensions.h'   
113     INTEGER :: i
114       
115      do i=0,mpi_size-1
116         jj_nb_vanleer2(i)=(jjm+1)/mpi_size
117         if (i<MOD(jjm+1,mpi_size)) jj_nb_vanleer2(i)=jj_nb_vanleer2(i)+1
118      enddo
119         
120#ifdef CPP_EARTH
121! Ehouarn: what follows is only related to // physics; for now only for Earth         
122      do i=0,MPI_Size-1
123        jj_Nb_physic(i)=jj_para_end(i)-jj_para_begin(i)+1
124        if (i/=0) then
125          if (jj_para_begin(i)==jj_para_end(i-1)) then
126            jj_Nb_physic(i-1)=jj_Nb_physic(i-1)-1
127          endif
128        endif
129      enddo
130     
131      do i=0,MPI_Size-1
132        jj_Nb_physic_bis(i)=jj_para_end(i)-jj_para_begin(i)+1
133        if (i/=0) then
134          if (jj_para_begin(i)==jj_para_end(i-1)) then
135            jj_Nb_physic_bis(i)=jj_Nb_physic_bis(i)-1
136          else
137            jj_Nb_physic_bis(i-1)=jj_Nb_physic_bis(i-1)+1
138            jj_Nb_physic_bis(i)=jj_Nb_physic_bis(i)-1
139          endif
140        endif
141      enddo
142#endif     
143      CALL create_distrib(jj_Nb_Caldyn,distrib_caldyn)
144      CALL create_distrib(jj_Nb_vanleer,distrib_vanleer)
145      CALL create_distrib(jj_Nb_vanleer2,distrib_vanleer2)
146      CALL create_distrib(jj_Nb_dissip,distrib_dissip)
147      CALL create_distrib(jj_Nb_physic,distrib_physic)
148      CALL create_distrib(jj_Nb_physic_bis,distrib_physic_bis)
149     
150      distrib_physic_bis%jjb_u=distrib_physic%jjb_u
151      distrib_physic_bis%jje_u=distrib_physic%jje_u
152      distrib_physic_bis%jjnb_u=distrib_physic%jjnb_u
153
154      distrib_physic_bis%ijb_u=distrib_physic%ijb_u
155      distrib_physic_bis%ije_u=distrib_physic%ije_u
156      distrib_physic_bis%ijnb_u=distrib_physic%ijnb_u
157
158      distrib_physic_bis%jjb_v=distrib_physic%jjb_v
159      distrib_physic_bis%jje_v=distrib_physic%jje_v
160      distrib_physic_bis%jjnb_v=distrib_physic%jjnb_v
161
162      distrib_physic_bis%ijb_v=distrib_physic%ijb_v
163      distrib_physic_bis%ije_v=distrib_physic%ije_v
164      distrib_physic_bis%ijnb_v=distrib_physic%ijnb_v
165     
166    end subroutine Set_Bands
167
168
169    subroutine AdjustBands_caldyn(new_dist)
170      use times
171      use parallel
172      implicit none
173      TYPE(distrib),INTENT(INOUT) :: new_dist
174
175      real :: minvalue,maxvalue
176      integer :: min_proc,max_proc
177      integer :: i,j
178      real,allocatable,dimension(:) :: value
179      integer,allocatable,dimension(:) :: index
180      real :: tmpvalue
181      integer :: tmpindex
182     
183      allocate(value(0:mpi_size-1))
184      allocate(index(0:mpi_size-1))
185       
186 
187      call allgather_timer_average
188
189      do i=0,mpi_size-1
190        value(i)=timer_average(jj_nb_caldyn(i),timer_caldyn,i)
191        index(i)=i
192      enddo
193     
194      do i=0,mpi_size-2
195        do j=i+1,mpi_size-1
196          if (value(i)>value(j)) then
197            tmpvalue=value(i)
198            value(i)=value(j)
199            value(j)=tmpvalue
200           
201            tmpindex=index(i)
202            index(i)=index(j)
203            index(j)=tmpindex
204           endif
205         enddo
206      enddo
207     
208      maxvalue=value(mpi_size-1)
209      max_proc=index(mpi_size-1)           
210           
211      do i=0,mpi_size-2
212        minvalue=value(i)
213        min_proc=index(i)
214        if (jj_nb_caldyn(max_proc)>3) then
215          if (timer_iteration(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc)<=1 ) then
216             jj_nb_caldyn(min_proc)=jj_nb_caldyn(min_proc)+1
217             jj_nb_caldyn(max_proc)=jj_nb_caldyn(max_proc)-1
218             exit
219           else
220             if (timer_average(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc)                 &
221                -timer_delta(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc) < maxvalue) then
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             endif
226           endif
227         endif
228      enddo
229     
230      deallocate(value)
231      deallocate(index)
232      CALL create_distrib(jj_nb_caldyn,new_dist)
233       
234    end subroutine AdjustBands_caldyn
235   
236    subroutine AdjustBands_vanleer(new_dist)
237      use times
238      use parallel
239      implicit none
240      TYPE(distrib),INTENT(INOUT) :: new_dist
241
242      real :: minvalue,maxvalue
243      integer :: min_proc,max_proc
244      integer :: i,j
245      real,allocatable,dimension(:) :: value
246      integer,allocatable,dimension(:) :: index
247      real :: tmpvalue
248      integer :: tmpindex
249     
250      allocate(value(0:mpi_size-1))
251      allocate(index(0:mpi_size-1))
252       
253 
254      call allgather_timer_average
255
256      do i=0,mpi_size-1
257        value(i)=timer_average(jj_nb_vanleer(i),timer_vanleer,i)
258        index(i)=i
259      enddo
260     
261      do i=0,mpi_size-2
262        do j=i+1,mpi_size-1
263          if (value(i)>value(j)) then
264            tmpvalue=value(i)
265            value(i)=value(j)
266            value(j)=tmpvalue
267           
268            tmpindex=index(i)
269            index(i)=index(j)
270            index(j)=tmpindex
271           endif
272         enddo
273      enddo
274     
275      maxvalue=value(mpi_size-1)
276      max_proc=index(mpi_size-1)           
277           
278      do i=0,mpi_size-2
279        minvalue=value(i)
280        min_proc=index(i)
281
282        if (jj_nb_vanleer(max_proc)>3) then
283          if (timer_average(jj_nb_vanleer(min_proc)+1,timer_vanleer,min_proc)==0. .or. &
284             timer_average(jj_nb_vanleer(max_proc)-1,timer_vanleer,max_proc)==0.) then
285             jj_nb_vanleer(min_proc)=jj_nb_vanleer(min_proc)+1
286             jj_nb_vanleer(max_proc)=jj_nb_vanleer(max_proc)-1
287             exit
288           else
289             if (timer_average(jj_nb_vanleer(min_proc)+1,timer_vanleer,min_proc) < maxvalue) then
290               jj_nb_vanleer(min_proc)=jj_nb_vanleer(min_proc)+1
291               jj_nb_vanleer(max_proc)=jj_nb_vanleer(max_proc)-1
292               exit
293             endif
294           endif
295         endif
296      enddo
297     
298      deallocate(value)
299      deallocate(index)
300 
301      CALL create_distrib(jj_nb_vanleer,new_dist)
302         
303    end subroutine AdjustBands_vanleer
304
305    subroutine AdjustBands_dissip(new_dist)
306      use times
307      use parallel
308      implicit none
309      TYPE(distrib),INTENT(INOUT) :: new_dist
310     
311      real :: minvalue,maxvalue
312      integer :: min_proc,max_proc
313      integer :: i,j
314      real,allocatable,dimension(:) :: value
315      integer,allocatable,dimension(:) :: index
316      real :: tmpvalue
317      integer :: tmpindex
318     
319      allocate(value(0:mpi_size-1))
320      allocate(index(0:mpi_size-1))
321       
322 
323      call allgather_timer_average
324
325      do i=0,mpi_size-1
326        value(i)=timer_average(jj_nb_dissip(i),timer_dissip,i)
327        index(i)=i
328      enddo
329     
330      do i=0,mpi_size-2
331        do j=i+1,mpi_size-1
332          if (value(i)>value(j)) then
333            tmpvalue=value(i)
334            value(i)=value(j)
335            value(j)=tmpvalue
336           
337            tmpindex=index(i)
338            index(i)=index(j)
339            index(j)=tmpindex
340           endif
341         enddo
342      enddo
343     
344      maxvalue=value(mpi_size-1)
345      max_proc=index(mpi_size-1)           
346           
347      do i=0,mpi_size-2
348        minvalue=value(i)
349        min_proc=index(i)
350
351        if (jj_nb_dissip(max_proc)>3) then
352          if (timer_iteration(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc)<=1) then
353             jj_nb_dissip(min_proc)=jj_nb_dissip(min_proc)+1
354             jj_nb_dissip(max_proc)=jj_nb_dissip(max_proc)-1
355             exit
356           else
357             if (timer_average(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc)         &
358                - timer_delta(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc) < maxvalue) then
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             endif
363           endif
364         endif
365      enddo
366     
367      deallocate(value)
368      deallocate(index)
369 
370      CALL create_distrib(jj_nb_dissip,new_dist)
371         
372    end subroutine AdjustBands_dissip
373
374    subroutine AdjustBands_physic
375      use times
376#ifdef CPP_EARTH
377! Ehouarn: what follows is only related to // physics; for now only for Earth
378      USE mod_phys_lmdz_para, only : klon_mpi_para_nb
379#endif
380      USE parallel
381      implicit none
382
383      integer :: i,Index
384      real,allocatable,dimension(:) :: value
385      integer,allocatable,dimension(:) :: Inc
386      real :: medium
387      integer :: NbTot,sgn
388     
389      allocate(value(0:mpi_size-1))
390      allocate(Inc(0:mpi_size-1))
391       
392 
393      call allgather_timer_average
394     
395      medium=0
396      do i=0,mpi_size-1
397        value(i)=timer_average(jj_nb_physic(i),timer_physic,i)
398        medium=medium+value(i)
399      enddo   
400     
401      medium=medium/mpi_size     
402      NbTot=0
403#ifdef CPP_EARTH
404! Ehouarn: what follows is only related to // physics; for now only for Earth
405      do i=0,mpi_size-1
406        Inc(i)=nint(klon_mpi_para_nb(i)*(medium-value(i))/value(i))
407        NbTot=NbTot+Inc(i) 
408      enddo
409     
410      if (NbTot>=0) then
411        Sgn=1
412      else
413        Sgn=-1
414        NbTot=-NbTot
415      endif
416     
417      Index=0
418      do i=1,NbTot
419        Inc(Index)=Inc(Index)-Sgn
420        Index=Index+1
421        if (Index>mpi_size-1) Index=0
422      enddo
423     
424      do i=0,mpi_size-1
425        distrib_phys(i)=klon_mpi_para_nb(i)+inc(i)
426      enddo
427#endif 
428         
429    end subroutine AdjustBands_physic
430
431    subroutine WriteBands
432    USE parallel
433    implicit none
434    include "dimensions.h"
435
436      integer :: i,j
437      character (len=4) :: siim,sjjm,sllm,sproc
438      character (len=255) :: filename
439      integer :: unit_number=10
440      integer :: ierr
441 
442      write(siim,'(i3)') iim
443      write(sjjm,'(i3)') jjm
444      write(sllm,'(i3)') llm
445      write(sproc,'(i3)') mpi_size
446
447      filename='Bands_'//TRIM(ADJUSTL(siim))//'x'//TRIM(ADJUSTL(sjjm))//'x'//TRIM(ADJUSTL(sllm))//'_'  &
448                        //TRIM(ADJUSTL(sproc))//'prc.dat'   
449     
450      OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='replace',FORM='formatted',IOSTAT=ierr)
451     
452      if (ierr==0) then
453       
454!       write (unit_number,*) '*** Bandes caldyn ***'
455        do i=0,mpi_size-1
456          write (unit_number,*) i,jj_nb_caldyn(i)
457        enddo
458       
459!       write (unit_number,*) '*** Bandes vanleer ***'
460        do i=0,mpi_size-1
461          write (unit_number,*) i,jj_nb_vanleer(i)
462        enddo
463       
464!        write (unit_number,*) '*** Bandes dissip ***'
465        do i=0,mpi_size-1
466          write (unit_number,*) i,jj_nb_dissip(i)
467        enddo
468       
469        do i=0,mpi_size-1
470          write (unit_number,*) i,distrib_phys(i)
471        enddo
472       
473        CLOSE(unit_number)   
474      else
475        print *,'probleme lors de l ecriture des bandes'
476      endif
477       
478    end subroutine WriteBands
479 
480  end module Bands
481 
482 
Note: See TracBrowser for help on using the repository browser.