source: tags/ORCHIDEE_2_0/ORCHIDEE/src_parallel/mod_orchidee_para.F90

Last change on this file was 8038, checked in by josefine.ghattas, 13 months ago

Added option PRINTSTANDOUT which sends all write statement to the standard output instead of opening a text file out_orchidee per running core. This option should be used if problem with too many output files. This is also done on the trunk [7969].
  • Property svn:keywords set to Date Revision HeadURL
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$
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   
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   
143    offset=arg_offset 
144    CALL init_orchidee_omp_data(arg_omp_size,arg_omp_rank,nbp,offset)
145   
146    IF (is_omp_root) THEN
147       arg_nbp_mpi=SUM(nbp_omp_para_nb(:))
148       ALLOCATE(kindex_mpi(arg_nbp_mpi))
149    ENDIF
150
151    CALL barrier2_omp()
152    kindex_mpi(nbp_omp_begin:nbp_omp_end)=kindex(:)+offset
153    CALL barrier2_omp()
154     
155    IF (is_omp_root) THEN     
156       kindex_mpi(:)=kindex_mpi(:)-offset
157       CALL init_orchidee_mpi_data(arg_nbp_mpi,kindex_mpi,offset,COMM)
158       nbp_glo=SUM(nbp_mpi_para(:))
159    ENDIF
160    CALL barrier2_omp()
161
162    nbp_loc=nbp
163
164    ! Define is_root_prc
165    ! Note that this is already done in init_orchidee_para for the offline case but it is done here again for the coupled case.
166    IF (is_mpi_root .AND. is_omp_root) THEN
167       is_root_prc=.TRUE.
168    ELSE
169       is_root_prc=.FALSE.
170    ENDIF
171   
172    CALL Test_orchidee_para
173
174  END SUBROUTINE Init_orchidee_data_para
175   
176  !!  =============================================================================================================================
177  !! SUBROUTINE:  Set_stdout_file
178  !!
179  !>\BRIEF       for each output file will give a unit number for the write function
180  !!
181  !! DESCRIPTION:       for each output file will give a unit number for the write function
182  !!
183  !! \n
184  !_ ==============================================================================================================================
185  SUBROUTINE Set_stdout_file(filename)
186
187    IMPLICIT NONE
188
189    CHARACTER(len=*), INTENT(IN) :: filename
190    CHARACTER(len=255) :: fileout
191    CHARACTER(len=4)  :: num_mpi
192    CHARACTER(len=4)  :: num_omp
193    INTEGER,PARAMETER :: base_numout=100
194    INTEGER           :: ierr
195    LOGICAL           :: printstandout 
196
197
198    !Config Key   = PRINTSTANDOUT
199    !Config Desc  = Print to standard output
200    !Config If    =
201    !Config Help  = Write to standard output instead of opening a text output file out_orchidee
202    !Config Def   = FALSE
203    !Config Units = [FLAG]
204    printstandout=.FALSE.
205    CALL getin_p('PRINTSTANDOUT',printstandout)
206
207
208    IF (is_ok_mpi) THEN
209       WRITE(num_mpi,'(I4.4)') mpi_rank
210    ENDIF
211   
212    IF (is_ok_omp) THEN
213       WRITE(num_omp,'(I4.4)') omp_rank
214    ENDIF
215   
216     
217    IF (is_ok_mpi .AND. is_ok_omp) THEN
218       fileout=TRIM(filename)//'_'//num_mpi//'.'//num_omp
219       numout=base_numout+omp_rank
220    ELSE IF (is_ok_mpi .AND. (.NOT. is_ok_omp)) THEN
221       fileout=TRIM(filename)//'_'//num_mpi
222       numout=base_numout
223    ELSE IF ((.NOT. is_ok_mpi) .AND. is_ok_omp) THEN
224       fileout=TRIM(filename)//'_'//num_omp
225       numout=base_numout+omp_rank
226    ELSE
227       fileout=TRIM(filename)
228       numout=base_numout
229    ENDIF
230!!$OMP CRITICAL 
231!    WRITE(*,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
232!!$OMP END CRITICAL
233
234
235    IF (printstandout) THEN 
236       ! Don't open text output file. All write(numout,*) are sent to the standard output.
237       numout=6 
238    ELSE 
239       ! Open text output file. All write(numout,*) are sent to this file.
240       OPEN(UNIT=numout,FILE=TRIM(fileout),ACTION='write',STATUS='unknown',FORM='formatted',IOSTAT=ierr) 
241       IF (ierr /= 0) THEN
242#ifdef CPP_PARA
243          CALL MPI_FINALIZE(ierr)
244#endif
245          WRITE(*,*) "In Set_stdout_file : Erreur can't open file ", filename
246          STOP 1
247       END IF
248    END IF
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.