Changeset 10136 for NEMO/branches
- Timestamp:
- 2018-09-17T15:16:43+02:00 (6 years ago)
- Location:
- NEMO/branches/2018/dev_r9759_HPC09_ESIWACE
- Files:
-
- 54 added
- 1 deleted
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r9759_HPC09_ESIWACE/src/OCE/LBC/lbc_lnk_multi_generic.h90
r9814 r10136 14 14 # define PTR_ptab pt4d 15 15 #endif 16 #if defined ASYNC 17 SUBROUTINE ROUTINE_MULTI( rname, loop_fct & 18 , pt1, cdna1, psgn1, pt2, cdna2, psgn2, pt3, cdna3, psgn3 & 19 & , pt4, cdna4, psgn4, pt5, cdna5, psgn5, pt6, cdna6, psgn6 & 20 & , pt7, cdna7, psgn7, pt8, cdna8, psgn8, pt9, cdna9, psgn9, cd_mpp, pval) 21 #else 16 22 SUBROUTINE ROUTINE_MULTI( rname, pt1, cdna1, psgn1, pt2, cdna2, psgn2, pt3, cdna3, psgn3 & 17 23 & , pt4, cdna4, psgn4, pt5, cdna5, psgn5, pt6, cdna6, psgn6 & 18 24 & , pt7, cdna7, psgn7, pt8, cdna8, psgn8, pt9, cdna9, psgn9, cd_mpp, pval) 25 #endif 19 26 !!--------------------------------------------------------------------- 20 27 ARRAY_TYPE(:,:,:,:) , TARGET, INTENT(inout) :: pt1 ! arrays on which the lbc is applied … … 26 33 CHARACTER(len=3) , OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only 27 34 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries) 35 #ifdef ASYNC 36 interface 37 subroutine loop_fct(i0, i1, j0, j1, k0, k1, buf) 38 integer, intent(in) :: i0, i1, j0, j1, k0, k1 39 REAL*8, dimension(:,:,:,:,:,:), optional, intent(out) :: buf 40 end subroutine loop_fct 41 end interface 42 #endif 28 43 !! 29 44 INTEGER :: kfld ! number of elements that will be attributed … … 49 64 IF( PRESENT(psgn9) ) CALL ROUTINE_LOAD( pt9, cdna9, psgn9, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 50 65 ! 66 #ifdef ASYNC 67 CALL lbc_lnk_ptr_async( rname, ptab_ptr, cdna_ptr, psgn_ptr, loop_fct, kfld, cd_mpp, pval ) 68 #else 51 69 CALL lbc_lnk_ptr( rname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, cd_mpp, pval ) 70 #endif 52 71 ! 53 72 END SUBROUTINE ROUTINE_MULTI -
NEMO/branches/2018/dev_r9759_HPC09_ESIWACE/src/OCE/LBC/lbclnk.F90
r9814 r10136 50 50 PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions 51 51 52 #ifdef BULL_ASYNC 53 INTERFACE lbc_lnk_async 54 MODULE PROCEDURE mpp_lnk_2d_async , mpp_lnk_3d_async , mpp_lnk_4d_async 55 END INTERFACE 56 INTERFACE lbc_lnk_ptr_async 57 MODULE PROCEDURE mpp_lnk_2d_ptr_async , mpp_lnk_3d_ptr_async , mpp_lnk_4d_ptr_async 58 END INTERFACE 59 INTERFACE lbc_lnk_multi_async 60 MODULE PROCEDURE lbc_lnk_2d_multi_async, lbc_lnk_3d_multi_async, lbc_lnk_4d_multi_async 61 END INTERFACE 62 63 PUBLIC lbc_lnk_async ! ocean/ice lateral boundary conditions 64 PUBLIC lbc_lnk_multi_async ! modified ocean/ice lateral boundary conditions 65 #endif 66 52 67 PUBLIC simulated_lbc_lnk 53 68 … … 91 106 MODULE PROCEDURE lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi 92 107 END INTERFACE 108 93 109 ! 94 110 INTERFACE lbc_bdy_lnk … … 104 120 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 105 121 PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions 106 122 107 123 !!---------------------------------------------------------------------- 108 124 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 327 343 # undef ROUTINE_LOAD 328 344 # undef DIM_4d 345 346 #ifdef BULL_ASYNC 347 #define ASYNC 348 # define DIM_2d 349 # define ROUTINE_MULTI lbc_lnk_2d_multi_async 350 # define ROUTINE_LOAD load_ptr_2d_async 351 # include "lbc_lnk_multi_generic.h90" 352 # undef ROUTINE_MULTI 353 # undef ROUTINE_LOAD 354 # undef DIM_2d 355 356 357 # define DIM_3d 358 # define ROUTINE_MULTI lbc_lnk_3d_multi_async 359 # define ROUTINE_LOAD load_ptr_3d_async 360 # include "lbc_lnk_multi_generic.h90" 361 # undef ROUTINE_MULTI 362 # undef ROUTINE_LOAD 363 # undef DIM_3d 364 365 366 # define DIM_4d 367 # define ROUTINE_MULTI lbc_lnk_4d_multi_async 368 # define ROUTINE_LOAD load_ptr_4d_async 369 # include "lbc_lnk_multi_generic.h90" 370 # undef ROUTINE_MULTI 371 # undef ROUTINE_LOAD 372 # undef DIM_4d 373 374 #undef ASYNC 375 #endif 329 376 330 377 SUBROUTINE simulated_lbc_lnk () -
NEMO/branches/2018/dev_r9759_HPC09_ESIWACE/src/OCE/LBC/lib_mpp.F90
r9814 r10136 72 72 PUBLIC mpp_lnk_2d_ptr, mpp_lnk_3d_ptr, mpp_lnk_4d_ptr 73 73 ! 74 #ifdef BULL_ASYNC 75 ! Interface associated to the mpp_lnk_... routines is defined in lbclnk 76 PUBLIC mpp_lnk_2d_async , mpp_lnk_3d_async , mpp_lnk_4d_async 77 PUBLIC mpp_lnk_2d_ptr_async, mpp_lnk_3d_ptr_async, mpp_lnk_4d_ptr_async 78 #endif 74 79 !!gm this should be useless 75 80 PUBLIC mpp_nfd_2d , mpp_nfd_3d , mpp_nfd_4d … … 270 275 WRITE(ldtxt(ii),*) ' bad value for cn_mpi_send = ', cn_mpi_send ; ii = ii + 1 271 276 kstop = kstop + 1 277 WRITE(*,*) ' bad value for cn_mpi_send = ', cn_mpi_send ; ii = ii + 1 272 278 END SELECT 273 279 ! … … 276 282 WRITE(ldtxt(ii),*) ' without calling MPI_Init before ! ' ; ii = ii + 1 277 283 kstop = kstop + 1 284 WRITE(*,*) ' lib_mpp: You cannot provide a local communicator ' ; ii = ii + 1 278 285 ELSE 279 286 SELECT CASE ( cn_mpi_send ) … … 292 299 WRITE(ldtxt(ii),*) ' bad value for cn_mpi_send = ', cn_mpi_send ; ii = ii + 1 293 300 kstop = kstop + 1 301 WRITE(*,*) ' bad value for cn_mpi_send = ', cn_mpi_send ; ii = ii + 1 294 302 END SELECT 295 303 ! … … 383 391 # undef MULTI 384 392 # undef DIM_4d 393 394 #ifdef BULL_ASYNC 395 # define ASYNC 396 397 #if (defined BULL_MPI_DATATYPE || defined BULL_MPI_DATATYPE_SUBARRAY) 398 # define MPI_DATATYPE_SUBARRAY 399 #warning "MPI_DATATYPE_SUBARRAY" 400 #ifdef BULL_MPI_DATATYPE_VECTOR 401 #undef MPI_DATATYPE_VECTOR 402 #warning "BULL_MPI_DATATYPE_SUBARRAY and BULL_MPI_DATATYPE_VECTOR are defined: undef BULL_MPI_DATATYPE_VECTOR" 403 #endif 404 #endif 405 #ifdef BULL_MPI_DATATYPE_VECTOR 406 # define MPI_DATATYPE_VECTOR 407 #warning "MPI_DATATYPE_VECTOR" 408 #endif 409 !!---------------------------------------------------------------------- 410 !! *** routine mpp_lnk_(2,3,4)d *** 411 !! 412 !! * Argument : dummy argument use in mpp_lnk_... routines 413 !! ptab : array or pointer of arrays on which the boundary condition is applied 414 !! cd_nat : nature of array grid-points 415 !! psgn : sign used across the north fold boundary 416 !! kfld : optional, number of pt3d arrays 417 !! cd_mpp : optional, fill the overlap area only 418 !! pval : optional, background value (used at closed boundaries) 419 !!---------------------------------------------------------------------- 420 ! 421 ! !== 2D array and array of 2D pointer ==! 422 ! 423 # define DIM_2d 424 # define ROUTINE_LNK mpp_lnk_2d_async 425 # include "mpp_lnk_generic.h90" 426 # undef ROUTINE_LNK 427 # define MULTI 428 # define ROUTINE_LNK mpp_lnk_2d_ptr_async 429 # include "mpp_lnk_generic.h90" 430 # undef ROUTINE_LNK 431 # undef MULTI 432 # undef DIM_2d 433 ! 434 ! !== 3D array and array of 3D pointer ==! 435 ! 436 # define DIM_3d 437 # define ROUTINE_LNK mpp_lnk_3d_async 438 # include "mpp_lnk_generic.h90" 439 # undef ROUTINE_LNK 440 # define MULTI 441 # define ROUTINE_LNK mpp_lnk_3d_ptr_async 442 # include "mpp_lnk_generic.h90" 443 # undef ROUTINE_LNK 444 # undef MULTI 445 # undef DIM_3d 446 ! 447 ! !== 4D array and array of 4D pointer ==! 448 ! 449 # define DIM_4d 450 # define ROUTINE_LNK mpp_lnk_4d_async 451 # include "mpp_lnk_generic.h90" 452 # undef ROUTINE_LNK 453 # define MULTI 454 # define ROUTINE_LNK mpp_lnk_4d_ptr_async 455 # include "mpp_lnk_generic.h90" 456 # undef ROUTINE_LNK 457 # undef MULTI 458 # undef DIM_4d 459 460 #undef ASYNC 461 #undef MPI_DATATYPE 462 #endif 385 463 386 464 !!---------------------------------------------------------------------- -
NEMO/branches/2018/dev_r9759_HPC09_ESIWACE/src/OCE/LBC/mpp_lnk_generic.h90
r9844 r10136 1 1 #if defined MULTI 2 # define NAT_IN(k) cd_nat(k) 2 # define NAT_IN(k) cd_nat(k) 3 3 # define SGN_IN(k) psgn(k) 4 4 # define F_SIZE(ptab) kfld … … 9 9 # define K_SIZE(ptab) 1 10 10 # define L_SIZE(ptab) 1 11 # define _INDEX(i,j,k,l) (i+((j)+((0)+(0)*ipk)*jpj)*jpi) 11 12 # endif 12 13 # if defined DIM_3d … … 15 16 # define K_SIZE(ptab) SIZE(ptab(1)%pt3d,3) 16 17 # define L_SIZE(ptab) 1 18 # define _INDEX(i,j,k,l) (i+((j)+((k)+(0)*ipk)*jpj)*jpi) 17 19 # endif 18 20 # if defined DIM_4d … … 21 23 # define K_SIZE(ptab) SIZE(ptab(1)%pt4d,3) 22 24 # define L_SIZE(ptab) SIZE(ptab(1)%pt4d,4) 25 # define _INDEX(i,j,k,l) (i+((j)+((k)+(l)*ipk)*jpj)*jpi) 23 26 # endif 24 27 #else … … 27 30 # define SGN_IN(k) psgn 28 31 # define F_SIZE(ptab) 1 29 # define OPT_K(k) 32 # define OPT_K(k) 30 33 # if defined DIM_2d 31 34 # define ARRAY_IN(i,j,k,l,f) ptab(i,j) 32 35 # define K_SIZE(ptab) 1 33 36 # define L_SIZE(ptab) 1 37 # define _INDEX(i,j,k,l) (i+((j)+((0)+(0)*ipk)*jpj)*jpi) 34 38 # endif 35 39 # if defined DIM_3d … … 37 41 # define K_SIZE(ptab) SIZE(ptab,3) 38 42 # define L_SIZE(ptab) 1 43 # define _INDEX(i,j,k,l) (i+((j)+((k)+(0)*ipk)*jpj)*jpi) 39 44 # endif 40 45 # if defined DIM_4d … … 42 47 # define K_SIZE(ptab) SIZE(ptab,3) 43 48 # define L_SIZE(ptab) SIZE(ptab,4) 49 # define _INDEX(i,j,k,l) (i+((j)+((k)+(l)*ipk)*jpj)*jpi) 44 50 # endif 45 51 #endif 46 52 47 53 #if defined MULTI 48 SUBROUTINE ROUTINE_LNK( rname, ptab, cd_nat, psgn, kfld, cd_mpp, pval ) 54 #if defined ASYNC 55 SUBROUTINE ROUTINE_LNK( rname, ptab, cd_nat, psgn, loop_fct, kfld, cd_mpp, pval ) 49 56 INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays 50 57 #else 51 SUBROUTINE ROUTINE_LNK( rname, ptab, cd_nat, psgn , cd_mpp, pval ) 58 SUBROUTINE ROUTINE_LNK( rname, ptab, cd_nat, psgn , kfld, cd_mpp, pval ) 59 INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays 60 #endif 61 #else 62 #if defined ASYNC 63 SUBROUTINE ROUTINE_LNK( rname, ptab, cd_nat, psgn, loop_fct, cd_mpp, pval ) 64 #else 65 SUBROUTINE ROUTINE_LNK( rname, ptab, cd_nat, psgn, cd_mpp, pval ) 66 #endif 67 #endif 68 #ifdef SCOREP_USER_ENABLE 69 #include "scorep/SCOREP_User.inc" 70 #else 71 #define SCOREP_USER_REGION_BEGIN ! 72 #define SCOREP_USER_REGION_END ! 52 73 #endif 53 74 ARRAY_TYPE(:,:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied … … 56 77 CHARACTER(len=3), OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only 57 78 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries) 79 #ifdef ASYNC 80 interface 81 subroutine loop_fct(i0, i1, j0, j1, k0, k1, buf) 82 integer, intent(in) :: i0, i1, j0, j1, k0, k1 83 ! @BULL_FIXME 84 ! lib_mpp.f90(4209): error #6683: A kind type parameter must be a compile-time constant. [WP] 85 ! REAL(wp), dimension(:), optional, intent(out) :: buf 86 REAL*8, dimension(:,:,:,:,:,:), optional, intent(out) :: buf 87 end subroutine loop_fct 88 end interface 89 #endif 58 90 CHARACTER(len=*), INTENT(in ) :: rname ! name of the calling subroutine 59 91 ! … … 66 98 REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! north-south & south-north halos 67 99 REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! east -west & west - east halos 100 #ifdef ASYNC 101 integer :: iflag, i 102 logical :: finished 103 #if (defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 104 integer :: ml_reqs(8,F_SIZE(ptab)) 105 #else 106 integer :: ml_reqs(8) 107 #endif 108 #endif 109 #ifdef SCOREP_USER_ENABLE 110 integer :: ier 111 SCOREP_USER_REGION_DEFINE( reg_cb ) 112 SCOREP_USER_REGION_DEFINE( reg_cbWhole ) 113 SCOREP_USER_REGION_DEFINE( reg_cbWE ) 114 SCOREP_USER_REGION_DEFINE( reg_cbNS ) 115 SCOREP_USER_REGION_DEFINE( reg_cbCenter ) 116 SCOREP_USER_REGION_DEFINE( reg_pack ) 117 SCOREP_USER_REGION_DEFINE( reg_unpack ) 118 #if (defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 119 SCOREP_USER_REGION_DEFINE( reg_datatype ) 120 #endif 121 #endif 122 #ifdef MPI_DATATYPE_VECTOR 123 integer :: type_ns, type_ew 124 #endif 125 #ifdef MPI_DATATYPE_SUBARRAY 126 integer :: ndims 127 integer, dimension(4) :: array_of_sizes 128 integer, dimension(4) :: array_of_subsizes 129 integer, dimension(4) :: array_of_starts 130 integer :: type_north_halo, type_north_ghost 131 integer :: type_south_halo, type_south_ghost 132 integer :: type_west_halo, type_west_ghost 133 integer :: type_east_halo, type_east_ghost 134 #endif 135 real*8 :: t0 136 real*8, save :: time=0.0 137 138 #ifdef ASYNC 139 ml_reqs = MPI_REQUEST_NULL 140 #endif 68 141 !!---------------------------------------------------------------------- 69 142 ! … … 72 145 ipf = F_SIZE(ptab) ! 5th - use in "multi" case (array of pointers) 73 146 ! 147 #if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 74 148 ALLOCATE( zt3ns(jpi,nn_hls,ipk,ipl,ipf,2), zt3sn(jpi,nn_hls,ipk,ipl,ipf,2), & 75 149 & zt3ew(jpj,nn_hls,ipk,ipl,ipf,2), zt3we(jpj,nn_hls,ipk,ipl,ipf,2) ) 150 #endif 76 151 ! 77 152 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value … … 79 154 ENDIF 80 155 156 #ifndef ASYNC 81 157 ! ------------------------------- ! 82 158 ! standard boundary treatment ! ! CAUTION: semi-column notation is often impossible … … 133 209 ! we play with the neigbours AND the row number because of the periodicity 134 210 ! 211 SCOREP_USER_REGION_BEGIN( reg_pack, "pack", SCOREP_USER_REGION_TYPE_COMMON ) 135 212 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 136 213 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) … … 147 224 END DO 148 225 END SELECT 226 SCOREP_USER_REGION_END( reg_pack ) 149 227 ! 150 228 ! ! Migrations … … 210 288 iihom = nlci-nn_hls 211 289 ! 290 SCOREP_USER_REGION_BEGIN( reg_unpack, "unpack", SCOREP_USER_REGION_TYPE_COMMON ) 212 291 SELECT CASE ( nbondi ) 213 292 CASE ( -1 ) … … 243 322 END DO 244 323 END SELECT 324 SCOREP_USER_REGION_END( reg_unpack ) 245 325 246 326 ! 3. North and south directions … … 248 328 ! always closed : we play only with the neigbours 249 329 ! 330 SCOREP_USER_REGION_BEGIN( reg_pack, "pack", SCOREP_USER_REGION_TYPE_COMMON ) 250 331 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 251 332 ijhom = nlcj-nrecj … … 261 342 END DO 262 343 ENDIF 344 #ifdef SCOREP_USER_ENABLE 345 SCOREP_USER_REGION_END( reg_pack ) 346 #endif 263 347 ! 264 348 ! ! Migrations … … 271 355 ! 272 356 CALL tic_tac(.TRUE.) 273 ! 357 ! 274 358 SELECT CASE ( nbondj ) 275 359 CASE ( -1 ) … … 295 379 ! 296 380 ! ! Write Dirichlet lateral conditions 381 SCOREP_USER_REGION_BEGIN( reg_unpack, "unpack", SCOREP_USER_REGION_TYPE_COMMON ) 297 382 ijhom = nlcj-nn_hls 298 383 ! … … 330 415 END DO 331 416 END SELECT 332 417 SCOREP_USER_REGION_END( reg_unpack ) 418 #else 419 ! ASYNC implementation 420 421 ! prepare receptions 422 !SUBROUTINE mpprecv( ktyp, pmess, kbytes, ksource ) 423 !CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_source, ktyp, mpi_comm_oce, istatus, iflag ) 424 #ifdef MPI_DATATYPE_VECTOR 425 ! IF( ln_timing ) t0=MPI_Wtime() 426 SCOREP_USER_REGION_BEGIN( reg_datatype, "datatype vector", SCOREP_USER_REGION_TYPE_COMMON ) 427 ! int MPI_Type_vector(int count, 428 ! int blocklength, 429 ! int stride, 430 ! MPI_Datatype old_type, 431 ! MPI_Datatype *newtype_p) 432 #ifdef DIM_2d 433 ! NS 434 call MPI_Type_contiguous((jpi-2*nn_hls), MPI_DOUBLE_PRECISION, type_ns, iflag) 435 call MPI_Type_commit(type_ns, iflag) 436 ! EW 437 call MPI_Type_vector((jpj-2*nn_hls), nn_hls, jpi, MPI_DOUBLE_PRECISION, type_ew, iflag) 438 call MPI_Type_commit(type_ew, iflag) 439 #endif 440 # if (defined DIM_3d || defined DIM_4d) 441 ! NS 442 call MPI_Type_vector(nn_hls *ipk*ipl, (jpi-2*nn_hls), jpi*jpj, MPI_DOUBLE_PRECISION, type_ns, iflag) 443 call MPI_Type_commit(type_ns, iflag) 444 ! EW 445 call MPI_Type_vector( (jpj-2*nn_hls)*ipk*ipl, nn_hls , jpi, MPI_DOUBLE_PRECISION, type_ew, iflag) 446 call MPI_Type_commit(type_ew, iflag) 447 #endif 448 SCOREP_USER_REGION_END( reg_datatype ) 449 ! IF( ln_timing ) time=time+MPI_Wtime()-t0 450 ! IF( ln_timing ) write(*,*) 'timing datatype vector: ',time 451 452 DO jf = 1, ipf 453 SELECT CASE ( nbondi ) 454 CASE ( -1 ) 455 call mpi_irecv(ARRAY_IN(1,2,1,1,jf), 1, type_ew, noea, 8*jf+1, mpi_comm_oce, ml_reqs(1,jf), iflag) 456 CASE ( 0 ) 457 call mpi_irecv(ARRAY_IN(1,2,1,1,jf), 1, type_ew, noea, 8*jf+1, mpi_comm_oce, ml_reqs(1,jf), iflag) 458 call mpi_irecv(ARRAY_IN(jpi-nn_hls,2,1,1,jf), 1, type_ew, nowe, 8*jf+2, mpi_comm_oce, ml_reqs(2,jf), iflag) 459 CASE ( 1 ) 460 call mpi_irecv(ARRAY_IN(jpi-nn_hls,2,1,1,jf), 1, type_ew, nowe, 8*jf+2, mpi_comm_oce, ml_reqs(2,jf), iflag) 461 END SELECT 462 463 SELECT CASE ( nbondj ) 464 CASE ( -1 ) 465 call mpi_irecv(ARRAY_IN(2,jpj-nn_hls,1,1,jf), 1, type_ns, nono, 8*jf+3, mpi_comm_oce, ml_reqs(3,jf), iflag) 466 CASE ( 0 ) 467 call mpi_irecv(ARRAY_IN(2,jpj-nn_hls,1,1,jf), 1, type_ns, nono, 8*jf+3, mpi_comm_oce, ml_reqs(3,jf), iflag) 468 call mpi_irecv(ARRAY_IN(2,1,1,1,jf), 1, type_ns, noso, 8*jf+4, mpi_comm_oce, ml_reqs(4,jf), iflag) 469 CASE ( 1 ) 470 call mpi_irecv(ARRAY_IN(2,1,1,1,jf), 1, type_ns, noso, 8*jf+4, mpi_comm_oce, ml_reqs(4,jf), iflag) 471 END SELECT 472 end do 473 #endif 474 475 #ifdef MPI_DATATYPE_SUBARRAY 476 IF( ln_timing ) CALL timing_start('datatype subarray') 477 SCOREP_USER_REGION_BEGIN( reg_datatype, "datatype", SCOREP_USER_REGION_TYPE_COMMON ) 478 479 array_of_sizes = (/ jpi, jpj, ipk, ipl /) 480 array_of_subsizes(3:4) = (/ ipk, ipl /) 481 array_of_starts(3:4) = 0 482 # if defined DIM_2d 483 ndims = 2 484 # endif 485 # if defined DIM_3d 486 ndims = 3 487 # endif 488 # if defined DIM_4d 489 ndims = 4 490 # endif 491 ! ------------------------------- ! 492 ! East and west exchange ! 493 ! ------------------------------- ! 494 array_of_subsizes(1:2) = (/ nn_hls, jpj-2*nn_hls /) 495 496 array_of_starts(1:2) = (/ 1, 1 /) ! zero indexing (as in C) 497 call MPI_Type_create_subarray( ndims, array_of_sizes, array_of_subsizes, array_of_starts, MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, type_west_halo, iflag) 498 call MPI_Type_commit(type_west_halo, iflag) 499 array_of_starts(1:2) = (/ 0, 1 /) ! zero indexing (as in C) 500 call MPI_Type_create_subarray( ndims, array_of_sizes, array_of_subsizes, array_of_starts, MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, type_west_ghost, iflag) 501 call MPI_Type_commit(type_west_ghost, iflag) 502 503 array_of_starts(1:2) = (/ jpi-1-nn_hls, 1 /) ! zero indexing (as in C) 504 call MPI_Type_create_subarray( ndims, array_of_sizes, array_of_subsizes, array_of_starts, MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, type_east_halo, iflag) 505 call MPI_Type_commit(type_east_halo, iflag) 506 array_of_starts(1:2) = (/ jpi-nn_hls, 1 /) ! zero indexing (as in C) 507 call MPI_Type_create_subarray( ndims, array_of_sizes, array_of_subsizes, array_of_starts, MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, type_east_ghost, iflag) 508 call MPI_Type_commit(type_east_ghost, iflag) 509 510 ! ------------------------------- ! 511 ! North and south exchange ! 512 ! ------------------------------- ! 513 array_of_subsizes(1:2) = (/ jpi-2*nn_hls, nn_hls /) 514 515 array_of_starts(1:2) = (/ 1, 1 /) ! zero indexing (as in C) 516 call MPI_Type_create_subarray( ndims, array_of_sizes, array_of_subsizes, array_of_starts, MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, type_south_halo, iflag) 517 call MPI_Type_commit(type_south_halo, iflag) 518 array_of_starts(1:2) = (/ 1, 0 /) ! zero indexing (as in C) 519 call MPI_Type_create_subarray( ndims, array_of_sizes, array_of_subsizes, array_of_starts, MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, type_south_ghost, iflag) 520 call MPI_Type_commit(type_south_ghost, iflag) 521 522 array_of_starts(1:2) = (/ 1, jpj-1-nn_hls /) ! zero indexing (as in C) 523 call MPI_Type_create_subarray( ndims, array_of_sizes, array_of_subsizes, array_of_starts, MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, type_north_halo, iflag) 524 call MPI_Type_commit(type_north_halo, iflag) 525 array_of_starts(1:2) = (/ 1, jpj-nn_hls /) ! zero indexing (as in C) 526 call MPI_Type_create_subarray( ndims, array_of_sizes, array_of_subsizes, array_of_starts, MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, type_north_ghost, iflag) 527 call MPI_Type_commit(type_north_ghost, iflag) 528 #ifdef SCOREP_USER_ENABLE 529 SCOREP_USER_REGION_END( reg_datatype ) 530 #endif 531 IF( ln_timing ) CALL timing_stop('datatype subarray') 532 533 DO jf = 1, ipf 534 SELECT CASE ( nbondi ) 535 CASE ( -1 ) 536 call mpi_irecv(ARRAY_IN(:,:,:,:,jf), 1, type_east_ghost, noea, 8*jf+1, mpi_comm_oce, ml_reqs(1,jf), iflag) 537 CASE ( 0 ) 538 call mpi_irecv(ARRAY_IN(:,:,:,:,jf), 1, type_east_ghost, noea, 8*jf+1, mpi_comm_oce, ml_reqs(1,jf), iflag) 539 call mpi_irecv(ARRAY_IN(:,:,:,:,jf), 1, type_west_ghost, nowe, 8*jf+2, mpi_comm_oce, ml_reqs(2,jf), iflag) 540 CASE ( 1 ) 541 call mpi_irecv(ARRAY_IN(:,:,:,:,jf), 1, type_west_ghost, nowe, 8*jf+2, mpi_comm_oce, ml_reqs(2,jf), iflag) 542 END SELECT 543 544 SELECT CASE ( nbondj ) 545 CASE ( -1 ) 546 call mpi_irecv(ARRAY_IN(:,:,:,:,jf), 1, type_north_ghost, nono, 8*jf+3, mpi_comm_oce, ml_reqs(3,jf), iflag) 547 CASE ( 0 ) 548 call mpi_irecv(ARRAY_IN(:,:,:,:,jf), 1, type_north_ghost, nono, 8*jf+3, mpi_comm_oce, ml_reqs(3,jf), iflag) 549 call mpi_irecv(ARRAY_IN(:,:,:,:,jf), 1, type_south_ghost, noso, 8*jf+4, mpi_comm_oce, ml_reqs(4,jf), iflag) 550 CASE ( 1 ) 551 call mpi_irecv(ARRAY_IN(:,:,:,:,jf), 1, type_south_ghost, noso, 8*jf+4, mpi_comm_oce, ml_reqs(4,jf), iflag) 552 END SELECT 553 end do 554 #endif 555 #if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 556 ! ! Migrations 557 imigr = nn_hls * jpj * ipk * ipl * ipf 558 ! 559 SELECT CASE ( nbondi ) 560 CASE ( -1 ) 561 call mpi_irecv(zt3ew(1,1,1,1,1,2), imigr, MPI_DOUBLE_PRECISION, noea, 1, mpi_comm_oce, ml_reqs(1), iflag) 562 CASE ( 0 ) 563 call mpi_irecv(zt3ew(1,1,1,1,1,2), imigr, MPI_DOUBLE_PRECISION, noea, 1, mpi_comm_oce, ml_reqs(1), iflag) 564 call mpi_irecv(zt3we(1,1,1,1,1,2), imigr, MPI_DOUBLE_PRECISION, nowe, 2, mpi_comm_oce, ml_reqs(2), iflag) 565 CASE ( 1 ) 566 call mpi_irecv(zt3we(1,1,1,1,1,2), imigr, MPI_DOUBLE_PRECISION, nowe, 2, mpi_comm_oce, ml_reqs(2), iflag) 567 END SELECT 568 569 imigr = nn_hls * jpi * ipk * ipl * ipf 570 SELECT CASE ( nbondj ) 571 CASE ( -1 ) 572 call mpi_irecv(zt3ns(1,1,1,1,1,2), imigr, MPI_DOUBLE_PRECISION, nono, 3, mpi_comm_oce, ml_reqs(3), iflag) 573 CASE ( 0 ) 574 call mpi_irecv(zt3ns(1,1,1,1,1,2), imigr, MPI_DOUBLE_PRECISION, nono, 3, mpi_comm_oce, ml_reqs(3), iflag) 575 call mpi_irecv(zt3sn(1,1,1,1,1,2), imigr, MPI_DOUBLE_PRECISION, noso, 4, mpi_comm_oce, ml_reqs(4), iflag) 576 CASE ( 1 ) 577 call mpi_irecv(zt3sn(1,1,1,1,1,2), imigr, MPI_DOUBLE_PRECISION, noso, 4, mpi_comm_oce, ml_reqs(4), iflag) 578 END SELECT 579 #endif 580 581 ! compute West 582 #define TI 1 583 #define TJ 1 584 585 #define I0 2 586 #define I1 jpi-1 587 #define J0 2 588 #define J1 jpj-1 589 590 #define FULL_ROWS (I0 == 2 && I1 == jpi-1) 591 #define FULL_COLUMNS (J0 == 2 && J1 == jpi-1) 592 #define WHOLE_RANGE (FULL_ROWS && FULL_COLUMNS) 593 594 #if (FULL_ROWS && FULL_COLUMNS) 595 #warning "BULL: lib_mpp will compute whole cb " 596 SCOREP_USER_REGION_BEGIN( reg_cb, "cb", SCOREP_USER_REGION_TYPE_COMMON ) 597 SCOREP_USER_REGION_BEGIN( reg_cbWhole, "cb whole", SCOREP_USER_REGION_TYPE_COMMON ) 598 call loop_fct( I0, I1 & 599 , J0, J1 & ! stand for 3,jpjm2 600 , 1, jpkm1 & ! TODO check if always jpkm1 601 ) 602 SCOREP_USER_REGION_END( reg_cbWhole ) 603 SCOREP_USER_REGION_END( reg_cb ) 604 #endif 605 606 #if !FULL_COLUMNS 607 #warning "BULL: lib_mpp will compute cb S" 608 SCOREP_USER_REGION_BEGIN( reg_cb, "cb", SCOREP_USER_REGION_TYPE_COMMON ) 609 SCOREP_USER_REGION_BEGIN( reg_cbNS, "cbns", SCOREP_USER_REGION_TYPE_COMMON ) 610 ! asynchrously send South 611 call loop_fct( I0, I1 & 612 , J0-1, J0-1 & 613 , 1, jpkm1 & ! TODO check if always jpkm1 614 ) 615 SCOREP_USER_REGION_END( reg_cbNS ) 616 SCOREP_USER_REGION_END( reg_cb ) 617 #endif 618 ! 3. South directions 619 ! ----------------------------- 620 SCOREP_USER_REGION_BEGIN( reg_pack, "pack", SCOREP_USER_REGION_TYPE_COMMON ) 621 #ifdef MPI_DATATYPE_SUBARRAY 622 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 623 CASE ( 0, 1 ) ! all exept 2 (i.e. close case) 624 DO jf = 1, ipf 625 #ifdef BULL_ISEND 626 call mpi_isend(ARRAY_IN(:,:,:,:,jf), 1, type_south_halo, noso, 8*jf+3, mpi_comm_oce, ml_reqs(4+3,jf), iflag) 627 #else 628 call mpi_send(ARRAY_IN(:,:,:,:,jf), 1, type_south_halo, noso, 8*jf+3, mpi_comm_oce, iflag) 629 #endif 630 END DO 631 END SELECT 632 #elif (defined MPI_DATATYPE_VECTOR) 633 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 634 CASE ( 0, 1 ) ! all exept 2 (i.e. close case) 635 DO jf = 1, ipf 636 #ifdef BULL_ISEND 637 call mpi_isend(ARRAY_IN(2,2,1,1,jf), 1, type_ns, noso, 8*jf+3, mpi_comm_oce, ml_reqs(4+3,jf), iflag) 638 #else 639 call mpi_send(ARRAY_IN(2,2,1,1,jf), 1, type_ns, noso, 8*jf+3, mpi_comm_oce, iflag) 640 #endif 641 END DO 642 END SELECT 643 #else 644 ! always closed : we play only with the neigbours 645 ! 646 imigr = nn_hls * jpi * ipk * ipl * ipf 647 SELECT CASE ( nbondj ) ! Read Dirichlet lateral conditions 648 CASE ( 0, 1 ) ! all exept 2 (i.e. close case) 649 ijhom = nlcj-nrecj 650 DO jf = 1, ipf 651 DO jl = 1, ipl 652 DO jk = 1, ipk 653 DO jh = 1, nn_hls 654 zt3ns(:,jh,jk,jl,jf,1) = ARRAY_IN(:,nn_hls+jh,jk,jl,jf) 655 END DO 656 END DO 657 END DO 658 END DO 659 call mpi_isend(zt3ns(1,1,1,1,1,1), imigr, MPI_DOUBLE_PRECISION, noso, 3, mpi_comm_oce, ml_reqs(4+3), iflag) 660 END SELECT 661 #endif 662 SCOREP_USER_REGION_END( reg_pack ) 663 664 ! progress all previous operations 665 #if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 666 call MPI_Testall(8, ml_reqs, finished, MPI_STATUSES_IGNORE, iflag) 667 #else 668 call MPI_Testall(8*ipf, ml_reqs, finished, MPI_STATUSES_IGNORE, iflag) 669 #endif 670 671 ! compute North 672 #if !FULL_COLUMNS 673 #warning "BULL: lib_mpp will compute cb N" 674 SCOREP_USER_REGION_BEGIN( reg_cb, "cb", SCOREP_USER_REGION_TYPE_COMMON ) 675 SCOREP_USER_REGION_BEGIN( reg_cbNS, "cbns", SCOREP_USER_REGION_TYPE_COMMON ) 676 call loop_fct( I0, I1 & 677 , J1+1, J1+1 & 678 , 1, jpkm1 & ! TODO check if always jpkm1 679 ) 680 SCOREP_USER_REGION_END( reg_cbNS ) 681 SCOREP_USER_REGION_END( reg_cb ) 682 #endif 683 ! 3. North directions 684 ! ----------------------------- 685 SCOREP_USER_REGION_BEGIN( reg_pack, "pack", SCOREP_USER_REGION_TYPE_COMMON ) 686 #ifdef MPI_DATATYPE_SUBARRAY 687 ! always closed : we play only with the neigbours 688 689 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 690 CASE ( -1, 0 ) ! all exept 2 (i.e. close case) 691 DO jf = 1, ipf 692 #ifdef BULL_ISEND 693 call mpi_isend(ARRAY_IN(:,:,:,:,jf), 1, type_north_halo, nono, 8*jf+4, mpi_comm_oce, ml_reqs(4+4,jf), iflag) 694 #else 695 call mpi_send(ARRAY_IN(:,:,:,:,jf), 1, type_north_halo, nono, 8*jf+4, mpi_comm_oce, iflag) 696 #endif 697 END DO 698 END SELECT 699 #elif (defined MPI_DATATYPE_VECTOR) 700 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 701 CASE ( 0, 1 ) ! all exept 2 (i.e. close case) 702 DO jf = 1, ipf 703 #ifdef BULL_ISEND 704 call mpi_isend(ARRAY_IN(2,jpj-nn_hls,1,1,jf), 1, type_ns, nono, 8*jf+4, mpi_comm_oce, ml_reqs(4+3,jf), iflag) 705 #else 706 call mpi_send(ARRAY_IN(2,jpj-nn_hls,1,1,jf), 1, type_ns, nono, 8*jf+4, mpi_comm_oce, iflag) 707 #endif 708 END DO 709 END SELECT 710 #else 711 ! 712 imigr = nn_hls * jpi * ipk * ipl * ipf 713 SELECT CASE ( nbondj ) ! Read Dirichlet lateral conditions 714 CASE ( -1, 0 ) ! all exept 2 (i.e. close case) 715 ijhom = nlcj-nrecj ! jpj-2*nn_hls 716 DO jf = 1, ipf 717 DO jl = 1, ipl 718 DO jk = 1, ipk 719 DO jh = 1, nn_hls 720 zt3sn(:,jh,jk,jl,jf,1) = ARRAY_IN(:,ijhom +jh,jk,jl,jf) 721 END DO 722 END DO 723 END DO 724 END DO 725 call mpi_isend(zt3sn(1,1,1,1,1,1), imigr, MPI_DOUBLE_PRECISION, nono, 4, mpi_comm_oce, ml_reqs(4+4), iflag) 726 END SELECT 727 #endif 728 SCOREP_USER_REGION_END( reg_pack ) 729 730 ! progress all previous operations 731 #if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 732 call MPI_Testall(8, ml_reqs, finished, MPI_STATUSES_IGNORE, iflag) 733 #else 734 call MPI_Testall(8*ipf, ml_reqs, finished, MPI_STATUSES_IGNORE, iflag) 735 #endif 736 737 #if !FULL_ROWS 738 #warning "BULL: lib_mpp will compute cb W" 739 SCOREP_USER_REGION_BEGIN( reg_cb, "cb", SCOREP_USER_REGION_TYPE_COMMON ) 740 SCOREP_USER_REGION_BEGIN( reg_cbWE, "cbew", SCOREP_USER_REGION_TYPE_COMMON ) 741 call loop_fct( I0-1, I0-1 & 742 , J0, J1 & ! stand for 3,jpjm2 743 , 1, jpkm1 & ! TODO check if always jpkm1 744 ) 745 SCOREP_USER_REGION_END( reg_cbWE ) 746 SCOREP_USER_REGION_END( reg_cb ) 747 #endif 748 ! ------------------------------- ! 749 ! West exchange ! 750 ! ------------------------------- ! 751 SCOREP_USER_REGION_BEGIN( reg_pack, "pack", SCOREP_USER_REGION_TYPE_COMMON ) 752 #ifdef MPI_DATATYPE_SUBARRAY 753 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 754 CASE ( 0, 1 ) ! all exept 2 (i.e. close case) 755 DO jf = 1, ipf 756 #ifdef BULL_ISEND 757 call mpi_isend(ARRAY_IN(:,:,:,:,jf), 1, type_west_halo, nowe, 8*jf+1, mpi_comm_oce, ml_reqs(4+1,jf), iflag) 758 #else 759 call mpi_send(ARRAY_IN(:,:,:,:,jf), 1, type_west_halo, nowe, 8*jf+1, mpi_comm_oce, iflag) 760 #endif 761 END DO 762 END SELECT 763 #elif (defined MPI_DATATYPE_VECTOR) 764 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 765 CASE ( 0, 1 ) ! all exept 2 (i.e. close case) 766 DO jf = 1, ipf 767 #ifdef BULL_ISEND 768 call mpi_isend(ARRAY_IN(2,2,1,1,jf), 1, type_ew, nowe, 8*jf+1, mpi_comm_oce, ml_reqs(4+3,jf), iflag) 769 #else 770 call mpi_send(ARRAY_IN(2,2,1,1,jf), 1, type_ew, nowe, 8*jf+1, mpi_comm_oce, iflag) 771 #endif 772 END DO 773 END SELECT 774 #else 775 ! we play with the neigbours AND the row number because of the periodicity 776 ! 777 imigr = nn_hls * jpj * ipk * ipl * ipf 778 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 779 CASE ( 0, 1 ) ! all exept 2 (i.e. close case) 780 DO jf = 1, ipf 781 DO jl = 1, ipl 782 DO jk = 1, ipk 783 DO jh = 1, nn_hls 784 zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf) 785 END DO 786 END DO 787 END DO 788 END DO 789 call mpi_isend(zt3ew(1,1,1,1,1,1), imigr, MPI_DOUBLE_PRECISION, nowe, 1, mpi_comm_oce, ml_reqs(4+1), iflag) 790 END SELECT 791 #endif 792 SCOREP_USER_REGION_END( reg_pack ) 793 794 ! progress all previous operations 795 #if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 796 call MPI_Testall(8, ml_reqs, finished, MPI_STATUSES_IGNORE, iflag) 797 #else 798 call MPI_Testall(8*ipf, ml_reqs, finished, MPI_STATUSES_IGNORE, iflag) 799 #endif 800 801 ! compute East 802 #if !FULL_ROWS 803 #warning "BULL: lib_mpp will compute cb E" 804 SCOREP_USER_REGION_BEGIN( reg_cb, "cb", SCOREP_USER_REGION_TYPE_COMMON ) 805 SCOREP_USER_REGION_BEGIN( reg_cbWE, "cbew", SCOREP_USER_REGION_TYPE_COMMON ) 806 call loop_fct( I1+1, I1+1 & 807 , J0, J1 & ! stand for 3,jpjm2 808 , 1, jpkm1 & ! TODO check if always jpkm1 809 ) 810 SCOREP_USER_REGION_END( reg_cbWE ) 811 SCOREP_USER_REGION_END( reg_cb ) 812 #endif 813 ! ------------------------------- ! 814 ! East exchange ! 815 ! ------------------------------- ! 816 SCOREP_USER_REGION_BEGIN( reg_pack, "pack", SCOREP_USER_REGION_TYPE_COMMON ) 817 #ifdef MPI_DATATYPE_SUBARRAY 818 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 819 CASE ( -1, 0 ) ! all exept 2 (i.e. close case) 820 DO jf = 1, ipf 821 #ifdef BULL_ISEND 822 call mpi_isend(ARRAY_IN(:,:,:,:,jf), 1, type_east_halo, noea, 8*jf+2, mpi_comm_oce, ml_reqs(4+2,jf), iflag) 823 #else 824 call mpi_send(ARRAY_IN(:,:,:,:,jf), 1, type_east_halo, noea, 8*jf+2, mpi_comm_oce, iflag) 825 #endif 826 END DO 827 END SELECT 828 #elif (defined MPI_DATATYPE_VECTOR) 829 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 830 CASE ( 0, 1 ) ! all exept 2 (i.e. close case) 831 DO jf = 1, ipf 832 #ifdef BULL_ISEND 833 call mpi_isend(ARRAY_IN(jpi-nn_hls,2,1,1,jf), 1, type_ew, noea, 8*jf+2, mpi_comm_oce, ml_reqs(4+3,jf), iflag) 834 #else 835 call mpi_send(ARRAY_IN(jpi-nn_hls,2,1,1,jf), 1, type_ew, noea, 8*jf+2, mpi_comm_oce, iflag) 836 #endif 837 END DO 838 END SELECT 839 #else 840 ! we play with the neigbours AND the row number because of the periodicity 841 ! 842 imigr = nn_hls * jpj * ipk * ipl * ipf 843 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 844 CASE ( -1, 0 ) ! all exept 2 (i.e. close case) 845 iihom = nlci-nreci ! jpi-2*nn_hls 846 DO jf = 1, ipf 847 DO jl = 1, ipl 848 DO jk = 1, ipk 849 DO jh = 1, nn_hls 850 zt3we(:,jh,jk,jl,jf,1) = ARRAY_IN(iihom +jh,:,jk,jl,jf) 851 END DO 852 END DO 853 END DO 854 END DO 855 call mpi_isend(zt3we(1,1,1,1,1,1), imigr, MPI_DOUBLE_PRECISION, noea, 2, mpi_comm_oce, ml_reqs(4+2), iflag) 856 END SELECT 857 #endif 858 SCOREP_USER_REGION_END( reg_pack ) 859 860 ! progress all previous operations 861 #if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 862 call MPI_Testall(8, ml_reqs, finished, MPI_STATUSES_IGNORE, iflag) 863 #else 864 call MPI_Testall(8*ipf, ml_reqs, finished, MPI_STATUSES_IGNORE, iflag) 865 #endif 866 867 ! compute Inner 868 #if !(FULL_ROWS && FULL_COLUMNS) 869 #warning "BULL: lib_mpp will compute inner cb" 870 SCOREP_USER_REGION_BEGIN( reg_cb, "cb", SCOREP_USER_REGION_TYPE_COMMON ) 871 SCOREP_USER_REGION_BEGIN( reg_cbCenter, "cbcenter", SCOREP_USER_REGION_TYPE_COMMON ) 872 call loop_fct( I0, I1 & 873 , J0, J1 & ! stand for 3,jpjm2 874 , 1, jpkm1 & ! TODO check if always jpkm1 875 ) 876 SCOREP_USER_REGION_END( reg_cbCenter ) 877 SCOREP_USER_REGION_END( reg_cb ) 878 #endif 879 880 ! ------------------------------- ! 881 ! standard boundary treatment ! ! CAUTION: semi-column notation is often impossible 882 ! ------------------------------- ! 883 ! 884 IF( PRESENT( cd_mpp ) ) THEN !== halos filled with inner values ==! 885 ! 886 DO jf = 1, ipf ! number of arrays to be treated 887 ! 888 DO jl = 1, ipl ! CAUTION: ptab is defined only between nld and nle 889 DO jk = 1, ipk 890 DO jj = nlcj+1, jpj ! added line(s) (inner only) 891 ARRAY_IN(nldi :nlei ,jj,jk,jl,jf) = ARRAY_IN(nldi:nlei,nlej,jk,jl,jf) 892 ARRAY_IN(1 :nldi-1,jj,jk,jl,jf) = ARRAY_IN(nldi ,nlej,jk,jl,jf) 893 ARRAY_IN(nlei+1:nlci ,jj,jk,jl,jf) = ARRAY_IN( nlei,nlej,jk,jl,jf) 894 END DO 895 DO ji = nlci+1, jpi ! added column(s) (full) 896 ARRAY_IN(ji,nldj :nlej ,jk,jl,jf) = ARRAY_IN(nlei,nldj:nlej,jk,jl,jf) 897 ARRAY_IN(ji,1 :nldj-1,jk,jl,jf) = ARRAY_IN(nlei,nldj ,jk,jl,jf) 898 ARRAY_IN(ji,nlej+1:jpj ,jk,jl,jf) = ARRAY_IN(nlei, nlej,jk,jl,jf) 899 END DO 900 END DO 901 END DO 902 ! 903 END DO 904 ! 905 ELSE !== standard close or cyclic treatment ==! 906 ! 907 DO jf = 1, ipf ! number of arrays to be treated 908 ! 909 ! ! East-West boundaries 910 IF( l_Iperio ) THEN !* cyclic 911 ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf) 912 ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN( 2 ,:,:,:,jf) 913 ELSE !* closed 914 IF( .NOT. NAT_IN(jf) == 'F' ) ARRAY_IN( 1 :nn_hls,:,:,:,jf) = zland ! east except F-point 915 ARRAY_IN(nlci-nn_hls+1:jpi ,:,:,:,jf) = zland ! west 916 ENDIF 917 ! ! North-South boundaries 918 IF( l_Jperio ) THEN !* cyclic (only with no mpp j-split) 919 ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:, jpjm1,:,:,jf) 920 ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:, 2 ,:,:,jf) 921 ELSE !* closed 922 IF( .NOT. NAT_IN(jf) == 'F' ) ARRAY_IN(:, 1 :nn_hls,:,:,jf) = zland ! south except F-point 923 ARRAY_IN(:,nlcj-nn_hls+1:jpj ,:,:,jf) = zland ! north 924 ENDIF 925 END DO 926 ! 927 ENDIF 928 929 ! Wait for any reception (unpack?) 930 #if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 931 call MPI_Waitall(4, ml_reqs, MPI_STATUSES_IGNORE, iflag) 932 #endif 933 ! ! Write Dirichlet lateral conditions 934 #if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 935 SCOREP_USER_REGION_BEGIN( reg_unpack, "unpack", SCOREP_USER_REGION_TYPE_COMMON ) 936 iihom = nlci-nn_hls 937 ! 938 SELECT CASE ( nbondi ) 939 CASE ( -1 ) 940 DO jf = 1, ipf 941 DO jl = 1, ipl 942 DO jk = 1, ipk 943 DO jh = 1, nn_hls 944 ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2) 945 END DO 946 END DO 947 END DO 948 END DO 949 CASE ( 0 ) 950 DO jf = 1, ipf 951 DO jl = 1, ipl 952 DO jk = 1, ipk 953 DO jh = 1, nn_hls 954 ARRAY_IN(jh ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2) 955 ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2) 956 END DO 957 END DO 958 END DO 959 END DO 960 CASE ( 1 ) 961 DO jf = 1, ipf 962 DO jl = 1, ipl 963 DO jk = 1, ipk 964 DO jh = 1, nn_hls 965 ARRAY_IN(jh ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2) 966 END DO 967 END DO 968 END DO 969 END DO 970 END SELECT 971 ! ! Write Dirichlet lateral conditions 972 ijhom = nlcj-nn_hls 973 ! 974 SELECT CASE ( nbondj ) 975 CASE ( -1 ) 976 DO jf = 1, ipf 977 DO jl = 1, ipl 978 DO jk = 1, ipk 979 DO jh = 1, nn_hls 980 ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2) 981 END DO 982 END DO 983 END DO 984 END DO 985 CASE ( 0 ) 986 DO jf = 1, ipf 987 DO jl = 1, ipl 988 DO jk = 1, ipk 989 DO jh = 1, nn_hls 990 ARRAY_IN(:, jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2) 991 ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2) 992 END DO 993 END DO 994 END DO 995 END DO 996 CASE ( 1 ) 997 DO jf = 1, ipf 998 DO jl = 1, ipl 999 DO jk = 1, ipk 1000 DO jh = 1, nn_hls 1001 ARRAY_IN(:,jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2) 1002 END DO 1003 END DO 1004 END DO 1005 END DO 1006 END SELECT 1007 SCOREP_USER_REGION_END( reg_unpack ) 1008 #endif 1009 #endif 333 1010 ! 4. north fold treatment 334 1011 ! ----------------------- … … 343 1020 ENDIF 344 1021 ! 1022 #ifdef ASYNC 1023 ! wait all sending messages 1024 #if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 1025 call MPI_Waitall(4, ml_reqs(5), MPI_STATUSES_IGNORE, iflag) 1026 #else 1027 call MPI_Waitall(8*ipf, ml_reqs, MPI_STATUSES_IGNORE, iflag) 1028 #endif 1029 ! ! Write Dirichlet lateral conditions 1030 #ifdef MPI_DATATYPE_SUBARRAY 1031 SCOREP_USER_REGION_BEGIN( reg_datatype, "datatype", SCOREP_USER_REGION_TYPE_COMMON ) 1032 call MPI_Type_free(type_north_halo, iflag) 1033 call MPI_Type_free(type_south_halo, iflag) 1034 call MPI_Type_free(type_east_halo, iflag) 1035 call MPI_Type_free(type_west_halo, iflag) 1036 call MPI_Type_free(type_north_ghost, iflag) 1037 call MPI_Type_free(type_south_ghost, iflag) 1038 call MPI_Type_free(type_east_ghost, iflag) 1039 call MPI_Type_free(type_west_ghost, iflag) 1040 SCOREP_USER_REGION_END( reg_datatype ) 1041 #endif 1042 #ifdef MPI_DATATYPE_VECTOR 1043 SCOREP_USER_REGION_BEGIN( reg_datatype, "datatype vector", SCOREP_USER_REGION_TYPE_COMMON ) 1044 call MPI_Type_free(type_ew, iflag) 1045 call MPI_Type_free(type_ns, iflag) 1046 SCOREP_USER_REGION_END( reg_datatype ) 1047 #endif 1048 #endif 1049 #if !(defined MPI_DATATYPE_SUBARRAY || defined MPI_DATATYPE_VECTOR) 345 1050 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 1051 #endif 346 1052 ! 347 1053 END SUBROUTINE ROUTINE_LNK … … 355 1061 #undef F_SIZE 356 1062 #undef OPT_K 1063 #undef _INDEX -
NEMO/branches/2018/dev_r9759_HPC09_ESIWACE/src/OCE/TRA/traadv_fct.F90
r10103 r10136 27 27 USE lbclnk ! ocean lateral boundary condition (or mpp link) 28 28 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 29 USE timing ! Timing 29 30 30 31 IMPLICIT NONE … … 325 326 326 327 SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt ) 328 #ifdef SCOREP_USER_ENABLE 329 use mpi 330 #include "scorep/SCOREP_User.inc" 331 #endif 327 332 !!--------------------------------------------------------------------- 328 333 !! *** ROUTINE nonosc *** … … 346 351 REAL(wp) :: zau, zbu, zcu, zav, zbv, zcv, zup, zdo ! - - 347 352 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zbetup, zbetdo, zbup, zbdo 353 !dir$ attributes align:64 :: zbetup, zbetdo, zbup, zbdo 354 #ifdef SCOREP_USER_ENABLE 355 integer :: ier 356 SCOREP_USER_REGION_DEFINE( reg_nonosc ) 357 SCOREP_USER_REGION_DEFINE( reg_nonosc_setup ) 358 SCOREP_USER_REGION_DEFINE( reg_nonosc_cb1 ) 359 SCOREP_USER_REGION_DEFINE( reg_nonosc_cb2 ) 360 SCOREP_USER_REGION_DEFINE( reg_nonosc_barrier ) 361 SCOREP_USER_REGION_DEFINE( reg_nonosc_imbalance ) 362 363 SCOREP_USER_REGION_BEGIN( reg_nonosc_barrier, "nonosc barrier", SCOREP_USER_REGION_TYPE_COMMON ) 364 call MPI_Barrier(MPI_COMM_WORLD, ier) 365 SCOREP_USER_REGION_END( reg_nonosc_barrier ) 366 SCOREP_USER_REGION_BEGIN( reg_nonosc, "nonosc", SCOREP_USER_REGION_TYPE_FUNCTION ) 367 SCOREP_USER_REGION_BEGIN( reg_nonosc_setup, "nonosc setup", SCOREP_USER_REGION_TYPE_COMMON ) 368 #endif 369 IF( ln_timing ) CALL timing_start( 'nonosc' ) 348 370 !!---------------------------------------------------------------------- 349 371 ! 350 372 zbig = 1.e+40_wp 351 373 zrtrn = 1.e-15_wp 374 #ifndef BULL_NONOSC_INIT 352 375 zbetup(:,:,:) = 0._wp ; zbetdo(:,:,:) = 0._wp 376 #else 377 zbetup(:,:,jpk) = 0._wp ; zbetdo(:,:,jpk) = 0._wp 378 #endif 353 379 354 380 ! Search local extrema … … 360 386 & paft * tmask + zbig * ( 1._wp - tmask ) ) 361 387 388 #ifdef SCOREP_USER_ENABLE 389 SCOREP_USER_REGION_END( reg_nonosc_setup ) 390 #endif 391 392 #ifndef BULL_ASYNC 393 #ifdef SCOREP_USER_ENABLE 394 SCOREP_USER_REGION_BEGIN( reg_nonosc_cb1, "cb1", SCOREP_USER_REGION_TYPE_LOOP ) 395 #endif 396 ! loads: 397 ! - zbup: ji-1/ji/ji+1, jj-1/jj/jj+1, ji/jk+1/jk-1 398 ! - zbdo: " 399 ! - paa: ji-1/ji 400 ! - pbb: jj-1/jj 401 ! - pcc: ji, jj, jk/jk+1 402 ! - e1e2t, e3t_n, paft (*2): ji,jj,jk 403 ! 404 ! stores: 405 ! - zbetup 406 ! - zbetdo 362 407 DO jk = 1, jpkm1 363 408 ikm1 = MAX(jk-1,1) … … 394 439 END DO 395 440 END DO 441 #ifdef SCOREP_USER_ENABLE 442 SCOREP_USER_REGION_END( reg_nonosc_cb1 ) 443 #endif 396 444 CALL lbc_lnk_multi("traadv_fct",zbetup, 'T', 1. , zbetdo, 'T', 1. ) ! lateral boundary cond. (unchanged sign) 397 445 #else 446 call lbc_lnk_multi_async( "traadv_fct", cb1, zbetup, 'T', 1. , zbetdo, 'T', 1. ) ! lateral boundary cond. (unchanged sign) 447 #endif 448 449 #ifndef BULL_ASYNC 398 450 ! 3. monotonic flux in the i & j direction (paa & pbb) 399 451 ! ---------------------------------------- 452 #ifdef SCOREP_USER_ENABLE 453 SCOREP_USER_REGION_BEGIN( reg_nonosc_cb2, "cb2", SCOREP_USER_REGION_TYPE_LOOP ) 454 #endif 400 455 DO jk = 1, jpkm1 401 456 DO jj = 2, jpjm1 … … 420 475 END DO 421 476 END DO 477 #ifdef SCOREP_USER_ENABLE 478 SCOREP_USER_REGION_END( reg_nonosc_cb2 ) 479 #endif 422 480 CALL lbc_lnk_multi("traadv_fct",paa, 'U', -1. , pbb, 'V', -1. ) ! lateral boundary condition (changed sign) 423 ! 481 #else 482 call lbc_lnk_multi_async( "traadv_fct", cb2, paa, 'U', -1. , pbb, 'V', -1. ) ! lateral boundary condition (changed sign) 483 #endif 484 ! 485 IF( ln_timing ) CALL timing_stop( 'nonosc' ) 486 #ifdef SCOREP_USER_ENABLE 487 SCOREP_USER_REGION_END( reg_nonosc ) 488 SCOREP_USER_REGION_BEGIN( reg_nonosc_imbalance, "nonosc imbalance", SCOREP_USER_REGION_TYPE_COMMON ) 489 call MPI_Barrier(MPI_COMM_WORLD, ier) 490 SCOREP_USER_REGION_END( reg_nonosc_imbalance ) 491 #endif 492 #ifdef BULL_ASYNC 493 contains 494 subroutine cb1(i0, i1, j0, j1, k0, k1, buf) 495 integer, intent(in) :: i0, i1, j0, j1, k0, k1 496 real(wp), dimension(:,:,:,:,:,:), optional, intent(out) :: buf 497 integer jji, jjj, jjk 498 real(wp) :: p2dt_inv 499 !REAL(wp), DIMENSION (40,jpj,jpk) :: paa, pbb, pcc ! monotonic fluxes in the 3 directions 500 !REAL(wp), DIMENSION (40,jpj,jpk) :: e3t_n, paft 501 !REAL(wp), DIMENSION (40,jpj) :: e1e2t 502 !REAL(wp), DIMENSION(40,jpj,jpk) :: zbetup, zbetdo, zbup, zbdo 503 !DIR$ ASSUME_ALIGNED zbup:64 504 !DIR$ ASSUME (jpi .EQ.40) 505 !DIR$ ASSUME (jpj .EQ.42) 506 !DIR$ ASSUME (jpk .EQ.75) 507 508 p2dt_inv = 1._wp * p2dt 509 if(i0 == i1) then 510 ji=i0 511 ! DO jjj = j0, j1, 8 512 DO jk = k0, k1 513 ikm1 = MAX(jk-1,1) 514 !DIR$ vector always 515 DO jj = j0, j1 516 !DO jj = jjj, min(jjj+7, j1) 517 ! search maximum in neighbourhood 518 zup = MAX( zbup(ji ,jj ,jk ), & 519 & zbup(ji-1,jj ,jk ), zbup(ji+1,jj ,jk ), & 520 & zbup(ji ,jj-1,jk ), zbup(ji ,jj+1,jk ), & 521 & zbup(ji ,jj ,ikm1), zbup(ji ,jj ,jk+1) ) 522 523 ! search minimum in neighbourhood 524 zdo = MIN( zbdo(ji ,jj ,jk ), & 525 & zbdo(ji-1,jj ,jk ), zbdo(ji+1,jj ,jk ), & 526 & zbdo(ji ,jj-1,jk ), zbdo(ji ,jj+1,jk ), & 527 & zbdo(ji ,jj ,ikm1), zbdo(ji ,jj ,jk+1) ) 528 529 ! positive part of the flux 530 zpos = MAX( 0., paa(ji-1,jj ,jk ) ) - MIN( 0., paa(ji ,jj ,jk ) ) & 531 & + MAX( 0., pbb(ji ,jj-1,jk ) ) - MIN( 0., pbb(ji ,jj ,jk ) ) & 532 & + MAX( 0., pcc(ji ,jj ,jk+1) ) - MIN( 0., pcc(ji ,jj ,jk ) ) 533 534 ! negative part of the flux 535 zneg = MAX( 0., paa(ji ,jj ,jk ) ) - MIN( 0., paa(ji-1,jj ,jk ) ) & 536 & + MAX( 0., pbb(ji ,jj ,jk ) ) - MIN( 0., pbb(ji ,jj-1,jk ) ) & 537 & + MAX( 0., pcc(ji ,jj ,jk ) ) - MIN( 0., pcc(ji ,jj ,jk+1) ) 538 539 ! up & down beta terms 540 zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * p2dt_inv 541 zbetup(ji,jj,jk) = ( zup - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt 542 zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo ) / ( zneg + zrtrn ) * zbt 543 544 #ifdef BULL_CB_WITH_BUF 545 ! zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf 546 buf(jj,1,jk,1,1,1) = zbetup(ji,jj,jk) 547 buf(jj,1,jk,1,2,1) = zbetdo(ji,jj,jk) 548 #endif 549 END DO 550 END DO 551 !end do 552 else 553 DO jk = k0, k1 554 ikm1 = MAX(jk-1,1) 555 DO jj = j0, j1 556 !DIR$ vector always 557 DO ji = i0, i1 558 559 ! search maximum in neighbourhood 560 zup = MAX( zbup(ji ,jj ,jk ), & 561 & zbup(ji-1,jj ,jk ), zbup(ji+1,jj ,jk ), & 562 & zbup(ji ,jj-1,jk ), zbup(ji ,jj+1,jk ), & 563 & zbup(ji ,jj ,ikm1), zbup(ji ,jj ,jk+1) ) 564 565 ! search minimum in neighbourhood 566 zdo = MIN( zbdo(ji ,jj ,jk ), & 567 & zbdo(ji-1,jj ,jk ), zbdo(ji+1,jj ,jk ), & 568 & zbdo(ji ,jj-1,jk ), zbdo(ji ,jj+1,jk ), & 569 & zbdo(ji ,jj ,ikm1), zbdo(ji ,jj ,jk+1) ) 570 571 ! positive part of the flux 572 zpos = MAX( 0., paa(ji-1,jj ,jk ) ) - MIN( 0., paa(ji ,jj ,jk ) ) & 573 & + MAX( 0., pbb(ji ,jj-1,jk ) ) - MIN( 0., pbb(ji ,jj ,jk ) ) & 574 & + MAX( 0., pcc(ji ,jj ,jk+1) ) - MIN( 0., pcc(ji ,jj ,jk ) ) 575 576 ! negative part of the flux 577 zneg = MAX( 0., paa(ji ,jj ,jk ) ) - MIN( 0., paa(ji-1,jj ,jk ) ) & 578 & + MAX( 0., pbb(ji ,jj ,jk ) ) - MIN( 0., pbb(ji ,jj-1,jk ) ) & 579 & + MAX( 0., pcc(ji ,jj ,jk ) ) - MIN( 0., pcc(ji ,jj ,jk+1) ) 580 581 ! up & down beta terms 582 zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * p2dt_inv 583 zbetup(ji,jj,jk) = ( zup - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt 584 zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo ) / ( zneg + zrtrn ) * zbt 585 586 END DO 587 END DO 588 END DO 589 endif 590 591 end subroutine 592 subroutine cb2(i0, i1, j0, j1, k0, k1, buf) 593 integer, intent(in) :: i0, i1, j0, j1, k0, k1 594 real(wp), dimension(:,:,:,:,:,:), optional, intent(out) :: buf 595 integer jji, jjj, jjk 596 597 ! 3. monotonic flux in the i & j direction (paa & pbb) 598 if(i0 == i1) then 599 ji=i0 600 do jjj=j0, j1, 8 601 DO jk = k0, k1 602 !DIR$ vector always 603 !DO jj = j0, j1 604 DO jj = jjj, min(jjj+7, j1) 605 zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 606 zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 607 zcu = ( 0.5 + SIGN( 0.5 , paa(ji,jj,jk) ) ) 608 paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu ) 609 610 zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) ) 611 zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) ) 612 zcv = ( 0.5 + SIGN( 0.5 , pbb(ji,jj,jk) ) ) 613 pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv ) 614 615 ! monotonic flux in the k direction, i.e. pcc 616 ! ------------------------------------------- 617 za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) ) 618 zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) ) 619 zc = ( 0.5 + SIGN( 0.5 , pcc(ji,jj,jk+1) ) ) 620 pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb ) 621 #ifdef BULL_CB_WITH_BUF 622 ! zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf 623 buf(jj,1,jk,1,1,1) = paa(ji,jj,jk) 624 buf(jj,1,jk,1,2,1) = pbb(ji,jj,jk) 625 #endif 626 END DO 627 END DO 628 end do 629 else 630 DO jk = k0, k1 631 DO jj = j0, j1 632 !DIR$ vector always 633 DO ji = i0, i1 634 zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 635 zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 636 zcu = ( 0.5 + SIGN( 0.5 , paa(ji,jj,jk) ) ) 637 paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu ) 638 639 zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) ) 640 zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) ) 641 zcv = ( 0.5 + SIGN( 0.5 , pbb(ji,jj,jk) ) ) 642 pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv ) 643 644 ! monotonic flux in the k direction, i.e. pcc 645 ! ------------------------------------------- 646 za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) ) 647 zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) ) 648 zc = ( 0.5 + SIGN( 0.5 , pcc(ji,jj,jk+1) ) ) 649 pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb ) 650 END DO 651 END DO 652 END DO 653 endif 654 end subroutine 655 #endif 424 656 END SUBROUTINE nonosc 425 657 -
NEMO/branches/2018/dev_r9759_HPC09_ESIWACE/tests/demo_cfgs.txt
r9766 r10136 6 6 VORTEX OCE NST 7 7 WAD OCE 8 BENCH OCE 8 BENCH_1 OCE 9 BENCH_025 OCE 10 BENCH_12 OCE
Note: See TracChangeset
for help on using the changeset viewer.