source: branches/publications/ORCHIDEE_gmd-2018-57/src_parallel/mod_orchidee_omp_data.F90

Last change on this file was 1920, checked in by josefine.ghattas, 10 years ago
  • Created a new module mod_orchidee_para_var. This module contains public variables previously stored in mod_orchidee_omp_data.F90 and mod_orchidee_mpi_data.F90. This is done to avoid circular dependency so that this module now can be used in all other modules if needed.
  • xios_orchidee : Add use of the new module to acces numout declaration. Change to write into file numout. This was not possible before.
File size: 5.6 KB
Line 
1! Definition and allocation of parallel datas for OpenMP.
2
3!-
4!- $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_parallel/Attic/mod_orchidee_omp_data.F90,v 1.1.2.3 2008/11/05 10:08:25 ssipsl Exp $
5!-
6
7MODULE mod_orchidee_omp_data
8
9!-
10  USE defprec
11  USE ioipsl
12  USE mod_orchidee_para_var
13
14  IMPLICIT NONE
15
16CONTAINS
17
18    SUBROUTINE barrier2_omp()
19
20    IMPLICIT NONE
21
22!$OMP BARRIER
23!$OMP BARRIER
24
25  END SUBROUTINE barrier2_omp
26
27
28
29 
30  SUBROUTINE Init_orchidee_omp
31  IMPLICIT NONE
32 
33#ifdef CPP_OMP
34    IF (is_omp_root) THEN
35        is_ok_omp=.TRUE.
36    ENDIF
37#else   
38    is_ok_omp=.FALSE.
39#endif
40
41
42    IF (is_ok_omp) THEN
43      STOP 'Open MP is not yet implemented for driver'
44    ELSE
45      omp_size=1
46      omp_rank=0
47      is_omp_root=.TRUE.
48    ENDIF
49
50  END SUBROUTINE Init_orchidee_omp
51
52  SUBROUTINE Init_numout_omp(numout)
53    INTEGER, INTENT(in) :: numout
54    numout_omp=numout
55  END SUBROUTINE Init_numout_omp
56
57
58  SUBROUTINE Init_orchidee_omp_data(arg_omp_size,arg_omp_rank,arg_nbp_omp,arg_offset_omp)
59    IMPLICIT NONE
60    INTEGER, INTENT(IN) :: arg_omp_size
61    INTEGER, INTENT(IN) :: arg_omp_rank
62    INTEGER, INTENT(IN) :: arg_nbp_omp
63    INTEGER, INTENT(IN) :: arg_offset_omp
64   
65    INTEGER    :: i
66   
67   
68    IF (arg_omp_rank==0) THEN
69      is_omp_root=.TRUE.
70    ELSE
71      is_omp_root=.FALSE.
72    ENDIF
73   
74#ifdef CPP_OMP
75    IF (is_omp_root) THEN
76        is_ok_omp=.TRUE.
77    ENDIF
78#else   
79    is_ok_omp=.FALSE.
80#endif
81
82    IF (is_omp_root) omp_size=arg_omp_size
83
84    CALL barrier2_omp()
85
86     omp_rank=arg_omp_rank
87   
88    IF (is_omp_root) THEN
89      ALLOCATE(nbp_omp_para_nb(0:omp_size-1))
90      ALLOCATE(nbp_omp_para_begin(0:omp_size-1))
91      ALLOCATE(nbp_omp_para_end(0:omp_size-1))
92    ENDIF
93   
94    CALL barrier2_omp()
95    nbp_omp_para_nb(omp_rank)=arg_nbp_omp
96    CALL barrier2_omp()
97   
98    IF (is_omp_root) THEN
99
100      nbp_omp_para_begin(0)=1
101      nbp_omp_para_end(0)=nbp_omp_para_nb(0)
102
103      DO i=1,omp_size-1
104        nbp_omp_para_begin(i)=nbp_omp_para_end(i-1)+1
105        nbp_omp_para_end(i)=nbp_omp_para_begin(i)+nbp_omp_para_nb(i)-1
106      ENDDO
107
108    ENDIF
109
110    CALL barrier2_omp()
111     
112    nbp_omp=nbp_omp_para_nb(omp_rank)
113    nbp_omp_begin=nbp_omp_para_begin(omp_rank)
114    nbp_omp_end=nbp_omp_para_end(omp_rank)
115   
116    offset_omp=arg_offset_omp         
117    CALL Print_omp_data
118   
119    CALL Init_synchro_omp()
120   
121  END SUBROUTINE Init_orchidee_omp_data
122
123  SUBROUTINE print_omp_data
124  IMPLICIT NONE
125
126!$OMP CRITICAL 
127  PRINT *,'--------> ORCHIDEE TASK ',omp_rank
128  PRINT *,'omp_size =',omp_size
129  PRINT *,'omp_rank =',omp_rank
130  PRINT *,'is_omp_root =',is_omp_root
131  PRINT *,'offset_omp',offset_omp
132  PRINT *,'nbp_omp_para_nb =',nbp_omp_para_nb
133  PRINT *,'nbp_omp_para_begin =',nbp_omp_para_begin
134  PRINT *,'nbp_omp_para_end =',nbp_omp_para_end   
135  PRINT *,'nbp_omp =',nbp_omp
136  PRINT *,'nbp_omp_begin =',nbp_omp_begin
137  PRINT *,'nbp_omp_end =',nbp_omp_end   
138!$OMP END CRITICAL
139
140  END SUBROUTINE print_omp_data
141
142  SUBROUTINE Init_synchro_omp
143  IMPLICIT NONE
144   
145    IF (is_omp_root) THEN
146      ALLOCATE(proc_synchro_omp(0:omp_size-1))
147      proc_synchro_omp(:)=.FALSE.
148
149      IF ( check_all_transfert ) THEN
150         ALLOCATE(omp_function(0:omp_size-1))
151         omp_function(:)=-1
152      ENDIF
153    ENDIF
154    CALL barrier2_omp()
155
156  END SUBROUTINE Init_Synchro_omp
157 
158  SUBROUTINE Synchro_omp
159  IMPLICIT NONE
160    INTEGER iter
161    LOGICAL, PARAMETER :: check=.TRUE.
162    INTEGER, PARAMETER :: iter_max=1
163    INTEGER, PARAMETER :: print_iter=1
164
165    proc_synchro_omp(omp_rank)=.TRUE.
166    CALL barrier2_omp()
167
168    iter=0
169    DO WHILE (.NOT. ALL(proc_synchro_omp))
170       iter=iter+1
171       IF ( mod(iter,print_iter) == 0 ) THEN
172          IF (numout_omp > 0) THEN
173             WRITE(numout_omp,*) "ORCHIDEE SYNCHRO OMP : iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
174          ELSE
175             WRITE(*,*) "ORCHIDEE SYNCHRO OMP : iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
176          ENDIF
177       ENDIF
178       IF (check) THEN
179          IF (iter > iter_max) THEN
180             IF (numout_omp > 0) THEN
181                WRITE(numout_omp,*) "TOO MUCH WAIT in Synchro_Omp !! iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
182                WRITE(numout_omp,*) "We stop here"
183                WRITE(numout_omp,*) "omp_function : ",omp_function(:)
184             ELSE
185                WRITE(*,*) "TOO MUCH WAIT in Synchro_Omp !! iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
186                WRITE(*,*) "We stop here"
187                WRITE(*,*) "omp_function : ",omp_function(:)
188             ENDIF
189#ifdef CPP_PARA
190             CALL MPI_ABORT(4)
191#endif     
192             STOP 'Fatal error from ORCHIDEE : Synchro_Omp failed'
193          ENDIF
194       ENDIF
195    CALL barrier2_omp()
196    ENDDO
197    CALL barrier2_omp()
198    proc_synchro_omp(omp_rank)=.FALSE.
199    CALL barrier2_omp()
200
201   END SUBROUTINE Synchro_omp
202
203   SUBROUTINE print_omp_function ()
204
205     IF ( check_all_transfert ) THEN
206        CALL barrier2_omp()
207        IF (numout_omp > 0) THEN
208           WRITE(numout_omp,*) omp_rank,&
209                " : ",omp_fct_name(omp_previous),'->',omp_fct_name(omp_function(omp_rank))
210           IF (MINVAL(omp_function(:)).LT.MAXVAL(omp_function(:))) &
211                WRITE(numout_omp,*) "!!! OMP ERROR : NO MORE SYNCHRO  !!!  ",omp_function(:)
212        ELSE
213           WRITE(*,*) omp_rank,&
214                " : ",omp_fct_name(omp_previous),'->',omp_fct_name(omp_function(omp_rank))
215           IF (MINVAL(omp_function(:)).LT.MAXVAL(omp_function(:))) &
216                WRITE(*,*) "!!! OMP ERROR : NO MORE SYNCHRO  !!!  ",omp_function(:)
217        ENDIF
218        CALL barrier2_omp()
219     ENDIF
220
221  END SUBROUTINE print_omp_function
222
223
224END MODULE mod_orchidee_omp_data
Note: See TracBrowser for help on using the repository browser.