source: branches/publications/ORCHIDEE_2.2_r7266/ORCHIDEE/src_parallel/mod_orchidee_omp_data.F90 @ 7541

Last change on this file since 7541 was 7541, checked in by fabienne.maignan, 2 years ago
  1. Zhang publication on coupling factor
File size: 11.3 KB
Line 
1! ===============================================================================================================================
2! MODULE       : mod_orchidee_omp_data
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        Contains initialization and allocation of variables and functions related to OpenMP parallelization.
10!!
11!! \n DESCRIPTION : Contains subroutines for initialization and allocation of variables and functions related to
12!!                  OpenMP parallelization.
13!!
14!! RECENT CHANGE(S): None
15!!
16!! REFERENCES(S)    : None
17!!
18!! SVN              :
19!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE_2_2/ORCHIDEE/src_parallel/mod_orchidee_omp_data.F90 $
20!! $Date: 2018-08-02 09:06:40 +0200 (Thu, 02 Aug 2018) $
21!! $Revision: 5364 $
22!! \n
23!_ ================================================================================================================================
24MODULE mod_orchidee_omp_data
25
26!-
27  USE defprec
28  USE ioipsl
29  USE mod_orchidee_para_var
30
31  IMPLICIT NONE
32
33CONTAINS
34
35
36
37!!  =============================================================================================================================
38!! SUBROUTINE:    barrier2_omp
39!!
40!>\BRIEF        this routine call two omp barrier to prevent a specific bug when orchidee is coupled to lmdz
41!!
42!! DESCRIPTION:   this routine call two omp barrier to prevent a specific bug when orchidee is coupled to lmdz
43!!
44!!               
45!! \n
46!_ ==============================================================================================================================
47    SUBROUTINE barrier2_omp()
48
49    IMPLICIT NONE
50
51!$OMP BARRIER
52!$OMP BARRIER
53
54  END SUBROUTINE barrier2_omp
55
56
57
58 
59!!  =============================================================================================================================
60!! SUBROUTINE:   Init_orchidee_omp
61!!
62!>\BRIEF        define the variables is_ok_omp, is_omp_root, omp_size and omp_rank  in the offline case
63!!
64!! DESCRIPTION:   define the variables is_ok_omp, is_omp_root, omp_size and omp_rank  in the offline case
65!!
66!!               
67!! \n
68!_ ==============================================================================================================================
69  SUBROUTINE Init_orchidee_omp
70  IMPLICIT NONE
71 
72#ifdef CPP_OMP
73    IF (is_omp_root) THEN
74        is_ok_omp=.TRUE.
75    ENDIF
76#else   
77    is_ok_omp=.FALSE.
78#endif
79
80
81    IF (is_ok_omp) THEN
82      STOP 'Open MP is not yet implemented for driver'
83    ELSE
84      omp_size=1
85      omp_rank=0
86      is_omp_root=.TRUE.
87    ENDIF
88
89  END SUBROUTINE Init_orchidee_omp
90
91
92!!  =============================================================================================================================
93!! SUBROUTINE:  Init_numout_omp 
94!!
95!>\BRIEF  Define a number for the output file specific to the omp thread.         
96!!
97!! DESCRIPTION:    Define a number for the output file specific to the omp thread.       
98!!
99!!               
100!! \n
101!_ ==============================================================================================================================
102  SUBROUTINE Init_numout_omp(numout)
103    INTEGER, INTENT(in) :: numout
104    numout_omp=numout
105  END SUBROUTINE Init_numout_omp
106
107
108!!  =============================================================================================================================
109!! SUBROUTINE:  Init_orchidee_omp_data 
110!!
111!>\BRIEF          Omp parallelisation in the coupled case.
112!!
113!! DESCRIPTION:    Omp parallelisation in the coupled case. In this routine we will define all omp variables
114!!                 is_omp_root, omp_size, omp_rank, nbp_omp_para_nb, nbp_omp_para_begin, nbp_omp_para_end
115!!                 nbp_omp_begin, nbp_omp_end, nbp_omp
116!!
117!!               
118!! \n
119!_ ==============================================================================================================================
120  SUBROUTINE Init_orchidee_omp_data(arg_omp_size,arg_omp_rank,arg_nbp_omp,kindex, arg_offset_omp,last)
121    IMPLICIT NONE
122    INTEGER, INTENT(IN) :: arg_omp_size
123    INTEGER, INTENT(IN) :: arg_omp_rank
124    INTEGER, INTENT(IN) :: arg_nbp_omp
125    INTEGER, INTENT(IN) :: kindex(arg_nbp_omp)
126    INTEGER, INTENT(IN) :: arg_offset_omp
127    LOGICAL, INTENT(IN) :: last
128   
129    INTEGER    :: i
130   
131   
132    IF (arg_omp_rank==0) THEN
133      is_omp_root=.TRUE.
134    ELSE
135      is_omp_root=.FALSE.
136    ENDIF
137   
138#ifdef CPP_OMP
139    IF (is_omp_root) THEN
140        is_ok_omp=.TRUE.
141    ENDIF
142#else   
143    is_ok_omp=.FALSE.
144#endif
145
146    IF (is_omp_root) omp_size=arg_omp_size
147
148    CALL barrier2_omp()
149
150     omp_rank=arg_omp_rank
151   
152    IF (is_omp_root) THEN
153      ALLOCATE(nbp_omp_para_nb(0:omp_size-1))
154      ALLOCATE(nbp_omp_para_begin(0:omp_size-1))
155      ALLOCATE(nbp_omp_para_end(0:omp_size-1))
156      ALLOCATE(ij_omp_para_nb(0:omp_size-1))
157      ALLOCATE(ij_omp_para_begin(0:omp_size-1))
158      ALLOCATE(ij_omp_para_end(0:omp_size-1))
159    ENDIF
160   
161    CALL barrier2_omp()
162    offset_omp=arg_offset_omp         
163
164    nbp_omp_para_nb(omp_rank)=arg_nbp_omp
165    ij_omp_para_begin(omp_rank)=offset_omp+1
166    IF (last) THEN
167      ij_omp_para_end(omp_rank)=iim_g*jjm_g
168    ELSE
169      ij_omp_para_end(omp_rank)=kindex(arg_nbp_omp)+offset_omp
170    ENDIF
171    ij_omp_para_nb(omp_rank)=ij_omp_para_end(omp_rank)-ij_omp_para_begin(omp_rank)+1
172    CALL barrier2_omp()
173   
174    IF (is_omp_root) THEN
175
176      nbp_omp_para_begin(0)=1
177      nbp_omp_para_end(0)=nbp_omp_para_nb(0)
178
179      DO i=1,omp_size-1
180        nbp_omp_para_begin(i)=nbp_omp_para_end(i-1)+1
181        nbp_omp_para_end(i)=nbp_omp_para_begin(i)+nbp_omp_para_nb(i)-1
182      ENDDO
183       ij_omp_para_begin(:) = ij_omp_para_begin(:)-offset_omp
184       ij_omp_para_end(:) = ij_omp_para_end(:)-offset_omp
185    ENDIF
186
187    CALL barrier2_omp()
188     
189    nbp_omp=nbp_omp_para_nb(omp_rank)
190    nbp_omp_begin=nbp_omp_para_begin(omp_rank)
191    nbp_omp_end=nbp_omp_para_end(omp_rank)
192
193    ij_omp_nb=ij_omp_para_nb(omp_rank)
194    ij_omp_begin=ij_omp_para_begin(omp_rank)
195    ij_omp_end=ij_omp_para_end(omp_rank)
196   
197    offset_omp=arg_offset_omp         
198    CALL Print_omp_data
199   
200    CALL Init_synchro_omp()
201   
202  END SUBROUTINE Init_orchidee_omp_data
203
204!!  =============================================================================================================================
205!! SUBROUTINE:    print_omp_data
206!!
207!>\BRIEF         print specific omp parallelisation variables
208!!
209!! DESCRIPTION:          print specific omp parallelisation variables
210!!
211!!               
212!! \n
213!_ ==============================================================================================================================
214  SUBROUTINE print_omp_data
215  IMPLICIT NONE
216
217!$OMP CRITICAL 
218  PRINT *,'--------> ORCHIDEE TASK ',omp_rank
219  PRINT *,'omp_size =',omp_size
220  PRINT *,'omp_rank =',omp_rank
221  PRINT *,'is_omp_root =',is_omp_root
222  PRINT *,'offset_omp',offset_omp
223  PRINT *,'nbp_omp_para_nb =',nbp_omp_para_nb
224  PRINT *,'nbp_omp_para_begin =',nbp_omp_para_begin
225  PRINT *,'nbp_omp_para_end =',nbp_omp_para_end   
226  PRINT *,'nbp_omp =',nbp_omp
227  PRINT *,'nbp_omp_begin =',nbp_omp_begin
228  PRINT *,'nbp_omp_end =',nbp_omp_end   
229!$OMP END CRITICAL
230
231  END SUBROUTINE print_omp_data
232
233!!  =============================================================================================================================
234!! SUBROUTINE:  Init_synchro_omp 
235!!
236!>\BRIEF    initialization of  some variables use for the synchronisation of omp threads
237!!
238!! DESCRIPTION:   initialization of  some variables use for the synchronisation of omp threads
239!!
240!!               
241!! \n
242!_ ==============================================================================================================================
243  SUBROUTINE Init_synchro_omp
244  IMPLICIT NONE
245   
246    IF (is_omp_root) THEN
247      ALLOCATE(proc_synchro_omp(0:omp_size-1))
248      proc_synchro_omp(:)=.FALSE.
249
250      IF ( check_all_transfert ) THEN
251         ALLOCATE(omp_function(0:omp_size-1))
252         omp_function(:)=-1
253      ENDIF
254    ENDIF
255    CALL barrier2_omp()
256
257  END SUBROUTINE Init_Synchro_omp
258 
259!!  =============================================================================================================================
260!! SUBROUTINE:   Synchro_omp
261!!
262!>\BRIEF            routine to make synchronisation of omp threads after a call to a omp routine         
263!!
264!! DESCRIPTION:   routine to make synchronisation of omp threads after a call to a omp routine
265!!                add a control to check the time waited for the synchronisation.
266!!               
267!! \n
268!_ ==============================================================================================================================
269  SUBROUTINE Synchro_omp
270    IMPLICIT NONE
271
272#ifdef CPP_PARA
273    INCLUDE 'mpif.h'
274#endif
275    INTEGER iter
276    LOGICAL, PARAMETER :: check=.TRUE.
277    INTEGER, PARAMETER :: iter_max=1
278    INTEGER, PARAMETER :: print_iter=1
279    INTEGER            :: ierr
280
281    proc_synchro_omp(omp_rank)=.TRUE.
282    CALL barrier2_omp()
283
284    iter=0
285    DO WHILE (.NOT. ALL(proc_synchro_omp))
286       iter=iter+1
287       IF ( mod(iter,print_iter) == 0 ) THEN
288          IF (numout_omp > 0) THEN
289             WRITE(numout_omp,*) "ORCHIDEE SYNCHRO OMP : iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
290          ELSE
291             WRITE(*,*) "ORCHIDEE SYNCHRO OMP : iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
292          ENDIF
293       ENDIF
294       IF (check) THEN
295          IF (iter > iter_max) THEN
296             IF (numout_omp > 0) THEN
297                WRITE(numout_omp,*) "TOO MUCH WAIT in Synchro_Omp !! iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
298                WRITE(numout_omp,*) "We stop here"
299                WRITE(numout_omp,*) "omp_function : ",omp_function(:)
300             ELSE
301                WRITE(*,*) "TOO MUCH WAIT in Synchro_Omp !! iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
302                WRITE(*,*) "We stop here"
303                WRITE(*,*) "omp_function : ",omp_function(:)
304             ENDIF
305#ifdef CPP_PARA
306             CALL MPI_ABORT(MPI_COMM_WORLD, 1, ierr)
307#endif     
308             STOP 'Fatal error from ORCHIDEE : Synchro_Omp failed'
309          ENDIF
310       ENDIF
311    CALL barrier2_omp()
312    ENDDO
313    CALL barrier2_omp()
314    proc_synchro_omp(omp_rank)=.FALSE.
315    CALL barrier2_omp()
316
317   END SUBROUTINE Synchro_omp
318
319!!  =============================================================================================================================
320!! SUBROUTINE:    print_omp_function
321!!
322!>\BRIEF         
323!!
324!! DESCRIPTION:   
325!!
326!!               
327!! \n
328!_ ==============================================================================================================================
329   SUBROUTINE print_omp_function ()
330
331     IF ( check_all_transfert ) THEN
332        CALL barrier2_omp()
333        IF (numout_omp > 0) THEN
334           WRITE(numout_omp,*) omp_rank,&
335                " : ",omp_fct_name(omp_previous),'->',omp_fct_name(omp_function(omp_rank))
336           IF (MINVAL(omp_function(:)).LT.MAXVAL(omp_function(:))) &
337                WRITE(numout_omp,*) "!!! OMP ERROR : NO MORE SYNCHRO  !!!  ",omp_function(:)
338        ELSE
339           WRITE(*,*) omp_rank,&
340                " : ",omp_fct_name(omp_previous),'->',omp_fct_name(omp_function(omp_rank))
341           IF (MINVAL(omp_function(:)).LT.MAXVAL(omp_function(:))) &
342                WRITE(*,*) "!!! OMP ERROR : NO MORE SYNCHRO  !!!  ",omp_function(:)
343        ENDIF
344        CALL barrier2_omp()
345     ENDIF
346
347  END SUBROUTINE print_omp_function
348
349
350END MODULE mod_orchidee_omp_data
Note: See TracBrowser for help on using the repository browser.