source: CONFIG/UNIFORM/v7/ICOLMDZORINCA_v7.2/SOURCES/REDHAT8/ORCHIDEE/mod_orchidee_para.F90 @ 6481

Last change on this file since 6481 was 6481, checked in by acosce, 13 months ago

Update configuration to compile and run on redhat8

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
246numout=6
247   
248 
249!!$OMP CRITICAL 
250!    WRITE(numout,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
251!!$OMP END CRITICAL
252
253    CALL Init_numout_omp(numout)
254
255  END SUBROUTINE Set_stdout_file
256     
257     
258  !!  =============================================================================================================================
259  !! SUBROUTINE:  Test_orchidee_para
260  !!
261  !>\BRIEF       
262  !!
263  !! DESCRIPTION:       
264  !!
265  !! \n
266  !_ ==============================================================================================================================
267  SUBROUTINE Test_orchidee_para
268
269    IMPLICIT NONE
270
271    INTEGER,PARAMETER :: dimsize=3
272    REAL :: Array(nbp_loc,dimsize)
273    REAL :: Array_glo(nbp_glo,dimsize)
274    REAL :: Array_glo_tmp(nbp_glo,dimsize)
275    REAL :: Array2D_loc(iim_g,jj_nb)
276    REAL :: Array2D_glo(iim_g,jjm_g)
277    REAL :: sum1,sum2,sum3
278   
279    INTEGER :: i,j
280   
281    DO j=1,dimsize
282       DO i=1,nbp_loc
283          Array(i,j)=10*j+omp_rank+i*1000
284       ENDDO
285    ENDDO
286     
287    CALL gather(Array,Array_glo)
288    CALL bcast(Array_glo)
289    CALL scatter(Array_glo,array)
290    CALL gather(array,array_glo_tmp)
291    CALL bcast(array_glo_tmp)   
292!    WRITE(*,*) "1) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",SUM(array_glo-array_glo_tmp)
293
294    sum1=SUM(array)
295    CALL reduce_sum(sum1,sum2)
296    CALL bcast(sum2)
297    sum3=SUM(array_glo)
298!    WRITE(*,*) "2) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum2
299   
300    IF (is_omp_root) THEN
301       DO j=1,jjm_g
302          DO i=1,iim_g
303             Array2D_glo(i,j)=(j-1)*iim_g+i
304          ENDDO
305       ENDDO
306       
307       array2D_loc(:,:)=0
308       CALL scatter2D_mpi(array2D_glo,array2D_loc)
309       array2D_glo(:,:)=0
310       CALL gather2D_mpi(array2D_loc,array2D_glo)
311       CALL bcast_mpi(array2D_glo)
312       sum1=SUM(array2D_glo)
313       sum2=SUM(array2D_loc)
314       CALL reduce_sum_mpi(sum2,sum3)
315       CALL bcast_mpi(sum3)
316       
317!       WRITE(*,*) "3) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum1
318    ENDIF
319    CALL barrier2_omp()
320
321  END SUBROUTINE  Test_orchidee_para
322 
323END MODULE mod_orchidee_para
Note: See TracBrowser for help on using the repository browser.