source: CONFIG_DEVT/LMDZOR_V6.2_work_ENSEMBLES/modeles/ORCHIDEE/src_parallel/mod_orchidee_para.F90 @ 5493

Last change on this file since 5493 was 5493, checked in by ymipsl, 4 years ago

Ensemble management for orchidee.

YM
File size: 10.6 KB
Line 
1! ==============================================================================================================================
2! MODULE   : mod_orchidee_para
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      Initialization of MPI and OpenMP parallelization.
10!!
11!!\n DESCRIPTION  :  This module contains subroutines to be called for the initialization of MPI and OpenMP parallelization.
12!!                   Note that some subroutines are called only for the offline case such as init_orchidee_para and
13!!                   init_orchidee_data_para_driver.
14!!
15!! SVN              :
16!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE_2_2/ORCHIDEE/src_parallel/mod_orchidee_para.F90 $
17!! $Date: 2018-08-02 09:06:40 +0200 (Thu, 02 Aug 2018) $
18!! $Revision: 5364 $
19!! \n
20!_ ================================================================================================================================
21MODULE mod_orchidee_para
22
23  USE mod_orchidee_para_var
24  USE mod_orchidee_mpi_data
25  USE mod_orchidee_omp_data
26  USE mod_orchidee_transfert_para
27   
28CONTAINS
29   
30  !!  =============================================================================================================================
31  !! SUBROUTINE:  Init_orchidee_para
32  !!
33  !>\BRIEF       Initialization of MPI and OpenMP parallelization in offline case
34  !!
35  !! DESCRIPTION: First subroutine for initialization to be called for the initialization of the MPI and OpenMP parallelization
36  !!              in offline mode. This routine will call the successively the initialization for OMP then for MPI.
37  !!              We define in this routine the variable "is_root_prc = is_mpi_root AND is_omp_root".
38  !!
39  !! \n
40  !_ ==============================================================================================================================
41  SUBROUTINE Init_orchidee_para(communicator)
42    IMPLICIT NONE
43    INTEGER,OPTIONAL,INTENT(in) :: communicator 
44
45    CALL Init_orchidee_omp
46
47
48    IF ( PRESENT(communicator) ) THEN
49       CALL Init_orchidee_mpi(communicator)
50    ELSE
51       CALL Init_orchidee_mpi
52    ENDIF
53
54
55    IF (is_mpi_root .AND. is_omp_root) THEN
56       is_root_prc=.TRUE.
57    ELSE
58       is_root_prc=.FALSE.
59    ENDIF
60  END SUBROUTINE Init_orchidee_para
61   
62 
63  !!  =============================================================================================================================
64  !! SUBROUTINE:  Init_orchidee_data_para_driver
65  !!
66  !>\BRIEF       Initialization of variables related to the local domain decomposition called by the offline driver.
67  !!
68  !! DESCRIPTION: Initialization of variables related to the local domain decomposition.
69  !!              This subroutine is only called in offline mode by the driver.
70  !!
71  !! \n
72  !_ ==============================================================================================================================
73  SUBROUTINE Init_orchidee_data_para_driver(nbp,kindex_glo)
74
75    IMPLICIT NONE
76    INTEGER,INTENT(IN) :: nbp
77    INTEGER,INTENT(IN) :: kindex_glo(nbp)
78     
79    INTEGER :: first_point
80    INTEGER :: last_point
81    INTEGER :: nbp_loc
82    INTEGER :: nbp_loc_para(0:mpi_size-1)
83    INTEGER,ALLOCATABLE :: kindex_loc(:)
84    INTEGER :: offset
85    INTEGER :: i
86   
87     
88    last_point=0
89   
90    CALL read_load_balance(nbp,nbp_loc_para)   
91   
92    DO i=0,mpi_rank
93       nbp_loc=nbp_loc_para(i)
94       First_point=last_point+1
95       Last_point=last_point+nbp_loc
96    ENDDO
97   
98    ALLOCATE(kindex_loc(nbp_loc))
99    DO i=1,nbp_loc
100       kindex_loc(i)=kindex_glo(i+First_Point-1)
101    ENDDO
102   
103    IF (mpi_rank==0) THEN
104       offset=0
105    ELSE
106       offset=kindex_glo(First_point-1)-MOD(kindex_glo(First_point-1),iim_g)
107    ENDIF
108
109    kindex_loc(:)=kindex_loc(:)-offset
110
111    CALL Init_orchidee_data_para(nbp_loc,kindex_loc,offset,omp_size,omp_rank,MPI_COMM_ORCH)
112    CALL Set_stdout_file('out_orchidee')
113    CALL ipslnlf(new_number=numout)
114       
115  END SUBROUTINE Init_orchidee_data_para_driver
116   
117 
118  !!  =============================================================================================================================
119  !! SUBROUTINE:  Init_orchidee_data_para
120  !!
121  !>\BRIEF       Initialization of MPI and OpenMP parallelization.
122  !!
123  !! DESCRIPTION: Initialization of MPI and OpenMP parallelization.
124  !!              This subroutine is called from both the offline driver and from the initialization routine for the coupled mode.
125  !!              This routine will call the successively the initialization for omp and then for mpi.
126  !!              We define in this routine the variable "is_root_prc = is_mpi_root AND is_omp_root".
127  !!
128  !! \n
129  !_ ==============================================================================================================================
130  SUBROUTINE Init_orchidee_data_para(nbp,kindex,arg_offset,arg_omp_size,arg_omp_rank, COMM_ENSEMBLE)
131    USE mod_orchidee_ensemble
132    IMPLICIT NONE
133    INTEGER,INTENT(IN)     :: nbp
134    INTEGER,INTENT(IN)     :: kindex(nbp)
135    INTEGER,INTENT(IN)     :: arg_offset
136    INTEGER,INTENT(IN)     :: arg_omp_size
137    INTEGER,INTENT(IN)     :: arg_omp_rank
138    INTEGER,INTENT(IN)     :: COMM_ENSEMBLE
139   
140    INTEGER,SAVE              :: arg_nbp_mpi
141    INTEGER,ALLOCATABLE,SAVE  :: kindex_mpi(:)
142    LOGICAL                   :: last
143    INTEGER                   :: mpi_size
144    INTEGER                   :: mpi_rank
145    INTEGER                   :: ierr
146    INTEGER,SAVE              :: COMM
147       
148   
149    IF (arg_omp_rank==0) CALL init_orchidee_ensemble(COMM_ENSEMBLE,COMM)
150    CALL barrier2_omp()
151
152#ifdef CPP_PARA
153    CALL MPI_COMM_SIZE(COMM,mpi_size,ierr)
154    CALL MPI_COMM_RANK(COMM,mpi_rank,ierr)
155#else
156    mpi_rank=0
157    mpi_size=1
158#endif
159   
160    offset=arg_offset 
161    last=.FALSE.
162    IF (mpi_rank==mpi_size .AND. arg_omp_rank==arg_omp_size) last=.TRUE.
163    CALL init_orchidee_omp_data(arg_omp_size,arg_omp_rank,nbp,kindex, offset,last)
164   
165    IF (is_omp_root) THEN
166       arg_nbp_mpi=SUM(nbp_omp_para_nb(:))
167       ALLOCATE(kindex_mpi(arg_nbp_mpi))
168    ENDIF
169
170    CALL barrier2_omp()
171    kindex_mpi(nbp_omp_begin:nbp_omp_end)=kindex(:)+offset
172    CALL barrier2_omp()
173     
174    IF (is_omp_root) THEN     
175       kindex_mpi(:)=kindex_mpi(:)-offset
176       CALL init_orchidee_mpi_data(arg_nbp_mpi,kindex_mpi,offset,COMM)
177       nbp_glo=SUM(nbp_mpi_para(:))
178    ENDIF
179    CALL barrier2_omp()
180
181    nbp_loc=nbp
182
183    ! Define is_root_prc
184    ! Note that this is already done in init_orchidee_para for the offline case but it is done here again for the coupled case.
185    IF (is_mpi_root .AND. is_omp_root) THEN
186       is_root_prc=.TRUE.
187    ELSE
188       is_root_prc=.FALSE.
189    ENDIF
190   
191    CALL Test_orchidee_para
192
193  END SUBROUTINE Init_orchidee_data_para
194   
195  !!  =============================================================================================================================
196  !! SUBROUTINE:  Set_stdout_file
197  !!
198  !>\BRIEF       for each output file will give a unit number for the write function
199  !!
200  !! DESCRIPTION:       for each output file will give a unit number for the write function
201  !!
202  !! \n
203  !_ ==============================================================================================================================
204  SUBROUTINE Set_stdout_file(filename)
205
206    IMPLICIT NONE
207
208    CHARACTER(len=*), INTENT(IN) :: filename
209    CHARACTER(len=255) :: fileout
210    CHARACTER(len=4)  :: num_mpi
211    CHARACTER(len=4)  :: num_omp
212    INTEGER,PARAMETER :: base_numout=100
213    INTEGER           :: ierr
214
215    IF (is_ok_mpi) THEN
216       WRITE(num_mpi,'(I4.4)') mpi_rank
217    ENDIF
218   
219    IF (is_ok_omp) THEN
220       WRITE(num_omp,'(I4.4)') omp_rank
221    ENDIF
222   
223     
224    IF (is_ok_mpi .AND. is_ok_omp) THEN
225       fileout=TRIM(filename)//'_'//num_mpi//'.'//num_omp
226       numout=base_numout+omp_rank
227    ELSE IF (is_ok_mpi .AND. (.NOT. is_ok_omp)) THEN
228       fileout=TRIM(filename)//'_'//num_mpi
229       numout=base_numout
230    ELSE IF ((.NOT. is_ok_mpi) .AND. is_ok_omp) THEN
231       fileout=TRIM(filename)//'_'//num_omp
232       numout=base_numout+omp_rank
233    ELSE
234       fileout=TRIM(filename)
235       numout=base_numout
236    ENDIF
237!!$OMP CRITICAL 
238!    WRITE(*,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
239!!$OMP END CRITICAL
240   
241    OPEN(UNIT=numout,FILE=TRIM(fileout),ACTION='write',STATUS='unknown',FORM='formatted',IOSTAT=ierr) 
242    IF (ierr /= 0) THEN
243#ifdef CPP_PARA
244       CALL MPI_FINALIZE(ierr)
245#endif
246       WRITE(*,*) "In Set_stdout_file : Erreur can't open file ", filename
247       STOP 1
248    ENDIF
249 
250!!$OMP CRITICAL 
251!    WRITE(numout,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
252!!$OMP END CRITICAL
253
254    CALL Init_numout_omp(numout)
255
256  END SUBROUTINE Set_stdout_file
257     
258     
259  !!  =============================================================================================================================
260  !! SUBROUTINE:  Test_orchidee_para
261  !!
262  !>\BRIEF       
263  !!
264  !! DESCRIPTION:       
265  !!
266  !! \n
267  !_ ==============================================================================================================================
268  SUBROUTINE Test_orchidee_para
269
270    IMPLICIT NONE
271
272    INTEGER,PARAMETER :: dimsize=3
273    REAL :: Array(nbp_loc,dimsize)
274    REAL :: Array_glo(nbp_glo,dimsize)
275    REAL :: Array_glo_tmp(nbp_glo,dimsize)
276    REAL :: Array2D_loc(iim_g,jj_nb)
277    REAL :: Array2D_glo(iim_g,jjm_g)
278    REAL :: sum1,sum2,sum3
279   
280    INTEGER :: i,j
281   
282    DO j=1,dimsize
283       DO i=1,nbp_loc
284          Array(i,j)=10*j+omp_rank+i*1000
285       ENDDO
286    ENDDO
287     
288    CALL gather(Array,Array_glo)
289    CALL bcast(Array_glo)
290    CALL scatter(Array_glo,array)
291    CALL gather(array,array_glo_tmp)
292    CALL bcast(array_glo_tmp)   
293!    WRITE(*,*) "1) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",SUM(array_glo-array_glo_tmp)
294
295    sum1=SUM(array)
296    CALL reduce_sum(sum1,sum2)
297    CALL bcast(sum2)
298    sum3=SUM(array_glo)
299!    WRITE(*,*) "2) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum2
300   
301    IF (is_omp_root) THEN
302       DO j=1,jjm_g
303          DO i=1,iim_g
304             Array2D_glo(i,j)=(j-1)*iim_g+i
305          ENDDO
306       ENDDO
307       
308       array2D_loc(:,:)=0
309       CALL scatter2D_mpi(array2D_glo,array2D_loc)
310       array2D_glo(:,:)=0
311       CALL gather2D_mpi(array2D_loc,array2D_glo)
312       CALL bcast_mpi(array2D_glo)
313       sum1=SUM(array2D_glo)
314       sum2=SUM(array2D_loc)
315       CALL reduce_sum_mpi(sum2,sum3)
316       CALL bcast_mpi(sum3)
317       
318!       WRITE(*,*) "3) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum1
319    ENDIF
320    CALL barrier2_omp()
321
322  END SUBROUTINE  Test_orchidee_para
323 
324END MODULE mod_orchidee_para
Note: See TracBrowser for help on using the repository browser.