source: branches/publications/ORCHIDEE-ICE_SurfaceMassBalance/src_parallel/mod_orchidee_omp_data.F90 @ 8398

Last change on this file since 8398 was 4264, checked in by josefine.ghattas, 7 years ago

Removed Author from svn information from module headings, according to coding guide lines.

  • Property svn:keywords set to Date Revision HeadURL
File size: 10.3 KB
Line 
1! ===============================================================================================================================
2! MODULE       : mod_orchidee_omp_data
3!
4! CONTACT      : orchidee-help _at_ ipsl.jussieu.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$
20!! $Date$
21!! $Revision$
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,arg_offset_omp)
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) :: arg_offset_omp
126   
127    INTEGER    :: i
128   
129   
130    IF (arg_omp_rank==0) THEN
131      is_omp_root=.TRUE.
132    ELSE
133      is_omp_root=.FALSE.
134    ENDIF
135   
136#ifdef CPP_OMP
137    IF (is_omp_root) THEN
138        is_ok_omp=.TRUE.
139    ENDIF
140#else   
141    is_ok_omp=.FALSE.
142#endif
143
144    IF (is_omp_root) omp_size=arg_omp_size
145
146    CALL barrier2_omp()
147
148     omp_rank=arg_omp_rank
149   
150    IF (is_omp_root) THEN
151      ALLOCATE(nbp_omp_para_nb(0:omp_size-1))
152      ALLOCATE(nbp_omp_para_begin(0:omp_size-1))
153      ALLOCATE(nbp_omp_para_end(0:omp_size-1))
154    ENDIF
155   
156    CALL barrier2_omp()
157    nbp_omp_para_nb(omp_rank)=arg_nbp_omp
158    CALL barrier2_omp()
159   
160    IF (is_omp_root) THEN
161
162      nbp_omp_para_begin(0)=1
163      nbp_omp_para_end(0)=nbp_omp_para_nb(0)
164
165      DO i=1,omp_size-1
166        nbp_omp_para_begin(i)=nbp_omp_para_end(i-1)+1
167        nbp_omp_para_end(i)=nbp_omp_para_begin(i)+nbp_omp_para_nb(i)-1
168      ENDDO
169
170    ENDIF
171
172    CALL barrier2_omp()
173     
174    nbp_omp=nbp_omp_para_nb(omp_rank)
175    nbp_omp_begin=nbp_omp_para_begin(omp_rank)
176    nbp_omp_end=nbp_omp_para_end(omp_rank)
177   
178    offset_omp=arg_offset_omp         
179    CALL Print_omp_data
180   
181    CALL Init_synchro_omp()
182   
183  END SUBROUTINE Init_orchidee_omp_data
184
185!!  =============================================================================================================================
186!! SUBROUTINE:    print_omp_data
187!!
188!>\BRIEF         print specific omp parallelisation variables
189!!
190!! DESCRIPTION:          print specific omp parallelisation variables
191!!
192!!               
193!! \n
194!_ ==============================================================================================================================
195  SUBROUTINE print_omp_data
196  IMPLICIT NONE
197
198!$OMP CRITICAL 
199  PRINT *,'--------> ORCHIDEE TASK ',omp_rank
200  PRINT *,'omp_size =',omp_size
201  PRINT *,'omp_rank =',omp_rank
202  PRINT *,'is_omp_root =',is_omp_root
203  PRINT *,'offset_omp',offset_omp
204  PRINT *,'nbp_omp_para_nb =',nbp_omp_para_nb
205  PRINT *,'nbp_omp_para_begin =',nbp_omp_para_begin
206  PRINT *,'nbp_omp_para_end =',nbp_omp_para_end   
207  PRINT *,'nbp_omp =',nbp_omp
208  PRINT *,'nbp_omp_begin =',nbp_omp_begin
209  PRINT *,'nbp_omp_end =',nbp_omp_end   
210!$OMP END CRITICAL
211
212  END SUBROUTINE print_omp_data
213
214!!  =============================================================================================================================
215!! SUBROUTINE:  Init_synchro_omp 
216!!
217!>\BRIEF    initialization of  some variables use for the synchronisation of omp threads
218!!
219!! DESCRIPTION:   initialization of  some variables use for the synchronisation of omp threads
220!!
221!!               
222!! \n
223!_ ==============================================================================================================================
224  SUBROUTINE Init_synchro_omp
225  IMPLICIT NONE
226   
227    IF (is_omp_root) THEN
228      ALLOCATE(proc_synchro_omp(0:omp_size-1))
229      proc_synchro_omp(:)=.FALSE.
230
231      IF ( check_all_transfert ) THEN
232         ALLOCATE(omp_function(0:omp_size-1))
233         omp_function(:)=-1
234      ENDIF
235    ENDIF
236    CALL barrier2_omp()
237
238  END SUBROUTINE Init_Synchro_omp
239 
240!!  =============================================================================================================================
241!! SUBROUTINE:   Synchro_omp
242!!
243!>\BRIEF            routine to make synchronisation of omp threads after a call to a omp routine         
244!!
245!! DESCRIPTION:   routine to make synchronisation of omp threads after a call to a omp routine
246!!                add a control to check the time waited for the synchronisation.
247!!               
248!! \n
249!_ ==============================================================================================================================
250  SUBROUTINE Synchro_omp
251  IMPLICIT NONE
252    INTEGER iter
253    LOGICAL, PARAMETER :: check=.TRUE.
254    INTEGER, PARAMETER :: iter_max=1
255    INTEGER, PARAMETER :: print_iter=1
256
257    proc_synchro_omp(omp_rank)=.TRUE.
258    CALL barrier2_omp()
259
260    iter=0
261    DO WHILE (.NOT. ALL(proc_synchro_omp))
262       iter=iter+1
263       IF ( mod(iter,print_iter) == 0 ) THEN
264          IF (numout_omp > 0) THEN
265             WRITE(numout_omp,*) "ORCHIDEE SYNCHRO OMP : iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
266          ELSE
267             WRITE(*,*) "ORCHIDEE SYNCHRO OMP : iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
268          ENDIF
269       ENDIF
270       IF (check) THEN
271          IF (iter > iter_max) THEN
272             IF (numout_omp > 0) THEN
273                WRITE(numout_omp,*) "TOO MUCH WAIT in Synchro_Omp !! iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
274                WRITE(numout_omp,*) "We stop here"
275                WRITE(numout_omp,*) "omp_function : ",omp_function(:)
276             ELSE
277                WRITE(*,*) "TOO MUCH WAIT in Synchro_Omp !! iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
278                WRITE(*,*) "We stop here"
279                WRITE(*,*) "omp_function : ",omp_function(:)
280             ENDIF
281#ifdef CPP_PARA
282             CALL MPI_ABORT(4)
283#endif     
284             STOP 'Fatal error from ORCHIDEE : Synchro_Omp failed'
285          ENDIF
286       ENDIF
287    CALL barrier2_omp()
288    ENDDO
289    CALL barrier2_omp()
290    proc_synchro_omp(omp_rank)=.FALSE.
291    CALL barrier2_omp()
292
293   END SUBROUTINE Synchro_omp
294
295!!  =============================================================================================================================
296!! SUBROUTINE:    print_omp_function
297!!
298!>\BRIEF         
299!!
300!! DESCRIPTION:   
301!!
302!!               
303!! \n
304!_ ==============================================================================================================================
305   SUBROUTINE print_omp_function ()
306
307     IF ( check_all_transfert ) THEN
308        CALL barrier2_omp()
309        IF (numout_omp > 0) THEN
310           WRITE(numout_omp,*) omp_rank,&
311                " : ",omp_fct_name(omp_previous),'->',omp_fct_name(omp_function(omp_rank))
312           IF (MINVAL(omp_function(:)).LT.MAXVAL(omp_function(:))) &
313                WRITE(numout_omp,*) "!!! OMP ERROR : NO MORE SYNCHRO  !!!  ",omp_function(:)
314        ELSE
315           WRITE(*,*) omp_rank,&
316                " : ",omp_fct_name(omp_previous),'->',omp_fct_name(omp_function(omp_rank))
317           IF (MINVAL(omp_function(:)).LT.MAXVAL(omp_function(:))) &
318                WRITE(*,*) "!!! OMP ERROR : NO MORE SYNCHRO  !!!  ",omp_function(:)
319        ENDIF
320        CALL barrier2_omp()
321     ENDIF
322
323  END SUBROUTINE print_omp_function
324
325
326END MODULE mod_orchidee_omp_data
Note: See TracBrowser for help on using the repository browser.