[7541] | 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 | !_ ================================================================================================================================ |
---|
| 24 | MODULE mod_orchidee_omp_data |
---|
| 25 | |
---|
| 26 | !- |
---|
| 27 | USE defprec |
---|
| 28 | USE ioipsl |
---|
| 29 | USE mod_orchidee_para_var |
---|
| 30 | |
---|
| 31 | IMPLICIT NONE |
---|
| 32 | |
---|
| 33 | CONTAINS |
---|
| 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 | |
---|
| 350 | END MODULE mod_orchidee_omp_data |
---|