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

Last change on this file since 8011 was 7792, checked in by josefine.ghattas, 20 months ago

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