source: branches/publications/ORCHILEAK-Gommet/src_parallel/mod_orchidee_mpi_data.F90 @ 7346

Last change on this file since 7346 was 3115, checked in by josefine.ghattas, 8 years ago

If XIOS is activated then all IOIPSL are deactivated. It is not longer possible to have both XIOS and IOIPSL output in the same run.
Some change in comments.
File size: 9.8 KB
Line 
1! Definition and allocation of parallel datas for MPI.
2! Initialization of parallel or sequentiel IOs.
3! Definition of Load Balancing functions.
4
5!-
6!- $Header: $
7!-
8
9MODULE mod_orchidee_mpi_data
10
11!-
12  USE defprec
13  USE ioipsl
14  USE xios_orchidee
15  USE mod_orchidee_para_var
16
17  IMPLICIT NONE
18
19!-
20#include "src_parallel.h"
21!-
22!-
23
24CONTAINS
25 
26  SUBROUTINE Init_orchidee_mpi(communicator)
27
28
29    IMPLICIT NONE
30    INTEGER, OPTIONAL, INTENT(in) :: communicator
31    INTEGER :: COMM
32    INTEGER :: ierr
33   
34#ifdef CPP_PARA
35    INCLUDE 'mpif.h'
36#endif
37
38    !Config Key   = XIOS_ORCHIDEE_OK
39    !Config Desc  = Use XIOS for writing diagnostics file
40    !Config If    =
41    !Config Def   = y
42    !Config Help  = If XIOS_ORCHIDEE_OK=y then no output with IOIPSL can be done
43    !Config Units = [FLAG]
44    CALL getin('XIOS_ORCHIDEE_OK',xios_orchidee_ok)
45    WRITE(numout,*)'In init_ochidee_mpi : xios_orchidee_ok=',xios_orchidee_ok
46
47#ifdef CPP_PARA
48    IF ( xios_orchidee_ok ) THEN
49       CALL MPI_INIT(ierr)
50       CALL xios_orchidee_comm_init(COMM)
51    ELSE IF ( PRESENT(communicator) ) THEN
52       COMM=communicator
53    ELSE
54       CALL MPI_INIT(ierr)
55       COMM=MPI_COMM_WORLD
56    ENDIF
57    CALL MPI_COMM_SIZE(COMM,mpi_size,ierr)
58    CALL MPI_COMM_RANK(COMM,mpi_rank,ierr)
59    is_ok_mpi=.TRUE.
60#else
61    mpi_rank=0
62    mpi_size=1
63    is_ok_mpi=.FALSE.
64    ! It is not possible to use XIOS without MPI
65    WRITE(numout,*)'XIOS cannot be run without MPI. xios_orchidee_ok is set to false.'
66    xios_orchidee_ok=.FALSE.
67#endif
68   
69    mpi_rank_root=0
70
71    IF (mpi_rank==mpi_rank_root) THEN
72      is_mpi_root=.TRUE.
73    ELSE
74      is_mpi_root=.FALSE.
75    ENDIF
76 
77    CALL Init_const_mpi(COMM)
78     
79  END SUBROUTINE Init_orchidee_mpi
80
81
82
83  SUBROUTINE Init_orchidee_mpi_data(arg_nbp_mpi,arg_kindex_mpi,arg_offset_mpi,COMM)
84
85  IMPLICIT NONE
86#ifdef CPP_PARA
87    INCLUDE 'mpif.h'
88#endif
89    INTEGER, INTENT(IN) :: arg_nbp_mpi
90    INTEGER, INTENT(IN) :: arg_kindex_mpi(arg_nbp_mpi)
91    INTEGER, INTENT(IN) :: arg_offset_mpi
92    INTEGER, INTENT(IN) :: COMM
93
94    INTEGER :: i
95 
96#ifdef CPP_PARA
97    INTEGER :: ierr
98    is_ok_mpi=.TRUE.
99#else
100    is_ok_mpi=.FALSE.
101#endif
102
103    ! Initialization of MPI_COMM_ORCH
104    CALL init_const_mpi(COMM)
105    IF (is_ok_mpi) THEN   
106#ifdef CPP_PARA
107      CALL MPI_COMM_SIZE(MPI_COMM_ORCH,mpi_size,ierr)   
108      CALL MPI_COMM_RANK(MPI_COMM_ORCH,mpi_rank,ierr)
109#endif
110    ELSE
111      mpi_size=1
112      mpi_rank=0
113    ENDIF   
114   
115    IF (mpi_rank == 0) THEN
116      mpi_rank_root = 0
117      is_mpi_root = .true.
118    ENDIF
119   
120    ALLOCATE(nbp_mpi_para(0:mpi_size-1))
121    ALLOCATE(nbp_mpi_para_begin(0:mpi_size-1))
122    ALLOCATE(nbp_mpi_para_end(0:mpi_size-1))   
123    ALLOCATE(jj_para_nb(0:mpi_size-1))
124    ALLOCATE(jj_para_begin(0:mpi_size-1))
125    ALLOCATE(jj_para_end(0:mpi_size-1))
126    ALLOCATE(ii_para_begin(0:mpi_size-1))
127    ALLOCATE(ii_para_end(0:mpi_size-1))   
128    ALLOCATE(ij_para_nb(0:mpi_size-1))
129    ALLOCATE(ij_para_begin(0:mpi_size-1))
130    ALLOCATE(ij_para_end(0:mpi_size-1))
131   
132
133    nbp_mpi=arg_nbp_mpi
134    ALLOCATE(kindex_mpi(nbp_mpi))
135    kindex_mpi(:)=arg_kindex_mpi(:)
136   
137    offset_mpi=arg_offset_mpi
138   
139    IF (is_ok_mpi) THEN
140#ifdef CPP_PARA
141      CALL MPI_AllGather(nbp_mpi,1,MPI_INT_ORCH,nbp_mpi_para,1,MPI_INT_ORCH,MPI_COMM_ORCH,ierr)
142#endif
143    ELSE
144      nbp_mpi_para(0)=nbp_mpi
145    ENDIF
146   
147    nbp_mpi_para_begin(0)=1
148    nbp_mpi_para_end(0)=nbp_mpi_para(0)
149    DO i=1,mpi_size-1
150      nbp_mpi_para_begin(i)=nbp_mpi_para_end(i-1)+1
151      nbp_mpi_para_end(i)=nbp_mpi_para_begin(i)+nbp_mpi_para(i)-1
152    ENDDO
153    nbp_mpi_begin=nbp_mpi_para_begin(mpi_rank)
154    nbp_mpi_end=nbp_mpi_para_end(mpi_rank)
155   
156   
157    IF (mpi_rank==mpi_size-1) THEN
158      ij_end=iim_g*jjm_g
159    ELSE
160      ij_end=kindex_mpi(nbp_mpi)+offset_mpi
161    ENDIF
162
163    IF (is_ok_mpi) THEN   
164#ifdef CPP_PARA   
165      CALL MPI_Allgather(ij_end,1,MPI_INT_ORCH,ij_para_end,1,MPI_INT_ORCH,MPI_COMM_ORCH,ierr)
166#endif
167    ELSE
168      ij_para_end(0)=ij_end
169    ENDIF
170   
171    ij_para_begin(0)=1
172    ij_para_nb(0)=ij_para_end(0)-ij_para_begin(0)+1
173   
174    DO i=1,mpi_size-1
175      ij_para_begin(i)=ij_para_end(i-1)+1
176      ij_para_nb(i)=ij_para_end(i)-ij_para_begin(i)+1
177    ENDDO
178   
179    DO i=0,mpi_size-1
180      jj_para_begin(i)=(ij_para_begin(i)-1)/iim_g + 1
181      jj_para_end(i)=(ij_para_end(i)-1)/iim_g + 1
182      jj_para_nb(i)=jj_para_end(i)-jj_para_begin(i)+1
183         
184      ii_para_begin(i)=MOD(ij_para_begin(i)-1,iim_g)+1
185      ii_para_end(i)=MOD(ij_para_end(i)-1,iim_g)+1
186    ENDDO
187
188   
189    ij_nb=ij_para_nb(mpi_rank)
190    ij_begin=ij_para_begin(mpi_rank)
191    ij_end=ij_para_end(mpi_rank)
192       
193    jj_nb=jj_para_nb(mpi_rank)
194    jj_begin=jj_para_begin(mpi_rank)
195    jj_end=jj_para_end(mpi_rank)
196   
197    ii_begin=ii_para_begin(mpi_rank)
198    ii_end=ii_para_end(mpi_rank)
199       
200     
201    CALL print_mpi_data
202 
203   
204  END SUBROUTINE Init_orchidee_mpi_data
205 
206  SUBROUTINE init_const_mpi(COMM)
207
208  IMPLICIT NONE
209    INTEGER :: COMM
210
211#ifdef CPP_PARA
212    INCLUDE 'mpif.h'
213   
214    MPI_COMM_ORCH=COMM
215   
216    IF (i_std==i_4) THEN
217       MPI_INT_ORCH=MPI_INTEGER4
218    ELSEIF (i_std==i_8) THEN
219       MPI_INT_ORCH=MPI_INTEGER8
220    ELSE
221       MPI_INT_ORCH=MPI_INTEGER
222    ENDIF
223         
224    IF (r_std==r_4) THEN
225       MPI_REAL_ORCH=MPI_REAL4
226    ELSEIF (r_std==r_8) THEN
227       MPI_REAL_ORCH=MPI_REAL8
228    ELSE
229       MPI_REAL_ORCH=MPI_REAL
230    ENDIF
231#endif
232
233  END SUBROUTINE init_const_mpi
234
235  SUBROUTINE Finalize_mpi
236
237  IMPLICIT NONE
238#ifdef CPP_PARA
239  include 'mpif.h' 
240  INTEGER :: ierr
241
242  CALL xios_orchidee_finalize
243
244  CALL MPI_FINALIZE(ierr)
245#endif
246   
247  END SUBROUTINE Finalize_mpi
248 
249  SUBROUTINE print_mpi_data
250
251  IMPLICIT NONE
252   
253    WRITE(numout,*) '==== MPI DOMAIN ===='
254    WRITE(numout,*) '     ----------     '
255    WRITE(numout,*) 'mpi_size',mpi_size
256    WRITE(numout,*) 'mpi_rank',mpi_rank
257    WRITE(numout,*) 'is_mpi_root',is_mpi_root
258    WRITE(numout,*) 'mpi_rank_root',mpi_rank_root
259
260    WRITE(numout,*) 'nbp_mpi_begin=',nbp_mpi_begin
261    WRITE(numout,*) 'nbp_mpi_end  =',nbp_mpi_end
262    WRITE(numout,*) 'nbp_mpi=',nbp_mpi
263         
264    WRITE(numout,*) 'ij_begin=',ij_begin
265    WRITE(numout,*) 'ij_end=',ij_end
266    WRITE(numout,*) 'ij_nb=',ij_nb
267    WRITE(numout,*) 'jj_begin=',jj_begin
268    WRITE(numout,*) 'jj_end=',jj_end
269    WRITE(numout,*) 'jj_nb=',jj_nb     
270    WRITE(numout,*) 'ii_begin=',ii_begin
271    WRITE(numout,*) 'ii_end=',ii_end
272   
273    WRITE(numout,*) 'offset_mpi',offset_mpi
274    WRITE(numout,*) 'nbp_mpi_para_begin=',nbp_mpi_para_begin
275    WRITE(numout,*) 'nbp_mpi_para_end  =',nbp_mpi_para_end
276    WRITE(numout,*) 'nbp_mpi_para=',nbp_mpi_para
277         
278    WRITE(numout,*) 'ij_para_begin=',ij_para_begin
279    WRITE(numout,*) 'ij_para_end=',ij_para_end
280    WRITE(numout,*) 'ij_para_nb=',ij_para_nb
281    WRITE(numout,*) 'jj_para_begin=',jj_para_begin
282    WRITE(numout,*) 'jj_para_end=',jj_para_end
283    WRITE(numout,*) 'jj_para_nb=',jj_para_nb   
284    WRITE(numout,*) 'ii_para_begin=',ii_para_begin
285    WRITE(numout,*) 'ii_para_end=',ii_para_end
286 
287  END SUBROUTINE print_mpi_data
288 
289 SUBROUTINE Read_Load_balance(NbPoints,Nbpoints_loc)
290
291    IMPLICIT NONE
292    INTEGER,INTENT(IN)  :: NbPoints
293    INTEGER,INTENT(OUT) :: Nbpoints_loc(0:mpi_size-1)
294    INTEGER :: i,s
295    INTEGER :: ierr
296   
297#ifdef CPP_PARA
298    CHARACTER(len=255)  :: filename='Load_balance_orchidee.dat'
299    INTEGER :: j
300    INTEGER :: unit_number=10
301#endif   
302
303#ifdef CPP_PARA
304    OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='old',FORM='formatted',IOSTAT=ierr) 
305#else
306    ierr=1
307#endif   
308    Nbpoints_loc(:) = 0
309
310    s=0
311#ifdef CPP_PARA 
312    IF (ierr==0) THEN
313       i=0
314       !- Reading for any balancing file (even with a bad structure)
315       DO WHILE (i < mpi_size .AND. ierr == 0) 
316          READ (unit_number,*,IOSTAT=ierr) j,Nbpoints_loc(i)
317          s=s+Nbpoints_loc(i)
318          i=i+1
319       ENDDO
320       CLOSE(unit_number)
321    ENDIF
322#endif   
323   
324    !- Correction of bad balancing file (or an empty file) => same nb of points for each procs
325    IF (ierr/=0 .OR. s/=Nbpoints) THEN
326       DO i=0,mpi_size-1
327          Nbpoints_loc(i)=Nbpoints/mpi_size
328          IF (MOD(Nbpoints,mpi_size) > i) Nbpoints_loc(i)=Nbpoints_loc(i)+1
329       ENDDO
330    ENDIF
331   
332  END SUBROUTINE Read_Load_balance
333 
334  SUBROUTINE Write_Load_balance(times)
335    IMPLICIT NONE
336    REAL,INTENT(IN) :: times
337 
338    CHARACTER(len=255)  :: filename='Load_balance_orchidee.dat'
339    INTEGER :: unit_number=10
340    INTEGER :: i,ierr
341    REAL :: All_Times(0:mpi_size-1)
342    REAL :: average
343    REAL :: efficiency
344    INTEGER :: dp,S
345    INTEGER :: New_nbpoints(0:mpi_size-1)
346   
347    WRITE(numout,*) 'time',times
348
349    IF (is_ok_mpi) THEN
350#ifdef CPP_PARA
351      CALL MPI_GATHER(times,1,MPI_REAL_ORCH,All_times,1,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
352#endif
353    ELSE
354      All_times(:)=times
355    ENDIF
356   
357    IF (is_mpi_root) WRITE(numout,*) 'ALL_times',All_times
358
359    IF (is_mpi_root) THEN
360     
361       OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='replace',FORM='formatted',IOSTAT=ierr)
362       
363       average=sum(All_times(:))/mpi_size
364       DO i=0,mpi_size-1
365          efficiency=All_times(i)/nbp_mpi_para(i)
366          New_nbpoints(i)=Nbp_mpi_para(i)-(All_times(i)-average)/efficiency
367       ENDDO
368       
369       S=sum(new_nbpoints(:))
370       dp=nbp_glo-S
371       
372       IF ( dp > 0 ) THEN
373          DO WHILE ( dp > 0 )
374             New_nbpoints(MOD(dp,mpi_size))=New_nbpoints(MOD(dp,mpi_size))+1
375             dp=dp-1
376          ENDDO
377       ELSE
378          dp=-dp
379          DO WHILE ( dp > 0 )
380             New_nbpoints(MOD(dp,mpi_size))=New_nbpoints(MOD(dp,mpi_size))-1
381             dp=dp-1
382          ENDDO
383       ENDIF
384       
385
386       ! If this algorithm diverge, we use previous repartition.
387       IF ( ANY(New_nbpoints(:) .LE. 0) ) THEN
388          New_nbpoints(:)=Nbp_mpi_para(:)
389       ENDIF
390       
391       DO i=0,mpi_size-1
392          WRITE(Unit_number,*) i,New_nbpoints(i)
393       ENDDO
394       CLOSE(Unit_number)
395    ENDIF
396
397  END SUBROUTINE Write_Load_Balance
398 
399END MODULE mod_orchidee_mpi_data
400
401#include "mpi_dummy.h"
Note: See TracBrowser for help on using the repository browser.