source: branches/publications/ORCHIDEE_gmd_2018_MICT-LEAK/src_parallel/mod_orchidee_para.F90 @ 7346

Last change on this file since 7346 was 4977, checked in by simon.bowring, 6 years ago

Currently running (13/02/2018) version includes all necessarily changes to include DOC in MICT code... further parametrisation necessary to equate soil pools with those of normal forcesoil restarts
File size: 10.0 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/perso/albert.jornet/MICT_LEAK/src_parallel/mod_orchidee_para.F90 $
17!! $Date: 2017-07-27 14:10:15 +0200 (jeu. 27 juil. 2017) $
18!! $Revision: 4537 $
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
196    IF (is_ok_mpi) THEN
197       WRITE(num_mpi,'(I4.4)') mpi_rank
198    ENDIF
199   
200    IF (is_ok_omp) THEN
201       WRITE(num_omp,'(I4.4)') omp_rank
202    ENDIF
203   
204     
205    IF (is_ok_mpi .AND. is_ok_omp) THEN
206       fileout=TRIM(filename)//'_'//num_mpi//'.'//num_omp
207       numout=base_numout+omp_rank
208    ELSE IF (is_ok_mpi .AND. (.NOT. is_ok_omp)) THEN
209       fileout=TRIM(filename)//'_'//num_mpi
210       numout=base_numout
211    ELSE IF ((.NOT. is_ok_mpi) .AND. is_ok_omp) THEN
212       fileout=TRIM(filename)//'_'//num_omp
213       numout=base_numout+omp_rank
214    ELSE
215       fileout=TRIM(filename)
216       numout=base_numout
217    ENDIF
218!$OMP CRITICAL 
219    WRITE(*,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
220!$OMP END CRITICAL
221   
222    OPEN(UNIT=numout,FILE=TRIM(fileout),ACTION='write',STATUS='unknown',FORM='formatted',IOSTAT=ierr) 
223    IF (ierr /= 0) THEN
224#ifdef CPP_PARA
225       CALL MPI_FINALIZE(ierr)
226#endif
227       WRITE(*,*) "In Set_stdout_file : Erreur can't open file ", filename
228       STOP 1
229    ENDIF
230 
231!$OMP CRITICAL 
232    WRITE(numout,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
233!$OMP END CRITICAL
234
235    CALL Init_numout_omp(numout)
236
237  END SUBROUTINE Set_stdout_file
238     
239     
240  !!  =============================================================================================================================
241  !! SUBROUTINE:  Test_orchidee_para
242  !!
243  !>\BRIEF       
244  !!
245  !! DESCRIPTION:       
246  !!
247  !! \n
248  !_ ==============================================================================================================================
249  SUBROUTINE Test_orchidee_para
250
251    IMPLICIT NONE
252
253    INTEGER,PARAMETER :: dimsize=3
254    REAL :: Array(nbp_loc,dimsize)
255    REAL :: Array_glo(nbp_glo,dimsize)
256    REAL :: Array_glo_tmp(nbp_glo,dimsize)
257    REAL :: Array2D_loc(iim_g,jj_nb)
258    REAL :: Array2D_glo(iim_g,jjm_g)
259    REAL :: sum1,sum2,sum3
260   
261    INTEGER :: i,j
262   
263    DO j=1,dimsize
264       DO i=1,nbp_loc
265          Array(i,j)=10*j+omp_rank+i*1000
266       ENDDO
267    ENDDO
268     
269    CALL gather(Array,Array_glo)
270    CALL bcast(Array_glo)
271    CALL scatter(Array_glo,array)
272    CALL gather(array,array_glo_tmp)
273    CALL bcast(array_glo_tmp)   
274    WRITE(*,*) "1) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",SUM(array_glo-array_glo_tmp)
275
276    sum1=SUM(array)
277    CALL reduce_sum(sum1,sum2)
278    CALL bcast(sum2)
279    sum3=SUM(array_glo)
280    WRITE(*,*) "2) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum2
281   
282    IF (is_omp_root) THEN
283       DO j=1,jjm_g
284          DO i=1,iim_g
285             Array2D_glo(i,j)=(j-1)*iim_g+i
286          ENDDO
287       ENDDO
288       
289       array2D_loc(:,:)=0
290       CALL scatter2D_mpi(array2D_glo,array2D_loc)
291       array2D_glo(:,:)=0
292       CALL gather2D_mpi(array2D_loc,array2D_glo)
293       CALL bcast_mpi(array2D_glo)
294       sum1=SUM(array2D_glo)
295       sum2=SUM(array2D_loc)
296       CALL reduce_sum_mpi(sum2,sum3)
297       CALL bcast_mpi(sum3)
298       
299       WRITE(*,*) "3) Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum1
300    ENDIF
301    CALL barrier2_omp()
302
303  END SUBROUTINE  Test_orchidee_para
304 
305END MODULE mod_orchidee_para
Note: See TracBrowser for help on using the repository browser.