Changeset 13982 for NEMO/trunk/src/OCE/LBC
- Timestamp:
- 2020-12-02T11:57:05+01:00 (3 years ago)
- Location:
- NEMO/trunk/src/OCE/LBC
- Files:
-
- 5 edited
- 2 copied
-
lbc_lnk_multi_generic.h90 (modified) (3 diffs)
-
lbc_lnk_nc_generic.h90 (copied) (copied from NEMO/branches/2020/dev_r13923_Tiling_Cleanup_MPI3_LoopFusion/src/OCE/LBC/lbc_lnk_nc_generic.h90)
-
lbclnk.F90 (modified) (3 diffs)
-
lib_mpp.F90 (modified) (3 diffs)
-
mpp_lnk_generic.h90 (modified) (4 diffs)
-
mpp_nc_generic.h90 (copied) (copied from NEMO/branches/2020/dev_r13923_Tiling_Cleanup_MPI3_LoopFusion/src/OCE/LBC/mpp_nc_generic.h90)
-
mppini.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/LBC/lbc_lnk_multi_generic.h90
r13472 r13982 40 40 & , pt9 , cdna9 , psgn9 , pt10, cdna10, psgn10, pt11, cdna11, psgn11, pt12, cdna12, psgn12 & 41 41 & , pt13, cdna13, psgn13, pt14, cdna14, psgn14, pt15, cdna15, psgn15, pt16, cdna16, psgn16 & 42 & , kfillmode, pfillval, lsend, lrecv )42 & , kfillmode, pfillval, lsend, lrecv, ncsten ) 43 43 !!--------------------------------------------------------------------- 44 44 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine … … 55 55 REAL(wp) , OPTIONAL , INTENT(in ) :: pfillval ! background value (used at closed boundaries) 56 56 LOGICAL, DIMENSION(4), OPTIONAL , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out 57 LOGICAL , OPTIONAL , INTENT(in ) :: ncsten 57 58 !! 58 59 INTEGER :: kfld ! number of elements that will be attributed … … 84 85 IF( PRESENT(psgn16) ) CALL ROUTINE_LOAD( pt16, cdna16, psgn16, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 85 86 ! 86 CALL lbc_lnk_ptr( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv )87 CALL lbc_lnk_ptr( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ncsten ) 87 88 ! 88 89 END SUBROUTINE ROUTINE_MULTI -
NEMO/trunk/src/OCE/LBC/lbclnk.F90
r13226 r13982 39 39 MODULE PROCEDURE lbc_lnk_2d_multi_dp , lbc_lnk_3d_multi_dp, lbc_lnk_4d_multi_dp 40 40 END INTERFACE 41 INTERFACE lbc_lnk_nc_multi 42 MODULE PROCEDURE lbc_lnk_nc_2d_sp, lbc_lnk_nc_3d_sp, lbc_lnk_nc_4d_sp 43 MODULE PROCEDURE lbc_lnk_nc_2d_dp, lbc_lnk_nc_3d_dp, lbc_lnk_nc_4d_dp 44 END INTERFACE 45 INTERFACE lbc_lnk_nc 46 MODULE PROCEDURE mpp_lnk_nc_2d_sp, mpp_lnk_nc_3d_sp, mpp_lnk_nc_4d_sp 47 MODULE PROCEDURE mpp_lnk_nc_2d_dp, mpp_lnk_nc_3d_dp, mpp_lnk_nc_4d_dp 48 END INTERFACE 41 49 ! 42 50 INTERFACE lbc_lnk_icb … … 52 60 END INTERFACE 53 61 54 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 55 PUBLIC lbc_lnk_multi ! modified ocean/ice lateral boundary conditions 56 PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions 62 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 63 PUBLIC lbc_lnk_multi ! modified ocean/ice lateral boundary conditions 64 PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions 65 PUBLIC lbc_lnk_nc ! ocean/ice lateral boundary conditions (MPI3 version) 66 PUBLIC lbc_lnk_nc_multi ! modified ocean/ice lateral boundary conditions (MPI3 version) 57 67 58 68 #if defined key_mpp_mpi … … 250 260 # undef DIM_4d 251 261 262 !!---------------------------------------------------------------------- 263 !! *** load_ptr_(2,3,4)d *** 264 !! 265 !! * Dummy Argument : 266 !! in ==> ptab ! array to be loaded (2D, 3D or 4D) 267 !! cd_nat ! nature of pt2d array grid-points 268 !! psgn ! sign used across the north fold boundary 269 !! inout <=> ptab_ptr ! array of 2D, 3D or 4D pointers 270 !! cdna_ptr ! nature of ptab array grid-points 271 !! psgn_ptr ! sign used across the north fold boundary 272 !! kfld ! number of elements that has been attributed 273 !!---------------------------------------------------------------------- 274 275 !!---------------------------------------------------------------------- 276 !! *** lbc_lnk_nc(2,3,4)d_multi *** 277 !! *** load_ptr_(2,3,4)d *** 278 !! 279 !! * Argument : dummy argument use in lbc_lnk_nc_multi_... routines 280 !! 281 !!---------------------------------------------------------------------- 282 283 !! 284 !! ---- SINGLE PRECISION VERSIONS 285 !! 286 # define SINGLE_PRECISION 287 # define DIM_2d 288 # define ROUTINE_NC_LOAD load_ptr_nc_2d_sp 289 # define ROUTINE_MULTI_NC lbc_lnk_nc_2d_sp 290 # include "lbc_lnk_nc_generic.h90" 291 # undef ROUTINE_MULTI_NC 292 # undef ROUTINE_NC_LOAD 293 # undef DIM_2d 294 295 # define DIM_3d 296 # define ROUTINE_NC_LOAD load_ptr_nc_3d_sp 297 # define ROUTINE_MULTI_NC lbc_lnk_nc_3d_sp 298 # include "lbc_lnk_nc_generic.h90" 299 # undef ROUTINE_MULTI_NC 300 # undef ROUTINE_NC_LOAD 301 # undef DIM_3d 302 303 # define DIM_4d 304 # define ROUTINE_NC_LOAD load_ptr_nc_4d_sp 305 # define ROUTINE_MULTI_NC lbc_lnk_nc_4d_sp 306 # include "lbc_lnk_nc_generic.h90" 307 # undef ROUTINE_MULTI_NC 308 # undef ROUTINE_NC_LOAD 309 # undef DIM_4d 310 # undef SINGLE_PRECISION 311 !! 312 !! ---- DOUBLE PRECISION VERSIONS 313 !! 314 315 # define DIM_2d 316 # define ROUTINE_NC_LOAD load_ptr_nc_2d_dp 317 # define ROUTINE_MULTI_NC lbc_lnk_nc_2d_dp 318 # include "lbc_lnk_nc_generic.h90" 319 # undef ROUTINE_MULTI_NC 320 # undef ROUTINE_NC_LOAD 321 # undef DIM_2d 322 323 # define DIM_3d 324 # define ROUTINE_NC_LOAD load_ptr_nc_3d_dp 325 # define ROUTINE_MULTI_NC lbc_lnk_nc_3d_dp 326 # include "lbc_lnk_nc_generic.h90" 327 # undef ROUTINE_MULTI_NC 328 # undef ROUTINE_NC_LOAD 329 # undef DIM_3d 330 331 # define DIM_4d 332 # define ROUTINE_NC_LOAD load_ptr_nc_4d_dp 333 # define ROUTINE_MULTI_NC lbc_lnk_nc_4d_dp 334 # include "lbc_lnk_nc_generic.h90" 335 # undef ROUTINE_MULTI_NC 336 # undef ROUTINE_NC_LOAD 337 # undef DIM_4d 338 339 !!---------------------------------------------------------------------- 340 !! *** routine mpp_lnk_nc_(2,3,4)d *** 341 !! 342 !! * Argument : dummy argument use in mpp_lnk_... routines 343 !! ptab : array or pointer of arrays on which the boundary condition is applied 344 !! cd_nat : nature of array grid-points 345 !! psgn : sign used across the north fold boundary 346 !! kfld : optional, number of pt3d arrays 347 !! kfillmode : optional, method to be use to fill the halos (see jpfill* variables) 348 !! pfillval : optional, background value (used with jpfillcopy) 349 !!---------------------------------------------------------------------- 350 ! 351 ! !== 2D array and array of 2D pointer ==! 352 ! 353 !! 354 !! ---- SINGLE PRECISION VERSIONS 355 !! 356 # define SINGLE_PRECISION 357 # define DIM_2d 358 # define ROUTINE_NC mpp_lnk_nc_2d_sp 359 # include "mpp_nc_generic.h90" 360 # undef ROUTINE_NC 361 # undef DIM_2d 362 ! 363 ! !== 3D array and array of 3D pointer ==! 364 ! 365 # define DIM_3d 366 # define ROUTINE_NC mpp_lnk_nc_3d_sp 367 # include "mpp_nc_generic.h90" 368 # undef ROUTINE_NC 369 # undef DIM_3d 370 ! 371 ! !== 4D array and array of 4D pointer ==! 372 ! 373 # define DIM_4d 374 # define ROUTINE_NC mpp_lnk_nc_4d_sp 375 # include "mpp_nc_generic.h90" 376 # undef ROUTINE_NC 377 # undef DIM_4d 378 # undef SINGLE_PRECISION 379 380 !! 381 !! ---- DOUBLE PRECISION VERSIONS 382 !! 383 # define DIM_2d 384 # define ROUTINE_NC mpp_lnk_nc_2d_dp 385 # include "mpp_nc_generic.h90" 386 # undef ROUTINE_NC 387 # undef DIM_2d 388 ! 389 ! !== 3D array and array of 3D pointer ==! 390 ! 391 # define DIM_3d 392 # define ROUTINE_NC mpp_lnk_nc_3d_dp 393 # include "mpp_nc_generic.h90" 394 # undef ROUTINE_NC 395 # undef DIM_3d 396 ! 397 ! !== 4D array and array of 4D pointer ==! 398 ! 399 # define DIM_4d 400 # define ROUTINE_NC mpp_lnk_nc_4d_dp 401 # include "mpp_nc_generic.h90" 402 # undef ROUTINE_NC 403 # undef DIM_4d 252 404 253 405 !!---------------------------------------------------------------------- -
NEMO/trunk/src/OCE/LBC/lib_mpp.F90
r13636 r13982 66 66 PUBLIC mppscatter, mppgather 67 67 PUBLIC mpp_ini_znl 68 PUBLIC mpp_ini_nc 68 69 PUBLIC mppsend, mpprecv ! needed by TAM and ICB routines 69 70 PUBLIC mppsend_sp, mpprecv_sp ! needed by TAM and ICB routines … … 137 138 INTEGER :: ndim_rank_znl ! number of processors on the same zonal average 138 139 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: nrank_znl ! dimension ndim_rank_znl, number of the procs into the same znl domain 140 141 ! variables used for MPI3 neighbourhood collectives 142 INTEGER, PUBLIC :: mpi_nc_com ! MPI3 neighbourhood collectives communicator 143 INTEGER, PUBLIC :: mpi_nc_all_com ! MPI3 neighbourhood collectives communicator (with diagionals) 139 144 140 145 ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM) … … 1067 1072 1068 1073 END SUBROUTINE mpp_ini_znl 1074 1075 SUBROUTINE mpp_ini_nc 1076 !!---------------------------------------------------------------------- 1077 !! *** routine mpp_ini_nc *** 1078 !! 1079 !! ** Purpose : Initialize special communicators for MPI3 neighbourhood 1080 !! collectives 1081 !! 1082 !! ** Method : - Create graph communicators starting from the processes 1083 !! distribution along i and j directions 1084 ! 1085 !! ** output 1086 !! mpi_nc_com = MPI3 neighbourhood collectives communicator 1087 !! mpi_nc_all_com = MPI3 neighbourhood collectives communicator 1088 !! (with diagonals) 1089 !! 1090 !!---------------------------------------------------------------------- 1091 INTEGER, DIMENSION(:), ALLOCATABLE :: ineigh, ineighalls, ineighallr 1092 INTEGER :: ideg, idegalls, idegallr, icont, icont1 1093 INTEGER :: ierr 1094 LOGICAL, PARAMETER :: ireord = .FALSE. 1095 1096 #if defined key_mpp_mpi 1097 1098 ideg = 0 1099 idegalls = 0 1100 idegallr = 0 1101 icont = 0 1102 icont1 = 0 1103 1104 IF (nbondi .eq. 1) THEN 1105 ideg = ideg + 1 1106 ELSEIF (nbondi .eq. -1) THEN 1107 ideg = ideg + 1 1108 ELSEIF (nbondi .eq. 0) THEN 1109 ideg = ideg + 2 1110 ENDIF 1111 1112 IF (nbondj .eq. 1) THEN 1113 ideg = ideg + 1 1114 ELSEIF (nbondj .eq. -1) THEN 1115 ideg = ideg + 1 1116 ELSEIF (nbondj .eq. 0) THEN 1117 ideg = ideg + 2 1118 ENDIF 1119 1120 idegalls = ideg 1121 idegallr = ideg 1122 1123 IF (nones .ne. -1) idegalls = idegalls + 1 1124 IF (nonws .ne. -1) idegalls = idegalls + 1 1125 IF (noses .ne. -1) idegalls = idegalls + 1 1126 IF (nosws .ne. -1) idegalls = idegalls + 1 1127 IF (noner .ne. -1) idegallr = idegallr + 1 1128 IF (nonwr .ne. -1) idegallr = idegallr + 1 1129 IF (noser .ne. -1) idegallr = idegallr + 1 1130 IF (noswr .ne. -1) idegallr = idegallr + 1 1131 1132 ALLOCATE(ineigh(ideg)) 1133 ALLOCATE(ineighalls(idegalls)) 1134 ALLOCATE(ineighallr(idegallr)) 1135 1136 IF (nbondi .eq. 1) THEN 1137 icont = icont + 1 1138 ineigh(icont) = nowe 1139 ineighalls(icont) = nowe 1140 ineighallr(icont) = nowe 1141 ELSEIF (nbondi .eq. -1) THEN 1142 icont = icont + 1 1143 ineigh(icont) = noea 1144 ineighalls(icont) = noea 1145 ineighallr(icont) = noea 1146 ELSEIF (nbondi .eq. 0) THEN 1147 icont = icont + 1 1148 ineigh(icont) = nowe 1149 ineighalls(icont) = nowe 1150 ineighallr(icont) = nowe 1151 icont = icont + 1 1152 ineigh(icont) = noea 1153 ineighalls(icont) = noea 1154 ineighallr(icont) = noea 1155 ENDIF 1156 1157 IF (nbondj .eq. 1) THEN 1158 icont = icont + 1 1159 ineigh(icont) = noso 1160 ineighalls(icont) = noso 1161 ineighallr(icont) = noso 1162 ELSEIF (nbondj .eq. -1) THEN 1163 icont = icont + 1 1164 ineigh(icont) = nono 1165 ineighalls(icont) = nono 1166 ineighallr(icont) = nono 1167 ELSEIF (nbondj .eq. 0) THEN 1168 icont = icont + 1 1169 ineigh(icont) = noso 1170 ineighalls(icont) = noso 1171 ineighallr(icont) = noso 1172 icont = icont + 1 1173 ineigh(icont) = nono 1174 ineighalls(icont) = nono 1175 ineighallr(icont) = nono 1176 ENDIF 1177 1178 icont1 = icont 1179 IF (nosws .ne. -1) THEN 1180 icont = icont + 1 1181 ineighalls(icont) = nosws 1182 ENDIF 1183 IF (noses .ne. -1) THEN 1184 icont = icont + 1 1185 ineighalls(icont) = noses 1186 ENDIF 1187 IF (nonws .ne. -1) THEN 1188 icont = icont + 1 1189 ineighalls(icont) = nonws 1190 ENDIF 1191 IF (nones .ne. -1) THEN 1192 icont = icont + 1 1193 ineighalls(icont) = nones 1194 ENDIF 1195 IF (noswr .ne. -1) THEN 1196 icont1 = icont1 + 1 1197 ineighallr(icont1) = noswr 1198 ENDIF 1199 IF (noser .ne. -1) THEN 1200 icont1 = icont1 + 1 1201 ineighallr(icont1) = noser 1202 ENDIF 1203 IF (nonwr .ne. -1) THEN 1204 icont1 = icont1 + 1 1205 ineighallr(icont1) = nonwr 1206 ENDIF 1207 IF (noner .ne. -1) THEN 1208 icont1 = icont1 + 1 1209 ineighallr(icont1) = noner 1210 ENDIF 1211 1212 CALL MPI_Dist_graph_create_adjacent(mpi_comm_oce, ideg, ineigh, MPI_UNWEIGHTED, ideg, ineigh, MPI_UNWEIGHTED, MPI_INFO_NULL, ireord, mpi_nc_com, ierr) 1213 CALL MPI_Dist_graph_create_adjacent(mpi_comm_oce, idegallr, ineighallr, MPI_UNWEIGHTED, idegalls, ineighalls, MPI_UNWEIGHTED, MPI_INFO_NULL, ireord, mpi_nc_all_com, ierr) 1214 1215 DEALLOCATE (ineigh) 1216 DEALLOCATE (ineighalls) 1217 DEALLOCATE (ineighallr) 1218 #endif 1219 END SUBROUTINE mpp_ini_nc 1220 1069 1221 1070 1222 -
NEMO/trunk/src/OCE/LBC/mpp_lnk_generic.h90
r13286 r13982 72 72 73 73 #if defined MULTI 74 SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv )74 SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ncsten ) 75 75 INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays 76 76 #else 77 SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn , kfillmode, pfillval, lsend, lrecv )77 SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn , kfillmode, pfillval, lsend, lrecv, ncsten ) 78 78 #endif 79 79 ARRAY_TYPE(:,:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied … … 84 84 REAL(wp), OPTIONAL, INTENT(in ) :: pfillval ! background value (used at closed boundaries) 85 85 LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in ) :: lsend, lrecv ! communication with other 4 proc 86 LOGICAL, OPTIONAL, INTENT(in ) :: ncsten ! 5-point or 9-point stencil 86 87 ! 87 88 INTEGER :: ji, jj, jk, jl, jf ! dummy loop indices … … 100 101 !!---------------------------------------------------------------------- 101 102 ! 103 #if defined key_mpi3 104 # if defined MULTI 105 CALL lbc_lnk_nc ( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ncsten ) 106 # else 107 CALL lbc_lnk_nc_multi(cdname, ptab, cd_nat, psgn, kfillmode=kfillmode, pfillval=pfillval, lsend=lsend, lrecv=lrecv, ncsten=ncsten) 108 # endif 109 #else 110 102 111 ! ----------------------------------------- ! 103 112 ! 0. local variables initialization ! … … 387 396 IF( llrecv_no ) DEALLOCATE( zrcv_no ) 388 397 ! 398 #endif 389 399 END SUBROUTINE ROUTINE_LNK 390 400 #undef PRECISION -
NEMO/trunk/src/OCE/LBC/mppini.F90
r13490 r13982 542 542 ij = ijn(narea) 543 543 ! 544 ! set default neighbours545 noso = ii_noso(narea)546 nowe = ii_nowe(narea)547 noea = ii_noea(narea)548 nono = ii_nono(narea)549 544 jpi = ijpi(ii,ij) 550 545 !!$ Nis0 = iis0(ii,ij) … … 558 553 njmpp = ijmppt(ii,ij) 559 554 jpk = jpkglo ! third dim 555 556 ! set default neighbours 557 noso = ii_noso(narea) 558 nowe = ii_nowe(narea) 559 noea = ii_noea(narea) 560 nono = ii_nono(narea) 561 562 nones = -1 563 nonws = -1 564 noses = -1 565 nosws = -1 566 567 noner = -1 568 nonwr = -1 569 noser = -1 570 noswr = -1 571 572 IF((nbondi .eq. -1) .or. (nbondi .eq. 0)) THEN ! east neighbour exists 573 IF(ibondj(iin(noea+1),ijn(noea+1)) .eq. 0) THEN 574 nones = ii_nono(noea+1) ! east neighbour has north and south neighbours 575 noses = ii_noso(noea+1) 576 ELSEIF(ibondj(iin(noea+1),ijn(noea+1)) .eq. -1) THEN 577 nones = ii_nono(noea+1) ! east neighbour has north neighbour 578 ELSEIF(ibondj(iin(noea+1),ijn(noea+1)) .eq. 1) THEN 579 noses = ii_noso(noea+1) ! east neighbour has south neighbour 580 END IF 581 END IF 582 IF((nbondi .eq. 1) .or. (nbondi .eq. 0)) THEN ! west neighbour exists 583 IF(ibondj(iin(nowe+1),ijn(nowe+1)) .eq. 0) THEN 584 nonws = ii_nono(nowe+1) ! west neighbour has north and south neighbours 585 nosws = ii_noso(nowe+1) 586 ELSEIF(ibondj(iin(nowe+1),ijn(nowe+1)) .eq. -1) THEN 587 nonws = ii_nono(nowe+1) ! west neighbour has north neighbour 588 ELSEIF(ibondj(iin(nowe+1),ijn(nowe+1)) .eq. 1) THEN 589 nosws = ii_noso(nowe+1) ! west neighbour has north neighbour 590 END IF 591 END IF 592 593 IF((nbondj .eq. -1) .or. (nbondj .eq. 0)) THEN ! north neighbour exists 594 IF(ibondi(iin(nono+1),ijn(nono+1)) .eq. 0) THEN 595 noner = ii_noea(nono+1) ! north neighbour has east and west neighbours 596 nonwr = ii_nowe(nono+1) 597 ELSEIF(ibondi(iin(nono+1),ijn(nono+1)) .eq. -1) THEN 598 noner = ii_noea(nono+1) ! north neighbour has east neighbour 599 ELSEIF(ibondi(iin(nono+1),ijn(nono+1)) .eq. 1) THEN 600 nonwr = ii_nowe(nono+1) ! north neighbour has west neighbour 601 END IF 602 END IF 603 IF((nbondj .eq. 1) .or. (nbondj .eq. 0)) THEN ! south neighbour exists 604 IF(ibondi(iin(noso+1),ijn(noso+1)) .eq. 0) THEN 605 noser = ii_noea(noso+1) ! south neighbour has east and west neighbours 606 noswr = ii_nowe(noso+1) 607 ELSEIF(ibondi(iin(noso+1),ijn(noso+1)) .eq. -1) THEN 608 noser = ii_noea(noso+1) ! south neighbour has east neighbour 609 ELSEIF(ibondi(iin(noso+1),ijn(noso+1)) .eq. 1) THEN 610 noswr = ii_nowe(noso+1) ! south neighbour has west neighbour 611 END IF 612 END IF 613 560 614 ! 561 615 CALL init_doloop ! set start/end indices of do-loop, depending on the halo width value (nn_hls) … … 648 702 ENDIF 649 703 ENDIF 704 705 ! 706 CALL mpp_ini_nc ! Initialize communicator for neighbourhood collective communications 650 707 ! 651 708 CALL init_ioipsl ! Prepare NetCDF output file (if necessary)
Note: See TracChangeset
for help on using the changeset viewer.
