source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bands.F90 @ 5160

Last change on this file since 5160 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
Line 
1
2! $Id$
3
4  module Bands
5  USE parallel_lmdz
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_lmdz
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_lmdz
44USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
45    IMPLICIT NONE
46
47
48      INTEGER :: i,j
49      CHARACTER (LEN=4) :: siim,sjjm,sllm,sproc
50      CHARACTER (LEN=255) :: filename
51      INTEGER :: unit_number=10
52      INTEGER :: ierr
53   
54      CALL AllocateBands
55      WRITE(siim,'(i3)') iim
56      WRITE(sjjm,'(i3)') jjm
57      WRITE(sllm,'(i3)') llm
58      WRITE(sproc,'(i3)') mpi_size
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     
64      IF (ierr==0) THEN
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_lmdz
107USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
108     IMPLICIT NONE
109
110     INTEGER :: i, ij
111     INTEGER :: jj_para_begin(0:mpi_size-1)
112     INTEGER :: jj_para_end(0:mpi_size-1)
113       
114      DO i=0,mpi_size-1
115         jj_nb_vanleer2(i)=(jjm+1)/mpi_size
116     IF (i<MOD(jjm+1,mpi_size)) jj_nb_vanleer2(i)=jj_nb_vanleer2(i)+1
117      enddo
118         
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 
130       DO i=0,MPI_Size-1
131        jj_Nb_physic(i)=jj_para_end(i)-jj_para_begin(i)+1
132        IF (i/=0) THEN
133          IF (jj_para_begin(i)==jj_para_end(i-1)) THEN
134            jj_Nb_physic(i-1)=jj_Nb_physic(i-1)-1
135          endif
136        endif
137      enddo
138     
139      DO i=0,MPI_Size-1
140        jj_Nb_physic_bis(i)=jj_para_end(i)-jj_para_begin(i)+1
141        IF (i/=0) THEN
142          IF (jj_para_begin(i)==jj_para_end(i-1)) THEN
143            jj_Nb_physic_bis(i)=jj_Nb_physic_bis(i)-1
144          else
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
148        endif
149      enddo
150
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     
174    END SUBROUTINE  Set_Bands
175
176
177    SUBROUTINE AdjustBands_caldyn(new_dist)
178      USE times
179      USE parallel_lmdz
180      IMPLICIT NONE
181      TYPE(distrib),INTENT(INOUT) :: new_dist
182
183      REAL :: minvalue,maxvalue
184      INTEGER :: min_proc,max_proc
185      INTEGER :: i,j
186      REAL,ALLOCATABLE,DIMENSION(:) :: value
187      INTEGER,ALLOCATABLE,DIMENSION(:) :: index
188      REAL :: tmpvalue
189      INTEGER :: tmpindex
190     
191      allocate(value(0:mpi_size-1))
192      allocate(index(0:mpi_size-1))
193       
194 
195      CALL allgather_timer_average
196
197      DO i=0,mpi_size-1
198        value(i)=timer_average(jj_nb_caldyn(i),timer_caldyn,i)
199    index(i)=i
200      enddo
201     
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
214      enddo
215     
216      maxvalue=value(mpi_size-1)
217      max_proc=index(mpi_size-1)           
218           
219      DO i=0,mpi_size-2
220        minvalue=value(i)
221        min_proc=index(i)
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
224             jj_nb_caldyn(min_proc)=jj_nb_caldyn(min_proc)+1
225             jj_nb_caldyn(max_proc)=jj_nb_caldyn(max_proc)-1
226         exit
227           else
228             IF (timer_average(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc)                 &
229            -timer_delta(jj_nb_caldyn(min_proc)+1,timer_caldyn,min_proc) < maxvalue) THEN
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
233         endif
234           endif
235         endif
236      enddo
237     
238      deallocate(value)
239      deallocate(index)
240      CALL create_distrib(jj_nb_caldyn,new_dist)
241       
242    END SUBROUTINE  AdjustBands_caldyn
243   
244    SUBROUTINE AdjustBands_vanleer(new_dist)
245      USE times
246      USE parallel_lmdz
247      IMPLICIT NONE
248      TYPE(distrib),INTENT(INOUT) :: new_dist
249
250      REAL :: minvalue,maxvalue
251      INTEGER :: min_proc,max_proc
252      INTEGER :: i,j
253      REAL,ALLOCATABLE,DIMENSION(:) :: value
254      INTEGER,ALLOCATABLE,DIMENSION(:) :: index
255      REAL :: tmpvalue
256      INTEGER :: tmpindex
257     
258      allocate(value(0:mpi_size-1))
259      allocate(index(0:mpi_size-1))
260       
261 
262      CALL allgather_timer_average
263
264      DO i=0,mpi_size-1
265        value(i)=timer_average(jj_nb_vanleer(i),timer_vanleer,i)
266    index(i)=i
267      enddo
268     
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
281      enddo
282     
283      maxvalue=value(mpi_size-1)
284      max_proc=index(mpi_size-1)           
285           
286      DO i=0,mpi_size-2
287        minvalue=value(i)
288        min_proc=index(i)
289
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. &
292             timer_average(jj_nb_vanleer(max_proc)-1,timer_vanleer,max_proc)==0.) THEN
293             jj_nb_vanleer(min_proc)=jj_nb_vanleer(min_proc)+1
294             jj_nb_vanleer(max_proc)=jj_nb_vanleer(max_proc)-1
295         exit
296           else
297             IF (timer_average(jj_nb_vanleer(min_proc)+1,timer_vanleer,min_proc) < maxvalue) THEN
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
301         endif
302           endif
303         endif
304      enddo
305     
306      deallocate(value)
307      deallocate(index)
308 
309      CALL create_distrib(jj_nb_vanleer,new_dist)
310         
311    END SUBROUTINE  AdjustBands_vanleer
312
313    SUBROUTINE AdjustBands_dissip(new_dist)
314      USE times
315      USE parallel_lmdz
316      IMPLICIT NONE
317      TYPE(distrib),INTENT(INOUT) :: new_dist
318     
319      REAL :: minvalue,maxvalue
320      INTEGER :: min_proc,max_proc
321      INTEGER :: i,j
322      REAL,ALLOCATABLE,DIMENSION(:) :: value
323      INTEGER,ALLOCATABLE,DIMENSION(:) :: index
324      REAL :: tmpvalue
325      INTEGER :: tmpindex
326     
327      allocate(value(0:mpi_size-1))
328      allocate(index(0:mpi_size-1))
329       
330 
331      CALL allgather_timer_average
332
333      DO i=0,mpi_size-1
334        value(i)=timer_average(jj_nb_dissip(i),timer_dissip,i)
335    index(i)=i
336      enddo
337     
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
350      enddo
351     
352      maxvalue=value(mpi_size-1)
353      max_proc=index(mpi_size-1)           
354           
355      DO i=0,mpi_size-2
356        minvalue=value(i)
357        min_proc=index(i)
358
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
361             jj_nb_dissip(min_proc)=jj_nb_dissip(min_proc)+1
362             jj_nb_dissip(max_proc)=jj_nb_dissip(max_proc)-1
363         exit
364           else
365             IF (timer_average(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc)         &
366            - timer_delta(jj_nb_dissip(min_proc)+1,timer_dissip,min_proc) < maxvalue) THEN
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
370         endif
371           endif
372         endif
373      enddo
374     
375      deallocate(value)
376      deallocate(index)
377 
378      CALL create_distrib(jj_nb_dissip,new_dist)
379         
380    END SUBROUTINE  AdjustBands_dissip
381
382    SUBROUTINE AdjustBands_physic
383      USE times
384
385      ! Ehouarn: what follows is only related to // physics
386      USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_PHYS
387      USE lmdz_phys_para, ONLY: klon_mpi_para_nb
388
389      USE parallel_lmdz
390      IMPLICIT NONE
391
392      INTEGER :: i,Index
393      REAL,ALLOCATABLE,DIMENSION(:) :: value
394      INTEGER,ALLOCATABLE,DIMENSION(:) :: Inc
395      REAL :: medium
396      INTEGER :: NbTot,sgn
397     
398      allocate(value(0:mpi_size-1))
399      allocate(Inc(0:mpi_size-1))
400       
401 
402      CALL allgather_timer_average
403     
404      medium=0
405      DO i=0,mpi_size-1
406        value(i)=timer_average(jj_nb_physic(i),timer_physic,i)
407    medium=medium+value(i)
408      enddo   
409     
410      medium=medium/mpi_size     
411      NbTot=0
412      IF (CPPKEY_PHYS) THEN
413      DO i=0,mpi_size-1
414        Inc(i)=nint(klon_mpi_para_nb(i)*(medium-value(i))/value(i))
415        NbTot=NbTot+Inc(i) 
416      enddo
417     
418      IF (NbTot>=0) THEN
419        Sgn=1
420      else
421        Sgn=-1
422    NbTot=-NbTot
423      endif
424     
425      Index=0
426      DO i=1,NbTot
427        Inc(Index)=Inc(Index)-Sgn
428    Index=Index+1
429    IF (Index>mpi_size-1) Index=0
430      enddo
431     
432      DO i=0,mpi_size-1
433        distrib_phys(i)=klon_mpi_para_nb(i)+inc(i)
434      enddo
435     END IF
436         
437    END SUBROUTINE  AdjustBands_physic
438
439    SUBROUTINE WriteBands
440    USE parallel_lmdz
441USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
442    IMPLICIT NONE
443
444
445      INTEGER :: i,j
446      CHARACTER (LEN=4) :: siim,sjjm,sllm,sproc
447      CHARACTER (LEN=255) :: filename
448      INTEGER :: unit_number=10
449      INTEGER :: ierr
450 
451      WRITE(siim,'(i3)') iim
452      WRITE(sjjm,'(i3)') jjm
453      WRITE(sllm,'(i3)') llm
454      WRITE(sproc,'(i3)') mpi_size
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     
461      IF (ierr==0) THEN
462!    write (unit_number,*) '*** Bandes caldyn ***'
463    DO i=0,mpi_size-1
464          write (unit_number,*) i,jj_nb_caldyn(i)
465        enddo
466       
467!    write (unit_number,*) '*** Bandes vanleer ***'
468        DO i=0,mpi_size-1
469          write (unit_number,*) i,jj_nb_vanleer(i)
470        enddo
471       
472!        write (unit_number,*) '*** Bandes dissip ***'
473        DO i=0,mpi_size-1
474          write (unit_number,*) i,jj_nb_dissip(i)
475        enddo
476       
477    DO i=0,mpi_size-1
478          write (unit_number,*) i,distrib_phys(i)
479        enddo
480
481        CLOSE(unit_number)   
482      else
483        PRINT *,'probleme lors de l ecriture des bandes'
484      endif
485       
486    END SUBROUTINE  WriteBands
487 
488  END MODULE Bands
489 
490 
491
Note: See TracBrowser for help on using the repository browser.