source: branches/ORCHIDEE_2_2/ORCHIDEE/src_parallel/mod_orchidee_para.F90

Last change on this file 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: 11.5 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$
17!! $Date$
18!! $Revision$
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  USE constantes_var, ONLY : printlev
28  USE ioipsl_para, ONLY : getin_p
29
30CONTAINS
31   
32  !!  =============================================================================================================================
33  !! SUBROUTINE:  Init_orchidee_para
34  !!
35  !>\BRIEF       Initialization of MPI and OpenMP parallelization in offline case
36  !!
37  !! DESCRIPTION: First subroutine for initialization to be called for the initialization of the MPI and OpenMP parallelization
38  !!              in offline mode. This routine will call the successively the initialization for OMP then for MPI.
39  !!              We define in this routine the variable "is_root_prc = is_mpi_root AND is_omp_root".
40  !!
41  !! \n
42  !_ ==============================================================================================================================
43  SUBROUTINE Init_orchidee_para(communicator, usexios)
44    IMPLICIT NONE
45    INTEGER,OPTIONAL,INTENT(in) :: communicator 
46    LOGICAL,OPTIONAL,INTENT(in) :: usexios
47   
48    CALL Init_orchidee_omp
49
50    IF ( PRESENT(communicator) ) THEN
51       IF ( PRESENT(usexios) ) THEN
52          CALL Init_orchidee_mpi(communicator, usexios)
53       ELSE
54          CALL Init_orchidee_mpi(communicator)
55       ENDIF
56    ELSE
57       CALL Init_orchidee_mpi
58    ENDIF
59
60    IF (is_mpi_root .AND. is_omp_root) THEN
61       is_root_prc=.TRUE.
62    ELSE
63       is_root_prc=.FALSE.
64    ENDIF
65  END SUBROUTINE Init_orchidee_para
66   
67 
68  !!  =============================================================================================================================
69  !! SUBROUTINE:  Init_orchidee_data_para_driver
70  !!
71  !>\BRIEF       Initialization of variables related to the local domain decomposition called by the offline driver.
72  !!
73  !! DESCRIPTION: Initialization of variables related to the local domain decomposition.
74  !!              This subroutine is only called in offline mode by the driver.
75  !!
76  !! \n
77  !_ ==============================================================================================================================
78  SUBROUTINE Init_orchidee_data_para_driver(nbp,kindex_glo)
79
80    IMPLICIT NONE
81    INTEGER,INTENT(IN) :: nbp
82    INTEGER,INTENT(IN) :: kindex_glo(nbp)
83     
84    INTEGER :: first_point
85    INTEGER :: last_point
86    INTEGER :: nbp_loc
87    INTEGER :: nbp_loc_para(0:mpi_size-1)
88    INTEGER,ALLOCATABLE :: kindex_loc(:)
89    INTEGER :: offset
90    INTEGER :: i
91   
92     
93    last_point=0
94   
95    CALL read_load_balance(nbp,nbp_loc_para)   
96   
97    DO i=0,mpi_rank
98       nbp_loc=nbp_loc_para(i)
99       First_point=last_point+1
100       Last_point=last_point+nbp_loc
101    ENDDO
102   
103    ALLOCATE(kindex_loc(nbp_loc))
104    DO i=1,nbp_loc
105       kindex_loc(i)=kindex_glo(i+First_Point-1)
106    ENDDO
107   
108    IF (mpi_rank==0) THEN
109       offset=0
110    ELSE
111       offset=kindex_glo(First_point-1)-MOD(kindex_glo(First_point-1),iim_g)
112    ENDIF
113
114    kindex_loc(:)=kindex_loc(:)-offset
115
116    CALL Init_orchidee_data_para(nbp_loc,kindex_loc,offset,omp_size,omp_rank,MPI_COMM_ORCH)
117    CALL ipslnlf(new_number=numout)
118       
119  END SUBROUTINE Init_orchidee_data_para_driver
120   
121 
122  !!  =============================================================================================================================
123  !! SUBROUTINE:  Init_orchidee_data_para
124  !!
125  !>\BRIEF       Initialization of MPI and OpenMP parallelization.
126  !!
127  !! DESCRIPTION: Initialization of MPI and OpenMP parallelization.
128  !!              This subroutine is called from both the offline driver and from the initialization routine for the coupled mode.
129  !!              This routine will call the successively the initialization for omp and then for mpi.
130  !!              We define in this routine the variable "is_root_prc = is_mpi_root AND is_omp_root".
131  !!
132  !! \n
133  !_ ==============================================================================================================================
134  SUBROUTINE Init_orchidee_data_para(nbp,kindex,arg_offset,arg_omp_size,arg_omp_rank,COMM)
135
136    IMPLICIT NONE
137    INTEGER,INTENT(IN)     :: nbp
138    INTEGER,INTENT(IN)     :: kindex(nbp)
139    INTEGER,INTENT(IN)     :: arg_offset
140    INTEGER,INTENT(IN)     :: arg_omp_size
141    INTEGER,INTENT(IN)     :: arg_omp_rank
142    INTEGER,INTENT(IN)     :: COMM
143   
144    INTEGER,SAVE              :: arg_nbp_mpi
145    INTEGER,ALLOCATABLE,SAVE  :: kindex_mpi(:)
146    LOGICAL                   :: last
147    INTEGER                   :: mpi_size
148    INTEGER                   :: mpi_rank
149    INTEGER                   :: ierr
150       
151#ifdef CPP_PARA
152    CALL MPI_COMM_SIZE(COMM,mpi_size,ierr)
153    CALL MPI_COMM_RANK(COMM,mpi_rank,ierr)
154#else
155    mpi_rank=0
156    mpi_size=1
157#endif
158   
159    offset=arg_offset 
160    last=.FALSE.
161    IF (mpi_rank==mpi_size .AND. arg_omp_rank==arg_omp_size) last=.TRUE.
162    CALL init_orchidee_omp_data(arg_omp_size,arg_omp_rank,nbp,kindex, offset,last)
163   
164    IF (is_omp_root) THEN
165       arg_nbp_mpi=SUM(nbp_omp_para_nb(:))
166       ALLOCATE(kindex_mpi(arg_nbp_mpi))
167    ENDIF
168
169    CALL barrier2_omp()
170    kindex_mpi(nbp_omp_begin:nbp_omp_end)=kindex(:)+offset
171    CALL barrier2_omp()
172     
173    IF (is_omp_root) THEN     
174       kindex_mpi(:)=kindex_mpi(:)-offset
175       CALL init_orchidee_mpi_data(arg_nbp_mpi,kindex_mpi,offset,COMM)
176       nbp_glo=SUM(nbp_mpi_para(:))
177    ENDIF
178    CALL barrier2_omp()
179
180    nbp_loc=nbp
181
182    ! Define is_root_prc
183    ! Note that this is already done in init_orchidee_para for the offline case but it is done here again for the coupled case.
184    IF (is_mpi_root .AND. is_omp_root) THEN
185       is_root_prc=.TRUE.
186    ELSE
187       is_root_prc=.FALSE.
188    ENDIF
189   
190    CALL Test_orchidee_para
191
192  END SUBROUTINE Init_orchidee_data_para
193   
194  !!  =============================================================================================================================
195  !! SUBROUTINE:  Set_stdout_file
196  !!
197  !>\BRIEF       for each output file will give a unit number for the write function
198  !!
199  !! DESCRIPTION:       for each output file will give a unit number for the write function
200  !!
201  !! \n
202  !_ ==============================================================================================================================
203  SUBROUTINE Set_stdout_file(filename)
204
205    IMPLICIT NONE
206
207    CHARACTER(len=*), INTENT(IN) :: filename
208    CHARACTER(len=255) :: fileout
209    CHARACTER(len=4)  :: num_mpi
210    CHARACTER(len=4)  :: num_omp
211    INTEGER,PARAMETER :: base_numout=100
212    INTEGER           :: ierr
213
214    !Config Key   = PRINTLEV
215    !Config Desc  = Print level for text output
216    !Config If    =
217    !Config Help  = Possible values are:
218    !Config         0    Nearly no output
219    !Config         1    Minimum writing for long simulations, only master MPI
220    !                    and master thread creates an output file. The other
221    !                    processors writes to standard output and their level is changed to 0 
222    !Config         2    More basic information for long simulations,
223    !                    all processors opens an own output text file
224    !Config         3    First debug level,
225    !Config         4    Higher debug level
226    !Config Def   = 2
227    !Config Units = [0, 1, 2, 3, 4]
228    CALL getin_p('PRINTLEV',printlev)
229
230    IF (printlev .EQ. 1) THEN
231       IF (is_mpi_root.AND.is_omp_root) THEN
232          ! Keep output level 1 only for the master processor
233          printlev=1
234       ELSE
235          ! Change output level for all other processors
236          printlev=0
237       END IF
238    END IF
239
240
241    IF (is_ok_mpi) THEN
242       WRITE(num_mpi,'(I4.4)') mpi_rank
243    ENDIF
244   
245    IF (is_ok_omp) THEN
246       WRITE(num_omp,'(I4.4)') omp_rank
247    ENDIF
248   
249     
250    IF (is_ok_mpi .AND. is_ok_omp) THEN
251       fileout=TRIM(filename)//'_'//num_mpi//'.'//num_omp
252       numout=base_numout+omp_rank
253    ELSE IF (is_ok_mpi .AND. (.NOT. is_ok_omp)) THEN
254       fileout=TRIM(filename)//'_'//num_mpi
255       numout=base_numout
256    ELSE IF ((.NOT. is_ok_mpi) .AND. is_ok_omp) THEN
257       fileout=TRIM(filename)//'_'//num_omp
258       numout=base_numout+omp_rank
259    ELSE
260       fileout=TRIM(filename)
261       numout=base_numout
262    ENDIF
263   
264    IF (printlev .GE. 1) THEN
265       ! Open text output out_orchidee_xxxx file
266       OPEN(UNIT=numout,FILE=TRIM(fileout),ACTION='write',STATUS='unknown',FORM='formatted',IOSTAT=ierr) 
267
268       IF (ierr /= 0) THEN
269#ifdef CPP_PARA
270          CALL MPI_FINALIZE(ierr)
271#endif
272          WRITE(*,*) "In Set_stdout_file : Erreur can't open file ", filename
273          STOP 1
274       ENDIF
275    ELSE
276       ! If printlev=0, do not open a file, sent write statements to standard output
277       numout=6
278    END IF
279 
280    CALL Init_numout_omp(numout)
281
282    IF (printlev>=1) WRITE(numout,*) 'ORCHIDEE start'
283  END SUBROUTINE Set_stdout_file
284     
285     
286  !!  =============================================================================================================================
287  !! SUBROUTINE:  Test_orchidee_para
288  !!
289  !>\BRIEF       
290  !!
291  !! DESCRIPTION:       
292  !!
293  !! \n
294  !_ ==============================================================================================================================
295  SUBROUTINE Test_orchidee_para
296
297    IMPLICIT NONE
298
299    INTEGER,PARAMETER :: dimsize=3
300    REAL :: Array(nbp_loc,dimsize)
301    REAL :: Array_glo(nbp_glo,dimsize)
302    REAL :: Array_glo_tmp(nbp_glo,dimsize)
303    REAL :: Array2D_loc(iim_g,jj_nb)
304    REAL :: Array2D_glo(iim_g,jjm_g)
305    REAL :: sum1,sum2,sum3
306   
307    INTEGER :: i,j
308   
309    DO j=1,dimsize
310       DO i=1,nbp_loc
311          Array(i,j)=10*j+omp_rank+i*1000
312       ENDDO
313    ENDDO
314     
315    CALL gather(Array,Array_glo)
316    CALL bcast(Array_glo)
317    CALL scatter(Array_glo,array)
318    CALL gather(array,array_glo_tmp)
319    CALL bcast(array_glo_tmp)   
320!    WRITE(*,*) "1) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",SUM(array_glo-array_glo_tmp)
321
322    sum1=SUM(array)
323    CALL reduce_sum(sum1,sum2)
324    CALL bcast(sum2)
325    sum3=SUM(array_glo)
326!    WRITE(*,*) "2) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum2
327   
328    IF (is_omp_root) THEN
329       DO j=1,jjm_g
330          DO i=1,iim_g
331             Array2D_glo(i,j)=(j-1)*iim_g+i
332          ENDDO
333       ENDDO
334       
335       array2D_loc(:,:)=0
336       CALL scatter2D_mpi(array2D_glo,array2D_loc)
337       array2D_glo(:,:)=0
338       CALL gather2D_mpi(array2D_loc,array2D_glo)
339       CALL bcast_mpi(array2D_glo)
340       sum1=SUM(array2D_glo)
341       sum2=SUM(array2D_loc)
342       CALL reduce_sum_mpi(sum2,sum3)
343       CALL bcast_mpi(sum3)
344       
345!       WRITE(*,*) "3) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum1
346    ENDIF
347    CALL barrier2_omp()
348
349  END SUBROUTINE  Test_orchidee_para
350 
351END MODULE mod_orchidee_para
Note: See TracBrowser for help on using the repository browser.