source: branches/publications/ORCHIDEE-MICT-BIOENERGY_r7298/src_parallel/mod_orchidee_mpi_data.F90 @ 7475

Last change on this file since 7475 was 7297, checked in by wei.li, 3 years ago

updated code for publication, 2021,9,25
File size: 15.0 KB
Line 
1! ==============================================================================================================================
2! MODULE   : mod_orchidee_mpi_data
3!
4! CONTACT      : orchidee-help _at_ listes.ipsl.fr
5!
6! LICENCE      : IPSL (2006)
7! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8!
9!>\BRIEF      All routines needed for the initialization of the MPI parallelization of Orchidee (coupled and offline)
10!!
11!!\n DESCRIPTION  :  Definition and allocation of parallel datas for MPI.
12!!                   Initialization of parallel or sequentiel IOs.
13!!                   Definition of Load Balancing functions.
14!!
15!! RECENT CHANGE(S): None
16!!
17!! REFERENCES(S)    : None
18!!
19!! SVN              :
20!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-MICT/ORCHIDEE/src_parallel/mod_orchidee_mpi_data.F90 $
21!! $Date: 2017-10-26 15:35:04 +0200 (Thu, 26 Oct 2017) $
22!! $Revision: 4719 $
23!! \n
24!_ ================================================================================================================================
25
26
27MODULE mod_orchidee_mpi_data
28
29!-
30  USE defprec
31  USE ioipsl
32  USE ioipsl_para
33  USE xios_orchidee
34  USE mod_orchidee_para_var
35
36  IMPLICIT NONE
37
38!-
39#include "src_parallel.h"
40!-
41!-
42
43CONTAINS
44
45  !!  =============================================================================================================================
46  !! SUBROUTINE:  Init_orchidee_mpi
47  !!
48  !>\BRIEF       Initialization of the mpi parallelization in ORCHIDEE offline mode.
49  !!
50  !! DESCRIPTION:        Initialization of the mpi parallelization in ORCHIDEE offline mode.
51  !!
52  !! \n
53  !_ ==============================================================================================================================
54  SUBROUTINE Init_orchidee_mpi(communicator)
55
56#ifdef CPP_PARA
57    USE mpi
58#endif
59
60    IMPLICIT NONE
61    INTEGER, OPTIONAL, INTENT(in) :: communicator
62    INTEGER :: COMM
63    INTEGER :: ierr
64
65    !Config Key   = XIOS_ORCHIDEE_OK
66    !Config Desc  = Use XIOS for writing diagnostics file
67    !Config If    =
68    !Config Def   = y
69    !Config Help  = If XIOS_ORCHIDEE_OK=y then no output with IOIPSL can be done
70    !Config Units = [FLAG]
71    CALL getin('XIOS_ORCHIDEE_OK',xios_orchidee_ok)
72
73#ifdef CPP_PARA
74    IF ( xios_orchidee_ok ) THEN
75       CALL MPI_INIT(ierr)
76       CALL xios_orchidee_comm_init(COMM)
77    ELSE IF ( PRESENT(communicator) ) THEN
78       COMM=communicator
79    ELSE
80       CALL MPI_INIT(ierr)
81       COMM=MPI_COMM_WORLD
82    ENDIF
83    CALL MPI_COMM_SIZE(COMM,mpi_size,ierr)
84    CALL MPI_COMM_RANK(COMM,mpi_rank,ierr)
85    is_ok_mpi=.TRUE.
86#else
87    mpi_rank=0
88    mpi_size=1
89    is_ok_mpi=.FALSE.
90    ! It is not possible to use XIOS without MPI
91    WRITE(numout,*) 'XIOS cannot be run without MPI. xios_orchidee_ok is set to false.'
92    xios_orchidee_ok=.FALSE.
93#endif
94   
95    mpi_rank_root=0
96
97    IF (mpi_rank==mpi_rank_root) THEN
98      is_mpi_root=.TRUE.
99    ELSE
100      is_mpi_root=.FALSE.
101    ENDIF
102 
103    CALL Init_const_mpi(COMM)
104     
105  END SUBROUTINE Init_orchidee_mpi
106
107
108
109  !!  =============================================================================================================================
110  !! SUBROUTINE:  Init_orchidee_mpi_data
111  !!
112  !>\BRIEF       Initialization of the mpi parallelization 
113  !!
114  !! DESCRIPTION: Initialization of the mpi parallelization. This subroutine is called from Init_orchidee_data_para
115  !!              which is called both in offline and coupled mode.
116  !!
117  !! \n
118  !_ ==============================================================================================================================
119  SUBROUTINE Init_orchidee_mpi_data(arg_nbp_mpi,arg_kindex_mpi,arg_offset_mpi,COMM)
120#ifdef CPP_PARA
121    USE mpi
122#endif
123
124  IMPLICIT NONE
125    INTEGER, INTENT(IN) :: arg_nbp_mpi
126    INTEGER, INTENT(IN) :: arg_kindex_mpi(arg_nbp_mpi)
127    INTEGER, INTENT(IN) :: arg_offset_mpi
128    INTEGER, INTENT(IN) :: COMM
129
130    INTEGER :: i
131 
132#ifdef CPP_PARA
133    INTEGER :: ierr
134    is_ok_mpi=.TRUE.
135#else
136    is_ok_mpi=.FALSE.
137#endif
138
139    ! Initialization of MPI_COMM_ORCH
140    CALL init_const_mpi(COMM)
141    IF (is_ok_mpi) THEN   
142#ifdef CPP_PARA
143      CALL MPI_COMM_SIZE(MPI_COMM_ORCH,mpi_size,ierr)   
144      CALL MPI_COMM_RANK(MPI_COMM_ORCH,mpi_rank,ierr)
145#endif
146    ELSE
147      mpi_size=1
148      mpi_rank=0
149    ENDIF   
150   
151    IF (mpi_rank == 0) THEN
152      mpi_rank_root = 0
153      is_mpi_root = .true.
154    ENDIF
155   
156    ! Test if there is enough land grid cells on each process MPI.
157    ! At least 2 grid cells are needed for each process if running in parallel. Stop if this is not the case.
158    IF ( arg_nbp_mpi < 1 ) THEN
159       PRINT*,'Init_orchidee_mpi_data: nbp_mpi(number of grid-cells for current MPI process)=',arg_nbp_mpi
160       PRINT*,'nbp_mpi=0 is not possible. It must be 1 or bigger for each MPI process. Stop now.'
161       CALL ipslerr_p(3, "Init_orchidee_mpi_data","Not all MPI processes has enough land grid cells",&
162            "Make the region bigger or use a lower number of MPI processes.","")
163    ELSE IF (arg_nbp_mpi == 1 .AND. mpi_size > 1) THEN
164       CALL ipslerr_p(1, "Init_orchidee_mpi_data","nbp=1 for current MPI process",&
165            "This can be a problem in some case.", &
166            "If the model crashes, then make the region bigger or use a lower number of MPI processes.")
167    END IF
168
169    ALLOCATE(nbp_mpi_para(0:mpi_size-1))
170    ALLOCATE(nbp_mpi_para_begin(0:mpi_size-1))
171    ALLOCATE(nbp_mpi_para_end(0:mpi_size-1))   
172    ALLOCATE(jj_para_nb(0:mpi_size-1))
173    ALLOCATE(jj_para_begin(0:mpi_size-1))
174    ALLOCATE(jj_para_end(0:mpi_size-1))
175    ALLOCATE(ii_para_begin(0:mpi_size-1))
176    ALLOCATE(ii_para_end(0:mpi_size-1))   
177    ALLOCATE(ij_para_nb(0:mpi_size-1))
178    ALLOCATE(ij_para_begin(0:mpi_size-1))
179    ALLOCATE(ij_para_end(0:mpi_size-1))
180   
181
182    nbp_mpi=arg_nbp_mpi
183    ALLOCATE(kindex_mpi(nbp_mpi))
184    kindex_mpi(:)=arg_kindex_mpi(:)
185   
186    offset_mpi=arg_offset_mpi
187   
188    IF (is_ok_mpi) THEN
189#ifdef CPP_PARA
190      CALL MPI_AllGather(nbp_mpi,1,MPI_INT_ORCH,nbp_mpi_para,1,MPI_INT_ORCH,MPI_COMM_ORCH,ierr)
191#endif
192    ELSE
193      nbp_mpi_para(0)=nbp_mpi
194    ENDIF
195   
196    nbp_mpi_para_begin(0)=1
197    nbp_mpi_para_end(0)=nbp_mpi_para(0)
198    DO i=1,mpi_size-1
199      nbp_mpi_para_begin(i)=nbp_mpi_para_end(i-1)+1
200      nbp_mpi_para_end(i)=nbp_mpi_para_begin(i)+nbp_mpi_para(i)-1
201    ENDDO
202    nbp_mpi_begin=nbp_mpi_para_begin(mpi_rank)
203    nbp_mpi_end=nbp_mpi_para_end(mpi_rank)
204   
205   
206    IF (mpi_rank==mpi_size-1) THEN
207      ij_end=iim_g*jjm_g
208    ELSE
209      ij_end=kindex_mpi(nbp_mpi)+offset_mpi
210    ENDIF
211
212    IF (is_ok_mpi) THEN   
213#ifdef CPP_PARA   
214      CALL MPI_Allgather(ij_end,1,MPI_INT_ORCH,ij_para_end,1,MPI_INT_ORCH,MPI_COMM_ORCH,ierr)
215#endif
216    ELSE
217      ij_para_end(0)=ij_end
218    ENDIF
219   
220    ij_para_begin(0)=1
221    ij_para_nb(0)=ij_para_end(0)-ij_para_begin(0)+1
222   
223    DO i=1,mpi_size-1
224      ij_para_begin(i)=ij_para_end(i-1)+1
225      ij_para_nb(i)=ij_para_end(i)-ij_para_begin(i)+1
226    ENDDO
227   
228    DO i=0,mpi_size-1
229      jj_para_begin(i)=(ij_para_begin(i)-1)/iim_g + 1
230      jj_para_end(i)=(ij_para_end(i)-1)/iim_g + 1
231      jj_para_nb(i)=jj_para_end(i)-jj_para_begin(i)+1
232         
233      ii_para_begin(i)=MOD(ij_para_begin(i)-1,iim_g)+1
234      ii_para_end(i)=MOD(ij_para_end(i)-1,iim_g)+1
235    ENDDO
236
237   
238    ij_nb=ij_para_nb(mpi_rank)
239    ij_begin=ij_para_begin(mpi_rank)
240    ij_end=ij_para_end(mpi_rank)
241       
242    jj_nb=jj_para_nb(mpi_rank)
243    jj_begin=jj_para_begin(mpi_rank)
244    jj_end=jj_para_end(mpi_rank)
245   
246    ii_begin=ii_para_begin(mpi_rank)
247    ii_end=ii_para_end(mpi_rank)
248       
249     
250    CALL print_mpi_data
251 
252   
253  END SUBROUTINE Init_orchidee_mpi_data
254 
255  !!  =============================================================================================================================
256  !! SUBROUTINE:  init_const_mpi
257  !!
258  !>\BRIEF       Initialization of some constants related to the MPI parallelization
259  !!
260  !! DESCRIPTION: Initialization of some constants related to the MPI parallelization
261  !!
262  !! \n
263  !_ ==============================================================================================================================
264  SUBROUTINE init_const_mpi(COMM)
265
266#ifdef CPP_PARA
267    USE mpi
268#endif
269
270  IMPLICIT NONE
271    INTEGER :: COMM
272
273#ifdef CPP_PARA
274    MPI_COMM_ORCH=COMM
275   
276    IF (i_std==i_4) THEN
277       MPI_INT_ORCH=MPI_INTEGER4
278    ELSEIF (i_std==i_8) THEN
279       MPI_INT_ORCH=MPI_INTEGER8
280    ELSE
281       MPI_INT_ORCH=MPI_INTEGER
282    ENDIF
283         
284    IF (r_std==r_4) THEN
285       MPI_REAL_ORCH=MPI_REAL4
286    ELSEIF (r_std==r_8) THEN
287       MPI_REAL_ORCH=MPI_REAL8
288    ELSE
289       MPI_REAL_ORCH=MPI_REAL
290    ENDIF
291#endif
292
293  END SUBROUTINE init_const_mpi
294
295  !!  =============================================================================================================================
296  !! SUBROUTINE:  Finalize_mpi
297  !!
298  !>\BRIEF       Close the MPI parallelization
299  !!
300  !! DESCRIPTION:    Close the MPI parallelization. The context XIOS will be closed before call to MPI_finalize routine
301  !!
302  !! \n
303  !_ ==============================================================================================================================
304  SUBROUTINE Finalize_mpi
305
306#ifdef CPP_PARA
307  USE mpi
308#endif
309
310  IMPLICIT NONE
311#ifdef CPP_PARA
312  INTEGER :: ierr
313
314  CALL xios_orchidee_finalize
315
316  CALL MPI_FINALIZE(ierr)
317#endif
318   
319  END SUBROUTINE Finalize_mpi
320 
321  !!  =============================================================================================================================
322  !! SUBROUTINE:  print_mpi_data
323  !!
324  !>\BRIEF       Print all data specific to MPI parallelization of ORCHIDEE
325  !!
326  !! DESCRIPTION:  Print all data specific to MPI parallelization of ORCHIDEE   
327  !!
328  !! \n
329  !_ ==============================================================================================================================
330  SUBROUTINE print_mpi_data
331
332  IMPLICIT NONE
333   
334    WRITE(numout,*) '==== MPI DOMAIN ===='
335    WRITE(numout,*) '     ----------     '
336    WRITE(numout,*) 'mpi_size',mpi_size
337    WRITE(numout,*) 'mpi_rank',mpi_rank
338    WRITE(numout,*) 'is_mpi_root',is_mpi_root
339    WRITE(numout,*) 'mpi_rank_root',mpi_rank_root
340
341    WRITE(numout,*) 'nbp_mpi_begin=',nbp_mpi_begin
342    WRITE(numout,*) 'nbp_mpi_end  =',nbp_mpi_end
343    WRITE(numout,*) 'nbp_mpi=',nbp_mpi
344         
345    WRITE(numout,*) 'ij_begin=',ij_begin
346    WRITE(numout,*) 'ij_end=',ij_end
347    WRITE(numout,*) 'ij_nb=',ij_nb
348    WRITE(numout,*) 'jj_begin=',jj_begin
349    WRITE(numout,*) 'jj_end=',jj_end
350    WRITE(numout,*) 'jj_nb=',jj_nb     
351    WRITE(numout,*) 'ii_begin=',ii_begin
352    WRITE(numout,*) 'ii_end=',ii_end
353   
354    WRITE(numout,*) 'offset_mpi',offset_mpi
355    WRITE(numout,*) 'nbp_mpi_para_begin=',nbp_mpi_para_begin
356    WRITE(numout,*) 'nbp_mpi_para_end  =',nbp_mpi_para_end
357    WRITE(numout,*) 'nbp_mpi_para=',nbp_mpi_para
358         
359    WRITE(numout,*) 'ij_para_begin=',ij_para_begin
360    WRITE(numout,*) 'ij_para_end=',ij_para_end
361    WRITE(numout,*) 'ij_para_nb=',ij_para_nb
362    WRITE(numout,*) 'jj_para_begin=',jj_para_begin
363    WRITE(numout,*) 'jj_para_end=',jj_para_end
364    WRITE(numout,*) 'jj_para_nb=',jj_para_nb   
365    WRITE(numout,*) 'ii_para_begin=',ii_para_begin
366    WRITE(numout,*) 'ii_para_end=',ii_para_end
367 
368  END SUBROUTINE print_mpi_data
369 
370  !!  =============================================================================================================================
371  !! SUBROUTINE:  Read_Load_balance
372  !!
373  !>\BRIEF       Read load balance file.
374  !!
375  !! DESCRIPTION:       Read load balance file. This is only done in offline mode.
376  !!                The load balance file contains information about the MPI partitionning on the different processes.
377  !!
378  !! \n
379  !_ ==============================================================================================================================
380 SUBROUTINE Read_Load_balance(NbPoints,Nbpoints_loc)
381
382    IMPLICIT NONE
383    INTEGER,INTENT(IN)  :: NbPoints
384    INTEGER,INTENT(OUT) :: Nbpoints_loc(0:mpi_size-1)
385    INTEGER :: i,s
386    INTEGER :: ierr
387   
388#ifdef CPP_PARA
389    CHARACTER(len=255)  :: filename='Load_balance_orchidee.dat'
390    INTEGER :: j
391    INTEGER :: unit_number=10
392#endif   
393
394#ifdef CPP_PARA
395    OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='old',FORM='formatted',IOSTAT=ierr) 
396#else
397    ierr=1
398#endif   
399    Nbpoints_loc(:) = 0
400
401    s=0
402#ifdef CPP_PARA 
403    IF (ierr==0) THEN
404       i=0
405       !- Reading for any balancing file (even with a bad structure)
406       DO WHILE (i < mpi_size .AND. ierr == 0) 
407          READ (unit_number,*,IOSTAT=ierr) j,Nbpoints_loc(i)
408          s=s+Nbpoints_loc(i)
409          i=i+1
410       ENDDO
411       CLOSE(unit_number)
412    ENDIF
413#endif   
414   
415    !- Correction of bad balancing file (or an empty file) => same nb of points for each procs
416    IF (ierr/=0 .OR. s/=Nbpoints) THEN
417       DO i=0,mpi_size-1
418          Nbpoints_loc(i)=Nbpoints/mpi_size
419          IF (MOD(Nbpoints,mpi_size) > i) Nbpoints_loc(i)=Nbpoints_loc(i)+1
420       ENDDO
421    ENDIF
422   
423  END SUBROUTINE Read_Load_balance
424 
425  !!  =============================================================================================================================
426  !! SUBROUTINE:  Write_Load_balance
427  !!
428  !>\BRIEF       Write the load balance file.
429  !!
430  !! DESCRIPTION:       Write the load balance file. This is only done in offline mode.
431  !!                The load balance file contains information about the MPI partitionning on the different processes.
432  !!
433  !! \n
434  !_ ==============================================================================================================================
435  SUBROUTINE Write_Load_balance(times)
436    IMPLICIT NONE
437    REAL,INTENT(IN) :: times
438 
439    CHARACTER(len=255)  :: filename='Load_balance_orchidee.dat'
440    INTEGER :: unit_number=10
441    INTEGER :: i,ierr
442    REAL :: All_Times(0:mpi_size-1)
443    REAL :: average
444    REAL :: efficiency
445    INTEGER :: dp,S
446    INTEGER :: New_nbpoints(0:mpi_size-1)
447   
448    IF (is_ok_mpi) THEN
449#ifdef CPP_PARA
450      CALL MPI_GATHER(times,1,MPI_REAL_ORCH,All_times,1,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
451#endif
452    ELSE
453      All_times(:)=times
454    ENDIF
455   
456    IF (is_mpi_root) WRITE(numout,*) 'ALL_times',All_times
457
458    IF (is_mpi_root) THEN
459     
460       OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='replace',FORM='formatted',IOSTAT=ierr)
461       
462       average=sum(All_times(:))/mpi_size
463       DO i=0,mpi_size-1
464          efficiency=All_times(i)/nbp_mpi_para(i)
465          New_nbpoints(i)=Nbp_mpi_para(i)-(All_times(i)-average)/efficiency
466       ENDDO
467       
468       S=sum(new_nbpoints(:))
469       dp=nbp_glo-S
470       
471       IF ( dp > 0 ) THEN
472          DO WHILE ( dp > 0 )
473             New_nbpoints(MOD(dp,mpi_size))=New_nbpoints(MOD(dp,mpi_size))+1
474             dp=dp-1
475          ENDDO
476       ELSE
477          dp=-dp
478          DO WHILE ( dp > 0 )
479             New_nbpoints(MOD(dp,mpi_size))=New_nbpoints(MOD(dp,mpi_size))-1
480             dp=dp-1
481          ENDDO
482       ENDIF
483       
484
485       ! If this algorithm diverge, we use previous repartition.
486       IF ( ANY(New_nbpoints(:) .LE. 0) ) THEN
487          New_nbpoints(:)=Nbp_mpi_para(:)
488       ENDIF
489       
490       DO i=0,mpi_size-1
491          WRITE(Unit_number,*) i,New_nbpoints(i)
492       ENDDO
493       CLOSE(Unit_number)
494    ENDIF
495
496  END SUBROUTINE Write_Load_Balance
497 
498END MODULE mod_orchidee_mpi_data
499
500#include "mpi_dummy.h"
Note: See TracBrowser for help on using the repository browser.