Changeset 11192 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/lbclnk.F90
- Timestamp:
- 2019-06-27T12:40:32+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/lbclnk.F90
r11067 r11192 14 14 !! - ! 2017-05 (G. Madec) create generic.h90 files to generate all lbc and north fold routines 15 15 !!---------------------------------------------------------------------- 16 #if defined key_mpp_mpi17 !!----------------------------------------------------------------------18 !! 'key_mpp_mpi' MPI massively parallel processing library19 !!----------------------------------------------------------------------20 16 !! define the generic interfaces of lib_mpp routines 21 17 !!---------------------------------------------------------------------- … … 23 19 !! lbc_bdy_lnk : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp 24 20 !!---------------------------------------------------------------------- 25 USE par_oce ! ocean dynamics and tracers21 USE dom_oce ! ocean space and time domain 26 22 USE lib_mpp ! distributed memory computing library 27 23 USE lbcnfd ! north fold 24 USE in_out_manager ! I/O manager 25 26 IMPLICIT NONE 27 PRIVATE 28 28 29 29 INTERFACE lbc_lnk … … 51 51 END INTERFACE 52 52 53 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 54 PUBLIC lbc_lnk_multi ! modified ocean/ice lateral boundary conditions 55 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 53 INTERFACE mpp_nfd 54 MODULE PROCEDURE mpp_nfd_2d , mpp_nfd_3d , mpp_nfd_4d 55 MODULE PROCEDURE mpp_nfd_2d_ptr, mpp_nfd_3d_ptr, mpp_nfd_4d_ptr 56 END INTERFACE 57 58 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 59 PUBLIC lbc_lnk_multi ! modified ocean/ice lateral boundary conditions 60 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 56 61 PUBLIC lbc_bdy_lnk_multi ! modified ocean lateral BDY boundary conditions 57 PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions 58 62 PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions 63 64 #if defined key_mpp_mpi 65 !$AGRIF_DO_NOT_TREAT 66 INCLUDE 'mpif.h' 67 !$AGRIF_END_DO_NOT_TREAT 68 #endif 59 69 !!---------------------------------------------------------------------- 60 70 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 63 73 !!---------------------------------------------------------------------- 64 74 CONTAINS 65 66 #else67 !!----------------------------------------------------------------------68 !! Default option shared memory computing69 !!----------------------------------------------------------------------70 !! routines setting the appropriate values71 !! on first and last row and column of the global domain72 !!----------------------------------------------------------------------73 !! lbc_lnk_sum_3d: compute sum over the halos on a 3D variable on ocean mesh74 !! lbc_lnk_sum_3d: compute sum over the halos on a 2D variable on ocean mesh75 !! lbc_lnk : generic interface for lbc_lnk_3d and lbc_lnk_2d76 !! lbc_lnk_3d : set the lateral boundary condition on a 3D variable on ocean mesh77 !! lbc_lnk_2d : set the lateral boundary condition on a 2D variable on ocean mesh78 !! lbc_bdy_lnk : set the lateral BDY boundary condition79 !!----------------------------------------------------------------------80 USE oce ! ocean dynamics and tracers81 USE dom_oce ! ocean space and time domain82 USE in_out_manager ! I/O manager83 USE lbcnfd ! north fold84 85 IMPLICIT NONE86 PRIVATE87 88 INTERFACE lbc_lnk89 MODULE PROCEDURE lbc_lnk_2d , lbc_lnk_3d , lbc_lnk_4d90 END INTERFACE91 INTERFACE lbc_lnk_ptr92 MODULE PROCEDURE lbc_lnk_2d_ptr , lbc_lnk_3d_ptr , lbc_lnk_4d_ptr93 END INTERFACE94 INTERFACE lbc_lnk_multi95 MODULE PROCEDURE lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi96 END INTERFACE97 !98 INTERFACE lbc_bdy_lnk99 MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d, lbc_bdy_lnk_4d100 END INTERFACE101 !102 INTERFACE lbc_lnk_icb103 MODULE PROCEDURE lbc_lnk_2d_icb104 END INTERFACE105 106 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions107 PUBLIC lbc_lnk_multi ! modified ocean/ice lateral boundary conditions108 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions109 PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions110 111 !!----------------------------------------------------------------------112 !! NEMO/OCE 4.0 , NEMO Consortium (2018)113 !! $Id$114 !! Software governed by the CeCILL license (see ./LICENSE)115 !!----------------------------------------------------------------------116 CONTAINS117 118 !!======================================================================119 !! Default option 3D shared memory computing120 !!======================================================================121 !! routines setting land point, or east-west cyclic,122 !! or north-south cyclic, or north fold values123 !! on first and last row and column of the global domain124 !!----------------------------------------------------------------------125 126 !!----------------------------------------------------------------------127 !! *** routine lbc_lnk_(2,3,4)d ***128 !!129 !! * Argument : dummy argument use in lbc_lnk_... routines130 !! ptab : array or pointer of arrays on which the boundary condition is applied131 !! cd_nat : nature of array grid-points132 !! psgn : sign used across the north fold boundary133 !! kfld : optional, number of pt3d arrays134 !! cd_mpp : optional, fill the overlap area only135 !! pval : optional, background value (used at closed boundaries)136 !!----------------------------------------------------------------------137 !138 ! !== 2D array and array of 2D pointer ==!139 !140 # define DIM_2d141 # define ROUTINE_LNK lbc_lnk_2d142 # include "lbc_lnk_generic.h90"143 # undef ROUTINE_LNK144 # define MULTI145 # define ROUTINE_LNK lbc_lnk_2d_ptr146 # include "lbc_lnk_generic.h90"147 # undef ROUTINE_LNK148 # undef MULTI149 # undef DIM_2d150 !151 ! !== 3D array and array of 3D pointer ==!152 !153 # define DIM_3d154 # define ROUTINE_LNK lbc_lnk_3d155 # include "lbc_lnk_generic.h90"156 # undef ROUTINE_LNK157 # define MULTI158 # define ROUTINE_LNK lbc_lnk_3d_ptr159 # include "lbc_lnk_generic.h90"160 # undef ROUTINE_LNK161 # undef MULTI162 # undef DIM_3d163 !164 ! !== 4D array and array of 4D pointer ==!165 !166 # define DIM_4d167 # define ROUTINE_LNK lbc_lnk_4d168 # include "lbc_lnk_generic.h90"169 # undef ROUTINE_LNK170 # define MULTI171 # define ROUTINE_LNK lbc_lnk_4d_ptr172 # include "lbc_lnk_generic.h90"173 # undef ROUTINE_LNK174 # undef MULTI175 # undef DIM_4d176 177 !!======================================================================178 !! identical routines in both C1D and shared memory computing179 !!======================================================================180 181 !!----------------------------------------------------------------------182 !! *** routine lbc_bdy_lnk_(2,3,4)d ***183 !!184 !! wrapper rountine to 'lbc_lnk_3d'. This wrapper is used185 !! to maintain the same interface with regards to the mpp case186 !!----------------------------------------------------------------------187 188 SUBROUTINE lbc_bdy_lnk_4d( cdname, pt4d, cd_type, psgn, ib_bdy )189 !!----------------------------------------------------------------------190 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine191 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pt4d ! 3D array on which the lbc is applied192 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points193 REAL(wp) , INTENT(in ) :: psgn ! sign used across north fold194 INTEGER , INTENT(in ) :: ib_bdy ! BDY boundary set195 !!----------------------------------------------------------------------196 CALL lbc_lnk_4d( cdname, pt4d, cd_type, psgn)197 END SUBROUTINE lbc_bdy_lnk_4d198 199 SUBROUTINE lbc_bdy_lnk_3d( cdname, pt3d, cd_type, psgn, ib_bdy )200 !!----------------------------------------------------------------------201 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine202 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied203 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points204 REAL(wp) , INTENT(in ) :: psgn ! sign used across north fold205 INTEGER , INTENT(in ) :: ib_bdy ! BDY boundary set206 !!----------------------------------------------------------------------207 CALL lbc_lnk_3d( cdname, pt3d, cd_type, psgn)208 END SUBROUTINE lbc_bdy_lnk_3d209 210 211 SUBROUTINE lbc_bdy_lnk_2d( cdname, pt2d, cd_type, psgn, ib_bdy )212 !!----------------------------------------------------------------------213 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine214 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2d ! 3D array on which the lbc is applied215 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points216 REAL(wp) , INTENT(in ) :: psgn ! sign used across north fold217 INTEGER , INTENT(in ) :: ib_bdy ! BDY boundary set218 !!----------------------------------------------------------------------219 CALL lbc_lnk_2d( cdname, pt2d, cd_type, psgn)220 END SUBROUTINE lbc_bdy_lnk_2d221 222 223 !!gm This routine should be removed with an optional halos size added in argument of generic routines224 225 SUBROUTINE lbc_lnk_2d_icb( cdname, pt2d, cd_type, psgn, ki, kj )226 !!----------------------------------------------------------------------227 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine228 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied229 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points230 REAL(wp) , INTENT(in ) :: psgn ! sign used across north fold231 INTEGER , INTENT(in ) :: ki, kj ! sizes of extra halo (not needed in non-mpp)232 !!----------------------------------------------------------------------233 CALL lbc_lnk_2d( cdname, pt2d, cd_type, psgn )234 END SUBROUTINE lbc_lnk_2d_icb235 !!gm end236 237 #endif238 239 !!======================================================================240 !! identical routines in both distributed and shared memory computing241 !!======================================================================242 75 243 76 !!---------------------------------------------------------------------- … … 307 140 # undef DIM_4d 308 141 142 !!---------------------------------------------------------------------- 143 !! *** routine mpp_lnk_(2,3,4)d *** 144 !! 145 !! * Argument : dummy argument use in mpp_lnk_... routines 146 !! ptab : array or pointer of arrays on which the boundary condition is applied 147 !! cd_nat : nature of array grid-points 148 !! psgn : sign used across the north fold boundary 149 !! kfld : optional, number of pt3d arrays 150 !! cd_mpp : optional, fill the overlap area only 151 !! pval : optional, background value (used at closed boundaries) 152 !!---------------------------------------------------------------------- 153 ! 154 ! !== 2D array and array of 2D pointer ==! 155 ! 156 # define DIM_2d 157 # define ROUTINE_LNK mpp_lnk_2d 158 # include "mpp_lnk_generic.h90" 159 # undef ROUTINE_LNK 160 # define MULTI 161 # define ROUTINE_LNK mpp_lnk_2d_ptr 162 # include "mpp_lnk_generic.h90" 163 # undef ROUTINE_LNK 164 # undef MULTI 165 # undef DIM_2d 166 ! 167 ! !== 3D array and array of 3D pointer ==! 168 ! 169 # define DIM_3d 170 # define ROUTINE_LNK mpp_lnk_3d 171 # include "mpp_lnk_generic.h90" 172 # undef ROUTINE_LNK 173 # define MULTI 174 # define ROUTINE_LNK mpp_lnk_3d_ptr 175 # include "mpp_lnk_generic.h90" 176 # undef ROUTINE_LNK 177 # undef MULTI 178 # undef DIM_3d 179 ! 180 ! !== 4D array and array of 4D pointer ==! 181 ! 182 # define DIM_4d 183 # define ROUTINE_LNK mpp_lnk_4d 184 # include "mpp_lnk_generic.h90" 185 # undef ROUTINE_LNK 186 # define MULTI 187 # define ROUTINE_LNK mpp_lnk_4d_ptr 188 # include "mpp_lnk_generic.h90" 189 # undef ROUTINE_LNK 190 # undef MULTI 191 # undef DIM_4d 192 193 !!---------------------------------------------------------------------- 194 !! *** routine mpp_nfd_(2,3,4)d *** 195 !! 196 !! * Argument : dummy argument use in mpp_nfd_... routines 197 !! ptab : array or pointer of arrays on which the boundary condition is applied 198 !! cd_nat : nature of array grid-points 199 !! psgn : sign used across the north fold boundary 200 !! kfld : optional, number of pt3d arrays 201 !! cd_mpp : optional, fill the overlap area only 202 !! pval : optional, background value (used at closed boundaries) 203 !!---------------------------------------------------------------------- 204 ! 205 ! !== 2D array and array of 2D pointer ==! 206 ! 207 # define DIM_2d 208 # define ROUTINE_NFD mpp_nfd_2d 209 # include "mpp_nfd_generic.h90" 210 # undef ROUTINE_NFD 211 # define MULTI 212 # define ROUTINE_NFD mpp_nfd_2d_ptr 213 # include "mpp_nfd_generic.h90" 214 # undef ROUTINE_NFD 215 # undef MULTI 216 # undef DIM_2d 217 ! 218 ! !== 3D array and array of 3D pointer ==! 219 ! 220 # define DIM_3d 221 # define ROUTINE_NFD mpp_nfd_3d 222 # include "mpp_nfd_generic.h90" 223 # undef ROUTINE_NFD 224 # define MULTI 225 # define ROUTINE_NFD mpp_nfd_3d_ptr 226 # include "mpp_nfd_generic.h90" 227 # undef ROUTINE_NFD 228 # undef MULTI 229 # undef DIM_3d 230 ! 231 ! !== 4D array and array of 4D pointer ==! 232 ! 233 # define DIM_4d 234 # define ROUTINE_NFD mpp_nfd_4d 235 # include "mpp_nfd_generic.h90" 236 # undef ROUTINE_NFD 237 # define MULTI 238 # define ROUTINE_NFD mpp_nfd_4d_ptr 239 # include "mpp_nfd_generic.h90" 240 # undef ROUTINE_NFD 241 # undef MULTI 242 # undef DIM_4d 243 244 !!---------------------------------------------------------------------- 245 !! *** routine mpp_lnk_bdy_(2,3,4)d *** 246 !! 247 !! * Argument : dummy argument use in mpp_lnk_... routines 248 !! ptab : array or pointer of arrays on which the boundary condition is applied 249 !! cd_nat : nature of array grid-points 250 !! psgn : sign used across the north fold boundary 251 !! kb_bdy : BDY boundary set 252 !! kfld : optional, number of pt3d arrays 253 !!---------------------------------------------------------------------- 254 ! 255 ! !== 2D array and array of 2D pointer ==! 256 ! 257 # define DIM_2d 258 # define ROUTINE_BDY mpp_lnk_bdy_2d 259 # include "mpp_bdy_generic.h90" 260 # undef ROUTINE_BDY 261 # define MULTI 262 # define ROUTINE_BDY mpp_lnk_bdy_2d_ptr 263 # include "mpp_bdy_generic.h90" 264 # undef ROUTINE_BDY 265 # undef MULTI 266 # undef DIM_2d 267 ! 268 ! !== 3D array and array of 3D pointer ==! 269 ! 270 # define DIM_3d 271 # define ROUTINE_BDY mpp_lnk_bdy_3d 272 # include "mpp_bdy_generic.h90" 273 # undef ROUTINE_BDY 274 # define MULTI 275 # define ROUTINE_BDY mpp_lnk_bdy_3d_ptr 276 # include "mpp_bdy_generic.h90" 277 # undef ROUTINE_BDY 278 # undef MULTI 279 # undef DIM_3d 280 ! 281 ! !== 4D array and array of 4D pointer ==! 282 ! 283 # define DIM_4d 284 # define ROUTINE_BDY mpp_lnk_bdy_4d 285 # include "mpp_bdy_generic.h90" 286 # undef ROUTINE_BDY 287 # define MULTI 288 # define ROUTINE_BDY mpp_lnk_bdy_4d_ptr 289 # include "mpp_bdy_generic.h90" 290 # undef ROUTINE_BDY 291 # undef MULTI 292 # undef DIM_4d 309 293 310 294 !!====================================================================== 295 296 297 298 SUBROUTINE mpp_lbc_north_icb( pt2d, cd_type, psgn, kextj) 299 !!--------------------------------------------------------------------- 300 !! *** routine mpp_lbc_north_icb *** 301 !! 302 !! ** Purpose : Ensure proper north fold horizontal bondary condition 303 !! in mpp configuration in case of jpn1 > 1 and for 2d 304 !! array with outer extra halo 305 !! 306 !! ** Method : North fold condition and mpp with more than one proc 307 !! in i-direction require a specific treatment. We gather 308 !! the 4+kextj northern lines of the global domain on 1 309 !! processor and apply lbc north-fold on this sub array. 310 !! Then we scatter the north fold array back to the processors. 311 !! This routine accounts for an extra halo with icebergs 312 !! and assumes ghost rows and columns have been suppressed. 313 !! 314 !!---------------------------------------------------------------------- 315 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2d ! 2D array with extra halo 316 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 317 ! ! = T , U , V , F or W -points 318 REAL(wp) , INTENT(in ) :: psgn ! = -1. the sign change across the 319 !! ! north fold, = 1. otherwise 320 INTEGER , INTENT(in ) :: kextj ! Extra halo width at north fold 321 ! 322 INTEGER :: ji, jj, jr 323 INTEGER :: ierr, itaille, ildi, ilei, iilb 324 INTEGER :: ipj, ij, iproc 325 ! 326 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ztab_e, znorthloc_e 327 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: znorthgloio_e 328 !!---------------------------------------------------------------------- 329 #if defined key_mpp_mpi 330 ! 331 ipj=4 332 ALLOCATE( ztab_e(jpiglo, 1-kextj:ipj+kextj) , & 333 & znorthloc_e(jpimax, 1-kextj:ipj+kextj) , & 334 & znorthgloio_e(jpimax, 1-kextj:ipj+kextj,jpni) ) 335 ! 336 ztab_e(:,:) = 0._wp 337 znorthloc_e(:,:) = 0._wp 338 ! 339 ij = 1 - kextj 340 ! put the last ipj+2*kextj lines of pt2d into znorthloc_e 341 DO jj = jpj - ipj + 1 - kextj , jpj + kextj 342 znorthloc_e(1:jpi,ij)=pt2d(1:jpi,jj) 343 ij = ij + 1 344 END DO 345 ! 346 itaille = jpimax * ( ipj + 2*kextj ) 347 ! 348 IF( ln_timing ) CALL tic_tac(.TRUE.) 349 CALL MPI_ALLGATHER( znorthloc_e(1,1-kextj) , itaille, MPI_DOUBLE_PRECISION, & 350 & znorthgloio_e(1,1-kextj,1), itaille, MPI_DOUBLE_PRECISION, & 351 & ncomm_north, ierr ) 352 ! 353 IF( ln_timing ) CALL tic_tac(.FALSE.) 354 ! 355 DO jr = 1, ndim_rank_north ! recover the global north array 356 iproc = nrank_north(jr) + 1 357 ildi = nldit (iproc) 358 ilei = nleit (iproc) 359 iilb = nimppt(iproc) 360 DO jj = 1-kextj, ipj+kextj 361 DO ji = ildi, ilei 362 ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr) 363 END DO 364 END DO 365 END DO 366 367 ! 2. North-Fold boundary conditions 368 ! ---------------------------------- 369 CALL lbc_nfd( ztab_e(:,1-kextj:ipj+kextj), cd_type, psgn, kextj ) 370 371 ij = 1 - kextj 372 !! Scatter back to pt2d 373 DO jj = jpj - ipj + 1 - kextj , jpj + kextj 374 DO ji= 1, jpi 375 pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij) 376 END DO 377 ij = ij +1 378 END DO 379 ! 380 DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e ) 381 ! 382 #endif 383 END SUBROUTINE mpp_lbc_north_icb 384 385 386 SUBROUTINE mpp_lnk_2d_icb( cdname, pt2d, cd_type, psgn, kexti, kextj ) 387 !!---------------------------------------------------------------------- 388 !! *** routine mpp_lnk_2d_icb *** 389 !! 390 !! ** Purpose : Message passing management for 2d array (with extra halo for icebergs) 391 !! This routine receives a (1-kexti:jpi+kexti,1-kexti:jpj+kextj) 392 !! array (usually (0:jpi+1, 0:jpj+1)) from lbc_lnk_icb calls. 393 !! 394 !! ** Method : Use mppsend and mpprecv function for passing mask 395 !! between processors following neighboring subdomains. 396 !! domain parameters 397 !! jpi : first dimension of the local subdomain 398 !! jpj : second dimension of the local subdomain 399 !! kexti : number of columns for extra outer halo 400 !! kextj : number of rows for extra outer halo 401 !! nbondi : mark for "east-west local boundary" 402 !! nbondj : mark for "north-south local boundary" 403 !! noea : number for local neighboring processors 404 !! nowe : number for local neighboring processors 405 !! noso : number for local neighboring processors 406 !! nono : number for local neighboring processors 407 !!---------------------------------------------------------------------- 408 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 409 REAL(wp), DIMENSION(1-kexti:jpi+kexti,1-kextj:jpj+kextj), INTENT(inout) :: pt2d ! 2D array with extra halo 410 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of ptab array grid-points 411 REAL(wp) , INTENT(in ) :: psgn ! sign used across the north fold 412 INTEGER , INTENT(in ) :: kexti ! extra i-halo width 413 INTEGER , INTENT(in ) :: kextj ! extra j-halo width 414 ! 415 INTEGER :: jl ! dummy loop indices 416 INTEGER :: imigr, iihom, ijhom ! local integers 417 INTEGER :: ipreci, iprecj ! - - 418 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 419 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 420 !! 421 REAL(wp), DIMENSION(1-kexti:jpi+kexti,nn_hls+kextj,2) :: r2dns, r2dsn 422 REAL(wp), DIMENSION(1-kextj:jpj+kextj,nn_hls+kexti,2) :: r2dwe, r2dew 423 !!---------------------------------------------------------------------- 424 425 ipreci = nn_hls + kexti ! take into account outer extra 2D overlap area 426 iprecj = nn_hls + kextj 427 428 IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, 1, 1, 1, ld_lbc = .TRUE. ) 429 430 ! 1. standard boundary treatment 431 ! ------------------------------ 432 ! Order matters Here !!!! 433 ! 434 ! ! East-West boundaries 435 ! !* Cyclic east-west 436 IF( l_Iperio ) THEN 437 pt2d(1-kexti: 1 ,:) = pt2d(jpim1-kexti: jpim1 ,:) ! east 438 pt2d( jpi :jpi+kexti,:) = pt2d( 2 :2+kexti,:) ! west 439 ! 440 ELSE !* closed 441 IF( .NOT. cd_type == 'F' ) pt2d( 1-kexti :nn_hls ,:) = 0._wp ! east except at F-point 442 pt2d(jpi-nn_hls+1:jpi+kexti,:) = 0._wp ! west 443 ENDIF 444 ! ! North-South boundaries 445 IF( l_Jperio ) THEN !* cyclic (only with no mpp j-split) 446 pt2d(:,1-kextj: 1 ) = pt2d(:,jpjm1-kextj: jpjm1) ! north 447 pt2d(:, jpj :jpj+kextj) = pt2d(:, 2 :2+kextj) ! south 448 ELSE !* closed 449 IF( .NOT. cd_type == 'F' ) pt2d(:, 1-kextj :nn_hls ) = 0._wp ! north except at F-point 450 pt2d(:,jpj-nn_hls+1:jpj+kextj) = 0._wp ! south 451 ENDIF 452 ! 453 454 ! north fold treatment 455 ! ----------------------- 456 IF( npolj /= 0 ) THEN 457 ! 458 SELECT CASE ( jpni ) 459 CASE ( 1 ) ; CALL lbc_nfd ( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj ) 460 CASE DEFAULT ; CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj ) 461 END SELECT 462 ! 463 ENDIF 464 465 ! 2. East and west directions exchange 466 ! ------------------------------------ 467 ! we play with the neigbours AND the row number because of the periodicity 468 ! 469 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 470 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 471 iihom = jpi-nreci-kexti 472 DO jl = 1, ipreci 473 r2dew(:,jl,1) = pt2d(nn_hls+jl,:) 474 r2dwe(:,jl,1) = pt2d(iihom +jl,:) 475 END DO 476 END SELECT 477 ! 478 ! ! Migrations 479 imigr = ipreci * ( jpj + 2*kextj ) 480 ! 481 IF( ln_timing ) CALL tic_tac(.TRUE.) 482 ! 483 SELECT CASE ( nbondi ) 484 CASE ( -1 ) 485 CALL mppsend( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req1 ) 486 CALL mpprecv( 1, r2dew(1-kextj,1,2), imigr, noea ) 487 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 488 CASE ( 0 ) 489 CALL mppsend( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 ) 490 CALL mppsend( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req2 ) 491 CALL mpprecv( 1, r2dew(1-kextj,1,2), imigr, noea ) 492 CALL mpprecv( 2, r2dwe(1-kextj,1,2), imigr, nowe ) 493 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 494 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 495 CASE ( 1 ) 496 CALL mppsend( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 ) 497 CALL mpprecv( 2, r2dwe(1-kextj,1,2), imigr, nowe ) 498 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 499 END SELECT 500 ! 501 IF( ln_timing ) CALL tic_tac(.FALSE.) 502 ! 503 ! ! Write Dirichlet lateral conditions 504 iihom = jpi - nn_hls 505 ! 506 SELECT CASE ( nbondi ) 507 CASE ( -1 ) 508 DO jl = 1, ipreci 509 pt2d(iihom+jl,:) = r2dew(:,jl,2) 510 END DO 511 CASE ( 0 ) 512 DO jl = 1, ipreci 513 pt2d(jl-kexti,:) = r2dwe(:,jl,2) 514 pt2d(iihom+jl,:) = r2dew(:,jl,2) 515 END DO 516 CASE ( 1 ) 517 DO jl = 1, ipreci 518 pt2d(jl-kexti,:) = r2dwe(:,jl,2) 519 END DO 520 END SELECT 521 522 523 ! 3. North and south directions 524 ! ----------------------------- 525 ! always closed : we play only with the neigbours 526 ! 527 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 528 ijhom = jpj-nrecj-kextj 529 DO jl = 1, iprecj 530 r2dsn(:,jl,1) = pt2d(:,ijhom +jl) 531 r2dns(:,jl,1) = pt2d(:,nn_hls+jl) 532 END DO 533 ENDIF 534 ! 535 ! ! Migrations 536 imigr = iprecj * ( jpi + 2*kexti ) 537 ! 538 IF( ln_timing ) CALL tic_tac(.TRUE.) 539 ! 540 SELECT CASE ( nbondj ) 541 CASE ( -1 ) 542 CALL mppsend( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req1 ) 543 CALL mpprecv( 3, r2dns(1-kexti,1,2), imigr, nono ) 544 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 545 CASE ( 0 ) 546 CALL mppsend( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 ) 547 CALL mppsend( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req2 ) 548 CALL mpprecv( 3, r2dns(1-kexti,1,2), imigr, nono ) 549 CALL mpprecv( 4, r2dsn(1-kexti,1,2), imigr, noso ) 550 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 551 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 552 CASE ( 1 ) 553 CALL mppsend( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 ) 554 CALL mpprecv( 4, r2dsn(1-kexti,1,2), imigr, noso ) 555 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 556 END SELECT 557 ! 558 IF( ln_timing ) CALL tic_tac(.FALSE.) 559 ! 560 ! ! Write Dirichlet lateral conditions 561 ijhom = jpj - nn_hls 562 ! 563 SELECT CASE ( nbondj ) 564 CASE ( -1 ) 565 DO jl = 1, iprecj 566 pt2d(:,ijhom+jl) = r2dns(:,jl,2) 567 END DO 568 CASE ( 0 ) 569 DO jl = 1, iprecj 570 pt2d(:,jl-kextj) = r2dsn(:,jl,2) 571 pt2d(:,ijhom+jl) = r2dns(:,jl,2) 572 END DO 573 CASE ( 1 ) 574 DO jl = 1, iprecj 575 pt2d(:,jl-kextj) = r2dsn(:,jl,2) 576 END DO 577 END SELECT 578 ! 579 END SUBROUTINE mpp_lnk_2d_icb 580 311 581 END MODULE lbclnk 312 582
Note: See TracChangeset
for help on using the changeset viewer.
