source: branches/publications/ORCHIDEE_2.2_r7266/ORCHIDEE/src_parallel/mod_orchidee_para.F90 @ 7541

Last change on this file since 7541 was 7541, checked in by fabienne.maignan, 2 years ago
  1. Zhang publication on coupling factor
File size: 10.4 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)
131
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
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       
147#ifdef CPP_PARA
148    CALL MPI_COMM_SIZE(COMM,mpi_size,ierr)
149    CALL MPI_COMM_RANK(COMM,mpi_rank,ierr)
150#else
151    mpi_rank=0
152    mpi_size=1
153#endif
154   
155    offset=arg_offset 
156    last=.FALSE.
157    IF (mpi_rank==mpi_size .AND. arg_omp_rank==arg_omp_size) last=.TRUE.
158    CALL init_orchidee_omp_data(arg_omp_size,arg_omp_rank,nbp,kindex, offset,last)
159   
160    IF (is_omp_root) THEN
161       arg_nbp_mpi=SUM(nbp_omp_para_nb(:))
162       ALLOCATE(kindex_mpi(arg_nbp_mpi))
163    ENDIF
164
165    CALL barrier2_omp()
166    kindex_mpi(nbp_omp_begin:nbp_omp_end)=kindex(:)+offset
167    CALL barrier2_omp()
168     
169    IF (is_omp_root) THEN     
170       kindex_mpi(:)=kindex_mpi(:)-offset
171       CALL init_orchidee_mpi_data(arg_nbp_mpi,kindex_mpi,offset,COMM)
172       nbp_glo=SUM(nbp_mpi_para(:))
173    ENDIF
174    CALL barrier2_omp()
175
176    nbp_loc=nbp
177
178    ! Define is_root_prc
179    ! Note that this is already done in init_orchidee_para for the offline case but it is done here again for the coupled case.
180    IF (is_mpi_root .AND. is_omp_root) THEN
181       is_root_prc=.TRUE.
182    ELSE
183       is_root_prc=.FALSE.
184    ENDIF
185   
186    CALL Test_orchidee_para
187
188  END SUBROUTINE Init_orchidee_data_para
189   
190  !!  =============================================================================================================================
191  !! SUBROUTINE:  Set_stdout_file
192  !!
193  !>\BRIEF       for each output file will give a unit number for the write function
194  !!
195  !! DESCRIPTION:       for each output file will give a unit number for the write function
196  !!
197  !! \n
198  !_ ==============================================================================================================================
199  SUBROUTINE Set_stdout_file(filename)
200
201    IMPLICIT NONE
202
203    CHARACTER(len=*), INTENT(IN) :: filename
204    CHARACTER(len=255) :: fileout
205    CHARACTER(len=4)  :: num_mpi
206    CHARACTER(len=4)  :: num_omp
207    INTEGER,PARAMETER :: base_numout=100
208    INTEGER           :: ierr
209
210    IF (is_ok_mpi) THEN
211       WRITE(num_mpi,'(I4.4)') mpi_rank
212    ENDIF
213   
214    IF (is_ok_omp) THEN
215       WRITE(num_omp,'(I4.4)') omp_rank
216    ENDIF
217   
218     
219    IF (is_ok_mpi .AND. is_ok_omp) THEN
220       fileout=TRIM(filename)//'_'//num_mpi//'.'//num_omp
221       numout=base_numout+omp_rank
222    ELSE IF (is_ok_mpi .AND. (.NOT. is_ok_omp)) THEN
223       fileout=TRIM(filename)//'_'//num_mpi
224       numout=base_numout
225    ELSE IF ((.NOT. is_ok_mpi) .AND. is_ok_omp) THEN
226       fileout=TRIM(filename)//'_'//num_omp
227       numout=base_numout+omp_rank
228    ELSE
229       fileout=TRIM(filename)
230       numout=base_numout
231    ENDIF
232!!$OMP CRITICAL 
233!    WRITE(*,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
234!!$OMP END CRITICAL
235   
236    OPEN(UNIT=numout,FILE=TRIM(fileout),ACTION='write',STATUS='unknown',FORM='formatted',IOSTAT=ierr) 
237    IF (ierr /= 0) THEN
238#ifdef CPP_PARA
239       CALL MPI_FINALIZE(ierr)
240#endif
241       WRITE(*,*) "In Set_stdout_file : Erreur can't open file ", filename
242       STOP 1
243    ENDIF
244 
245!!$OMP CRITICAL 
246!    WRITE(numout,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
247!!$OMP END CRITICAL
248
249    CALL Init_numout_omp(numout)
250
251  END SUBROUTINE Set_stdout_file
252     
253     
254  !!  =============================================================================================================================
255  !! SUBROUTINE:  Test_orchidee_para
256  !!
257  !>\BRIEF       
258  !!
259  !! DESCRIPTION:       
260  !!
261  !! \n
262  !_ ==============================================================================================================================
263  SUBROUTINE Test_orchidee_para
264
265    IMPLICIT NONE
266
267    INTEGER,PARAMETER :: dimsize=3
268    REAL :: Array(nbp_loc,dimsize)
269    REAL :: Array_glo(nbp_glo,dimsize)
270    REAL :: Array_glo_tmp(nbp_glo,dimsize)
271    REAL :: Array2D_loc(iim_g,jj_nb)
272    REAL :: Array2D_glo(iim_g,jjm_g)
273    REAL :: sum1,sum2,sum3
274   
275    INTEGER :: i,j
276   
277    DO j=1,dimsize
278       DO i=1,nbp_loc
279          Array(i,j)=10*j+omp_rank+i*1000
280       ENDDO
281    ENDDO
282     
283    CALL gather(Array,Array_glo)
284    CALL bcast(Array_glo)
285    CALL scatter(Array_glo,array)
286    CALL gather(array,array_glo_tmp)
287    CALL bcast(array_glo_tmp)   
288!    WRITE(*,*) "1) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",SUM(array_glo-array_glo_tmp)
289
290    sum1=SUM(array)
291    CALL reduce_sum(sum1,sum2)
292    CALL bcast(sum2)
293    sum3=SUM(array_glo)
294!    WRITE(*,*) "2) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum2
295   
296    IF (is_omp_root) THEN
297       DO j=1,jjm_g
298          DO i=1,iim_g
299             Array2D_glo(i,j)=(j-1)*iim_g+i
300          ENDDO
301       ENDDO
302       
303       array2D_loc(:,:)=0
304       CALL scatter2D_mpi(array2D_glo,array2D_loc)
305       array2D_glo(:,:)=0
306       CALL gather2D_mpi(array2D_loc,array2D_glo)
307       CALL bcast_mpi(array2D_glo)
308       sum1=SUM(array2D_glo)
309       sum2=SUM(array2D_loc)
310       CALL reduce_sum_mpi(sum2,sum3)
311       CALL bcast_mpi(sum3)
312       
313!       WRITE(*,*) "3) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum1
314    ENDIF
315    CALL barrier2_omp()
316
317  END SUBROUTINE  Test_orchidee_para
318 
319END MODULE mod_orchidee_para
Note: See TracBrowser for help on using the repository browser.