source: branches/publications/ORCHIDEE-PEAT_r5488/src_parallel/mod_orchidee_mpi_data.F90 @ 7442

Last change on this file since 7442 was 3770, checked in by albert.jornet, 8 years ago

Clean: use mpi is a better approach for Fortran 90. Include statement is used for Fortran 77.
Clean: add stomate_accu for 1, 2 and 3 dimensions. It deletes all warnings related to -check all compilation flag
Clean: useless altcalc variable type casting. It deletes all warnings related to -check all compilation flag
Clean: hsdeep_daily min check is done outside the subroutine call deep_carbcycle. It deletes all warnings related to -check all compilation flag
Fix: crop related variables are now always allocated. Those are passed to Stics_init or writerestart even if its module is not active.

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