source: branches/ORCHIDEE_2_2/ORCHIDEE/src_parallel/mod_orchidee_mpi_data.F90 @ 8377

Last change on this file since 8377 was 8377, checked in by jan.polcher, 6 months ago

The modifications performed on the trunk for the coupling to WRF and the interpolation by XIOS on curviliean grids has been backported.
  • Property svn:keywords set to Date Revision HeadURL
File size: 18.3 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$
21!! $Date$
22!! $Revision$
23!! \n
24!_ ================================================================================================================================
25
26
27MODULE mod_orchidee_mpi_data
28
29!-
30  USE defprec
31  USE ioipsl_para
32  USE mod_orchidee_para_var
33
34  IMPLICIT NONE
35
36!-
37#include "src_parallel.h"
38!-
39!-
40
41CONTAINS
42
43  !!  =============================================================================================================================
44  !! SUBROUTINE:  Init_orchidee_mpi
45  !!
46  !>\BRIEF       Initialization of the mpi parallelization in ORCHIDEE offline mode.
47  !!
48  !! DESCRIPTION:        Initialization of the mpi parallelization in ORCHIDEE offline mode.
49  !!
50  !! \n
51  !_ ==============================================================================================================================
52  SUBROUTINE Init_orchidee_mpi(communicator, usexios)
53
54
55    IMPLICIT NONE
56    INTEGER, OPTIONAL, INTENT(in) :: communicator
57    LOGICAL, OPTIONAL, INTENT(in) :: usexios
58    INTEGER :: COMM, COMM_in
59    INTEGER :: ierr
60    LOGICAL :: xios_orchidee_ok     !! Local variable read from run.def
61    LOGICAL :: ismpiinit
62   
63#ifdef CPP_PARA
64    INCLUDE 'mpif.h'
65#endif
66    IF ( .NOT. PRESENT(usexios) ) THEN
67       ! Read XIOS_ORCHIDEE_OK from run.def. In this module, due to cyclic dependancies
68       ! the variable can not be used from module xios_orchidee.
69       xios_orchidee_ok=.TRUE.
70       CALL getin('XIOS_ORCHIDEE_OK',xios_orchidee_ok)
71    ELSE
72       xios_orchidee_ok = usexios
73    ENDIF
74
75#ifdef CPP_PARA
76    IF ( PRESENT(communicator) ) THEN
77       COMM_in=communicator
78    ELSE
79       COMM_in=MPI_COMM_WORLD
80    ENDIF
81    !
82    ! This functions tests if MPI is initialized and thus determines if ORCHIDEE
83    ! is used in conjunction with OASIS who would have initialized MPI and provided
84    ! a local communicator.
85    !
86   
87    CALL MPI_INITIALIZED(ismpiinit, ierr)
88   
89    IF ( xios_orchidee_ok ) THEN
90       IF ( .NOT. ismpiinit ) THEN
91          CALL MPI_INIT(ierr)
92       ENDIF
93       CALL xios_orchidee_comm_init(COMM_in, COMM)
94    ELSE
95       IF ( .NOT. ismpiinit ) THEN
96          CALL MPI_INIT(ierr)
97       ENDIF
98       COMM=COMM_in
99    ENDIF
100    CALL MPI_COMM_SIZE(COMM,mpi_size,ierr)
101    CALL MPI_COMM_RANK(COMM,mpi_rank,ierr)
102    is_ok_mpi=.TRUE.
103#else
104    mpi_rank=0
105    mpi_size=1
106    is_ok_mpi=.FALSE.
107    ! It is not possible to use XIOS without MPI
108    WRITE(numout,*) 'XIOS cannot be run without MPI. xios_orchidee_ok is set to false.'
109    xios_orchidee_ok=.FALSE.
110#endif
111   
112    mpi_rank_root=0
113
114    IF (mpi_rank==mpi_rank_root) THEN
115      is_mpi_root=.TRUE.
116    ELSE
117      is_mpi_root=.FALSE.
118    ENDIF
119 
120    CALL Init_const_mpi(COMM)
121     
122  END SUBROUTINE Init_orchidee_mpi
123
124  !! ==============================================================================================================================
125  !! SUBROUTINE   : xios_orchidee_comm_init
126  !!
127  !>\BRIEF         Get the MPI communicator.
128  !!
129  !! DESCRIPTION  :\n First call to XIOS to get the MPI communicator.
130  !!                  Note that it is XIOS that initialize the MPI communicator.
131  !!                  This subroutine is only called in ORCHIDEE offline mode. When running in coupled mode, the
132  !!                  atmospheric model must initlialize XIOS at the same time as initializing MPI.
133  !! \n
134  !_ ================================================================================================================================
135
136  SUBROUTINE xios_orchidee_comm_init(comm_in, comm_local)
137#ifdef XIOS
138    USE xios
139#endif
140    !
141    !! 0. Variable and parameter declaration
142    !
143    !!    Output variables
144    INTEGER, INTENT(IN)  :: comm_in
145    INTEGER, INTENT(OUT) :: comm_local
146    CHARACTER(len=*),PARAMETER      :: id="client"           !! Id for initialization of ORCHIDEE in XIOS
147
148    !_ ================================================================================================================================
149#ifdef CPP_PARA
150    INCLUDE 'mpif.h'
151#endif
152   
153    IF (is_omp_root) THEN
154#ifdef XIOS
155       IF ( comm_in .EQ. MPI_COMM_WORLD ) THEN
156          CALL xios_initialize(id,return_comm=comm_local)
157       ELSE
158          CALL xios_initialize(id,local_comm=comm_in,return_comm=comm_local)
159       ENDIF
160#else
161       ! Write error messages and stop the model
162       WRITE(numout,*) 'Preprocessing key XIOS is missing to run ORCHIDEE with XIOS'
163       WRITE(numout,*) 'Recompile with preprocessing flag XIOS or set XIOS_ORCHIDEE_OK=n in run.def'
164       WRITE(numout,*) 'Fatal error from ORCHIDEE. STOP in xios_orchidee_comm_init'
165#ifdef CPP_PARA
166       CALL MPI_ABORT(3)
167#endif     
168       STOP 1       
169#endif
170   
171    END IF
172  END SUBROUTINE xios_orchidee_comm_init
173 
174
175  !! ==============================================================================================================================
176  !! SUBROUTINE   : xios_orchidee_finalize
177  !!
178  !>\BRIEF         Last call to XIOS for finalization.
179  !!
180  !! DESCRIPTION  :\n Last call to XIOS for finalization of the orchidee context and XIOS.
181  !!                  This subroutine is called only when ORCHIDEE is run in offline mode. In coupled mode it is the atmospheric
182  !!                  model that finalizes XIOS. In that case, the context orchidee must be finalized using the
183  !!                  subroutine xios_orchidee_context_finalize
184  !!                 
185  !! \n
186  !_ ================================================================================================================================
187
188  SUBROUTINE xios_orchidee_finalize
189#ifdef XIOS
190  USE xios, ONLY : xios_context_finalize, xios_finalize
191#endif
192    LOGICAL :: xios_orchidee_ok ! Local variable read from run.def
193
194    ! Read XIOS_ORCHIDEE_OK from run.def. In this module, due to cyclic dependancies
195    ! the variable can not be used from module xios_orchidee.
196    xios_orchidee_ok=.TRUE.
197    IF (is_omp_root) CALL getin('XIOS_ORCHIDEE_OK',xios_orchidee_ok)
198    !_ ================================================================================================================================
199
200    IF (xios_orchidee_ok .AND. is_omp_root) THEN
201#ifdef XIOS
202       CALL xios_context_finalize()
203       CALL xios_finalize()
204#endif
205    END IF
206  END SUBROUTINE xios_orchidee_finalize
207 
208
209
210  SUBROUTINE Init_orchidee_mpi_data(arg_nbp_mpi,arg_kindex_mpi,arg_offset_mpi,COMM)
211
212  IMPLICIT NONE
213#ifdef CPP_PARA
214    INCLUDE 'mpif.h'
215#endif
216    INTEGER, INTENT(IN) :: arg_nbp_mpi
217    INTEGER, INTENT(IN) :: arg_kindex_mpi(arg_nbp_mpi)
218    INTEGER, INTENT(IN) :: arg_offset_mpi
219    INTEGER, INTENT(IN) :: COMM
220
221    INTEGER :: i
222 
223#ifdef CPP_PARA
224    INTEGER :: ierr
225    is_ok_mpi=.TRUE.
226#else
227    is_ok_mpi=.FALSE.
228#endif
229
230    ! Initialization of MPI_COMM_ORCH
231    CALL init_const_mpi(COMM)
232    IF (is_ok_mpi) THEN   
233#ifdef CPP_PARA
234      CALL MPI_COMM_SIZE(MPI_COMM_ORCH,mpi_size,ierr)   
235      CALL MPI_COMM_RANK(MPI_COMM_ORCH,mpi_rank,ierr)
236#endif
237    ELSE
238      mpi_size=1
239      mpi_rank=0
240    ENDIF   
241   
242    IF (mpi_rank == 0) THEN
243      mpi_rank_root = 0
244      is_mpi_root = .true.
245    ENDIF
246   
247    ! Test if there is enough land grid cells on each process MPI.
248    ! At least 2 grid cells are needed for each process if running in parallel. Stop if this is not the case.
249    IF ( arg_nbp_mpi < 1 ) THEN
250       PRINT*,'Init_orchidee_mpi_data: nbp_mpi(number of grid-cells for current MPI process)=',arg_nbp_mpi
251       PRINT*,'nbp_mpi=0 is not possible. It must be 1 or bigger for each MPI process. Stop now.'
252       CALL ipslerr_p(3, "Init_orchidee_mpi_data","Not all MPI processes has enough land grid cells",&
253            "Make the region bigger or use a lower number of MPI processes.","")
254    ELSE IF (arg_nbp_mpi == 1 .AND. mpi_size > 1) THEN
255       CALL ipslerr_p(1, "Init_orchidee_mpi_data","nbp=1 for current MPI process",&
256            "This can be a problem in some case.", &
257            "If the model crashes, then make the region bigger or use a lower number of MPI processes.")
258    END IF
259
260    ALLOCATE(nbp_mpi_para(0:mpi_size-1))
261    ALLOCATE(nbp_mpi_para_begin(0:mpi_size-1))
262    ALLOCATE(nbp_mpi_para_end(0:mpi_size-1))   
263    ALLOCATE(jj_para_nb(0:mpi_size-1))
264    ALLOCATE(jj_para_begin(0:mpi_size-1))
265    ALLOCATE(jj_para_end(0:mpi_size-1))
266    ALLOCATE(ii_para_begin(0:mpi_size-1))
267    ALLOCATE(ii_para_end(0:mpi_size-1))   
268    ALLOCATE(ij_para_nb(0:mpi_size-1))
269    ALLOCATE(ij_para_begin(0:mpi_size-1))
270    ALLOCATE(ij_para_end(0:mpi_size-1))
271   
272
273    nbp_mpi=arg_nbp_mpi
274    ALLOCATE(kindex_mpi(nbp_mpi))
275    kindex_mpi(:)=arg_kindex_mpi(:)
276   
277    offset_mpi=arg_offset_mpi
278   
279    IF (is_ok_mpi) THEN
280#ifdef CPP_PARA
281      CALL MPI_AllGather(nbp_mpi,1,MPI_INT_ORCH,nbp_mpi_para,1,MPI_INT_ORCH,MPI_COMM_ORCH,ierr)
282#endif
283    ELSE
284      nbp_mpi_para(0)=nbp_mpi
285    ENDIF
286   
287    nbp_mpi_para_begin(0)=1
288    nbp_mpi_para_end(0)=nbp_mpi_para(0)
289    DO i=1,mpi_size-1
290      nbp_mpi_para_begin(i)=nbp_mpi_para_end(i-1)+1
291      nbp_mpi_para_end(i)=nbp_mpi_para_begin(i)+nbp_mpi_para(i)-1
292    ENDDO
293    nbp_mpi_begin=nbp_mpi_para_begin(mpi_rank)
294    nbp_mpi_end=nbp_mpi_para_end(mpi_rank)
295   
296   
297    IF (mpi_rank==mpi_size-1) THEN
298      ij_end=iim_g*jjm_g
299    ELSE
300      ij_end=kindex_mpi(nbp_mpi)+offset_mpi
301    ENDIF
302
303    IF (is_ok_mpi) THEN   
304#ifdef CPP_PARA   
305      CALL MPI_Allgather(ij_end,1,MPI_INT_ORCH,ij_para_end,1,MPI_INT_ORCH,MPI_COMM_ORCH,ierr)
306#endif
307    ELSE
308      ij_para_end(0)=ij_end
309    ENDIF
310   
311    ij_para_begin(0)=1
312    ij_para_nb(0)=ij_para_end(0)-ij_para_begin(0)+1
313   
314    DO i=1,mpi_size-1
315      ij_para_begin(i)=ij_para_end(i-1)+1
316      ij_para_nb(i)=ij_para_end(i)-ij_para_begin(i)+1
317    ENDDO
318   
319    DO i=0,mpi_size-1
320      jj_para_begin(i)=(ij_para_begin(i)-1)/iim_g + 1
321      jj_para_end(i)=(ij_para_end(i)-1)/iim_g + 1
322      jj_para_nb(i)=jj_para_end(i)-jj_para_begin(i)+1
323         
324      ii_para_begin(i)=MOD(ij_para_begin(i)-1,iim_g)+1
325      ii_para_end(i)=MOD(ij_para_end(i)-1,iim_g)+1
326    ENDDO
327
328   
329    ij_nb=ij_para_nb(mpi_rank)
330    ij_begin=ij_para_begin(mpi_rank)
331    ij_end=ij_para_end(mpi_rank)
332       
333    jj_nb=jj_para_nb(mpi_rank)
334    jj_begin=jj_para_begin(mpi_rank)
335    jj_end=jj_para_end(mpi_rank)
336   
337    ii_begin=ii_para_begin(mpi_rank)
338    ii_end=ii_para_end(mpi_rank)
339       
340     
341    CALL print_mpi_data
342 
343   
344  END SUBROUTINE Init_orchidee_mpi_data
345 
346  !!  =============================================================================================================================
347  !! SUBROUTINE:  init_const_mpi
348  !!
349  !>\BRIEF       Initialization of some constants related to the MPI parallelization
350  !!
351  !! DESCRIPTION: Initialization of some constants related to the MPI parallelization
352  !!
353  !! \n
354  !_ ==============================================================================================================================
355  SUBROUTINE init_const_mpi(COMM)
356
357  IMPLICIT NONE
358    INTEGER :: COMM
359
360#ifdef CPP_PARA
361    INCLUDE 'mpif.h'
362   
363    MPI_COMM_ORCH=COMM
364   
365    IF (i_std==i_4) THEN
366       MPI_INT_ORCH=MPI_INTEGER4
367    ELSEIF (i_std==i_8) THEN
368       MPI_INT_ORCH=MPI_INTEGER8
369    ELSE
370       MPI_INT_ORCH=MPI_INTEGER
371    ENDIF
372         
373    IF (r_std==r_4) THEN
374       MPI_REAL_ORCH=MPI_REAL4
375    ELSEIF (r_std==r_8) THEN
376       MPI_REAL_ORCH=MPI_REAL8
377    ELSE
378       MPI_REAL_ORCH=MPI_REAL
379    ENDIF
380#endif
381
382  END SUBROUTINE init_const_mpi
383
384  !!  =============================================================================================================================
385  !! SUBROUTINE:  Finalize_mpi
386  !!
387  !>\BRIEF       Close the MPI parallelization
388  !!
389  !! DESCRIPTION:    Close the MPI parallelization. The context XIOS will be closed before call to MPI_finalize routine
390  !!
391  !! \n
392  !_ ==============================================================================================================================
393  SUBROUTINE Finalize_mpi
394
395  IMPLICIT NONE
396#ifdef CPP_PARA
397  include 'mpif.h' 
398  INTEGER :: ierr
399
400  CALL xios_orchidee_finalize
401
402  CALL MPI_FINALIZE(ierr)
403#endif
404   
405  END SUBROUTINE Finalize_mpi
406 
407  !!  =============================================================================================================================
408  !! SUBROUTINE:  print_mpi_data
409  !!
410  !>\BRIEF       Print all data specific to MPI parallelization of ORCHIDEE
411  !!
412  !! DESCRIPTION:  Print all data specific to MPI parallelization of ORCHIDEE   
413  !!
414  !! \n
415  !_ ==============================================================================================================================
416  SUBROUTINE print_mpi_data
417
418  IMPLICIT NONE
419   
420    WRITE(numout,*) '==== MPI DOMAIN ===='
421    WRITE(numout,*) '     ----------     '
422    WRITE(numout,*) 'mpi_size',mpi_size
423    WRITE(numout,*) 'mpi_rank',mpi_rank
424    WRITE(numout,*) 'is_mpi_root',is_mpi_root
425    WRITE(numout,*) 'mpi_rank_root',mpi_rank_root
426
427    WRITE(numout,*) 'nbp_mpi_begin=',nbp_mpi_begin
428    WRITE(numout,*) 'nbp_mpi_end  =',nbp_mpi_end
429    WRITE(numout,*) 'nbp_mpi=',nbp_mpi
430         
431    WRITE(numout,*) 'ij_begin=',ij_begin
432    WRITE(numout,*) 'ij_end=',ij_end
433    WRITE(numout,*) 'ij_nb=',ij_nb
434    WRITE(numout,*) 'jj_begin=',jj_begin
435    WRITE(numout,*) 'jj_end=',jj_end
436    WRITE(numout,*) 'jj_nb=',jj_nb     
437    WRITE(numout,*) 'ii_begin=',ii_begin
438    WRITE(numout,*) 'ii_end=',ii_end
439   
440    WRITE(numout,*) 'offset_mpi',offset_mpi
441    WRITE(numout,*) 'nbp_mpi_para_begin=',nbp_mpi_para_begin
442    WRITE(numout,*) 'nbp_mpi_para_end  =',nbp_mpi_para_end
443    WRITE(numout,*) 'nbp_mpi_para=',nbp_mpi_para
444         
445    WRITE(numout,*) 'ij_para_begin=',ij_para_begin
446    WRITE(numout,*) 'ij_para_end=',ij_para_end
447    WRITE(numout,*) 'ij_para_nb=',ij_para_nb
448    WRITE(numout,*) 'jj_para_begin=',jj_para_begin
449    WRITE(numout,*) 'jj_para_end=',jj_para_end
450    WRITE(numout,*) 'jj_para_nb=',jj_para_nb   
451    WRITE(numout,*) 'ii_para_begin=',ii_para_begin
452    WRITE(numout,*) 'ii_para_end=',ii_para_end
453 
454  END SUBROUTINE print_mpi_data
455 
456  !!  =============================================================================================================================
457  !! SUBROUTINE:  Read_Load_balance
458  !!
459  !>\BRIEF       Read load balance file.
460  !!
461  !! DESCRIPTION:       Read load balance file. This is only done in offline mode.
462  !!                The load balance file contains information about the MPI partitionning on the different processes.
463  !!
464  !! \n
465  !_ ==============================================================================================================================
466 SUBROUTINE Read_Load_balance(NbPoints,Nbpoints_loc)
467
468    IMPLICIT NONE
469    INTEGER,INTENT(IN)  :: NbPoints
470    INTEGER,INTENT(OUT) :: Nbpoints_loc(0:mpi_size-1)
471    INTEGER :: i,s
472    INTEGER :: ierr
473   
474#ifdef CPP_PARA
475    CHARACTER(len=255)  :: filename='Load_balance_orchidee.dat'
476    INTEGER :: j
477    INTEGER :: unit_number=10
478#endif   
479
480#ifdef CPP_PARA
481    OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='old',FORM='formatted',IOSTAT=ierr) 
482#else
483    ierr=1
484#endif   
485    Nbpoints_loc(:) = 0
486
487    s=0
488#ifdef CPP_PARA 
489    IF (ierr==0) THEN
490       i=0
491       !- Reading for any balancing file (even with a bad structure)
492       DO WHILE (i < mpi_size .AND. ierr == 0) 
493          READ (unit_number,*,IOSTAT=ierr) j,Nbpoints_loc(i)
494          s=s+Nbpoints_loc(i)
495          i=i+1
496       ENDDO
497       CLOSE(unit_number)
498    ENDIF
499#endif   
500   
501    !- Correction of bad balancing file (or an empty file) => same nb of points for each procs
502    IF (ierr/=0 .OR. s/=Nbpoints) THEN
503       DO i=0,mpi_size-1
504          Nbpoints_loc(i)=Nbpoints/mpi_size
505          IF (MOD(Nbpoints,mpi_size) > i) Nbpoints_loc(i)=Nbpoints_loc(i)+1
506       ENDDO
507    ENDIF
508   
509  END SUBROUTINE Read_Load_balance
510 
511  !!  =============================================================================================================================
512  !! SUBROUTINE:  Write_Load_balance
513  !!
514  !>\BRIEF       Write the load balance file.
515  !!
516  !! DESCRIPTION:       Write the load balance file. This is only done in offline mode.
517  !!                The load balance file contains information about the MPI partitionning on the different processes.
518  !!
519  !! \n
520  !_ ==============================================================================================================================
521  SUBROUTINE Write_Load_balance(times)
522    IMPLICIT NONE
523    REAL,INTENT(IN) :: times
524 
525    CHARACTER(len=255)  :: filename='Load_balance_orchidee.dat'
526    INTEGER :: unit_number=10
527    INTEGER :: i,ierr
528    REAL :: All_Times(0:mpi_size-1)
529    REAL :: average
530    REAL :: efficiency
531    INTEGER :: dp,S
532    INTEGER :: New_nbpoints(0:mpi_size-1)
533   
534    IF (is_ok_mpi) THEN
535#ifdef CPP_PARA
536      CALL MPI_GATHER(times,1,MPI_REAL_ORCH,All_times,1,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
537#endif
538    ELSE
539      All_times(:)=times
540    ENDIF
541   
542    IF (is_mpi_root) WRITE(numout,*) 'ALL_times',All_times
543
544    IF (is_mpi_root) THEN
545     
546       OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='replace',FORM='formatted',IOSTAT=ierr)
547       
548       average=sum(All_times(:))/mpi_size
549       DO i=0,mpi_size-1
550          efficiency=All_times(i)/nbp_mpi_para(i)
551          New_nbpoints(i)=Nbp_mpi_para(i)-(All_times(i)-average)/efficiency
552       ENDDO
553       
554       S=sum(new_nbpoints(:))
555       dp=nbp_glo-S
556       
557       IF ( dp > 0 ) THEN
558          DO WHILE ( dp > 0 )
559             New_nbpoints(MOD(dp,mpi_size))=New_nbpoints(MOD(dp,mpi_size))+1
560             dp=dp-1
561          ENDDO
562       ELSE
563          dp=-dp
564          DO WHILE ( dp > 0 )
565             New_nbpoints(MOD(dp,mpi_size))=New_nbpoints(MOD(dp,mpi_size))-1
566             dp=dp-1
567          ENDDO
568       ENDIF
569       
570
571       ! If this algorithm diverge, we use previous repartition.
572       IF ( ANY(New_nbpoints(:) .LE. 0) ) THEN
573          New_nbpoints(:)=Nbp_mpi_para(:)
574       ENDIF
575       
576       DO i=0,mpi_size-1
577          WRITE(Unit_number,*) i,New_nbpoints(i)
578       ENDDO
579       CLOSE(Unit_number)
580    ENDIF
581
582  END SUBROUTINE Write_Load_Balance
583 
584END MODULE mod_orchidee_mpi_data
585
586#include "mpi_dummy.h"
Note: See TracBrowser for help on using the repository browser.