Changeset 3009 for branches/2011/dev_NOC_2011_MERGE
- Timestamp:
- 2011-10-27T13:35:36+02:00 (13 years ago)
- Location:
- branches/2011/dev_NOC_2011_MERGE
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_NOC_2011_MERGE/DOC/TexFiles/Chapters/Chap_MISC.tex
r2541 r3009 253 253 Note this implementation may be sensitive to the optimization level. 254 254 255 \subsection{MPP scalability} 256 \label{MISC_mppsca} 257 258 The default method of communicating values across the north-fold in distributed memory applications 259 (\key{mpp\_mpi}) uses a \textsc{MPI\_ALLGATHER} function to exchange values from each processing 260 region in the northern row with every other processing region in the northern row. This enables a 261 global width array containing the top 4 rows to be collated on every northern row processor and then 262 folded with a simple algorithm. Although conceptually simple, this "All to All" communication will 263 hamper performance scalability for large numbers of northern row processors. From version 3.4 264 onwards an alternative method is available which only performs direct "Peer to Peer" communications 265 between each processor and its immediate "neighbours" across the fold line. This is achieved by 266 using the default \textsc{MPI\_ALLGATHER} method during initialisation to help identify the "active" 267 neighbours. Stored lists of these neighbours are then used in all subsequent north-fold exchanges to 268 restrict exchanges to those between associated regions. The collated global width array for each 269 region is thus only partially filled but is guaranteed to be set at all the locations actually 270 required by each individual for the fold operation. This alternative method should give identical 271 results to the default \textsc{ALLGATHER} method and is recommended for large values of \np{jpni}. 272 The new method is activated by setting \np{ln\_nnogather} to be true ({\bf nammpp}). The 273 reproducibility of results using the two methods should be confirmed for each new, non-reference 274 configuration. 255 275 256 276 % ================================================================ -
branches/2011/dev_NOC_2011_MERGE/NEMOGCM/CONFIG/GYRE/EXP00/namelist
r2986 r3009 697 697 ! buffer blocking send or immediate non-blocking sends, resp. 698 698 nn_buffer = 0 ! size in bytes of exported buffer ('B' case), 0 no exportation 699 ln_nnogather= .false. ! activate code to avoid mpi_allgather use at the northfold 699 700 jpni = 0 ! jpni number of processors following i (set automatically if < 1) 700 701 jpnj = 0 ! jpnj number of processors following j (set automatically if < 1) -
branches/2011/dev_NOC_2011_MERGE/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist
r2986 r3009 697 697 ! buffer blocking send or immediate non-blocking sends, resp. 698 698 nn_buffer = 0 ! size in bytes of exported buffer ('B' case), 0 no exportation 699 ln_nnogather= .false. ! activate code to avoid mpi_allgather use at the northfold 699 700 jpni = 0 ! jpni number of processors following i (set automatically if < 1) 700 701 jpnj = 0 ! jpnj number of processors following j (set automatically if < 1) -
branches/2011/dev_NOC_2011_MERGE/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist
r2986 r3009 711 711 ! buffer blocking send or immediate non-blocking sends, resp. 712 712 nn_buffer = 0 ! size in bytes of exported buffer ('B' case), 0 no exportation 713 ln_nnogather= .false. ! activate code to avoid mpi_allgather use at the northfold 713 714 jpni = 0 ! jpni number of processors following i (set automatically if < 1) 714 715 jpnj = 0 ! jpnj number of processors following j (set automatically if < 1) -
branches/2011/dev_NOC_2011_MERGE/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
r2715 r3009 236 236 END DO 237 237 END DO 238 CASE ( 'J' ) ! first ice U-V point 239 DO jl =0, ipr2dj 240 pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl) 241 DO ji = 3, jpiglo 242 iju = jpiglo - ji + 3 243 pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl) 244 END DO 245 END DO 246 CASE ( 'K' ) ! second ice U-V point 247 DO jl =0, ipr2dj 248 pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl) 249 DO ji = 3, jpiglo 250 iju = jpiglo - ji + 3 251 pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl) 252 END DO 253 END DO 238 254 END SELECT 239 255 ! … … 285 301 END DO 286 302 END DO 303 CASE ( 'J' ) ! first ice U-V point 304 pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0 305 DO jl = 0, ipr2dj 306 DO ji = 2 , jpiglo-1 307 ijt = jpiglo - ji + 2 308 pt2d(ji,ijpj+jl)= pt2d(ji,ijpj-1-jl) 309 END DO 310 END DO 311 CASE ( 'K' ) ! second ice U-V point 312 pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0 313 DO jl = 0, ipr2dj 314 DO ji = 2 , jpiglo-1 315 ijt = jpiglo - ji + 2 316 pt2d(ji,ijpj+jl)= pt2d(ijt,ijpj-1-jl) 317 END DO 318 END DO 287 319 END SELECT 288 320 ! … … 298 330 pt2d(:, 1:1-ipr2dj ) = 0.e0 299 331 pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 332 CASE ( 'J' ) ! first ice U-V point 333 pt2d(:, 1:1-ipr2dj ) = 0.e0 334 pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 335 CASE ( 'K' ) ! second ice U-V point 336 pt2d(:, 1:1-ipr2dj ) = 0.e0 337 pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 300 338 END SELECT 301 339 ! -
branches/2011/dev_NOC_2011_MERGE/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r2731 r3009 164 164 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: ztab, znorthloc 165 165 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: znorthgloio 166 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: zfoldwk ! Workspace for message transfers avoiding mpi_allgather 166 167 167 168 ! Arrays used in mpp_lbc_north_2d() 168 169 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: ztab_2d, znorthloc_2d 169 170 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: znorthgloio_2d 171 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: zfoldwk_2d ! Workspace for message transfers avoiding mpi_allgather 170 172 171 173 ! Arrays used in mpp_lbc_north_e() … … 173 175 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: znorthgloio_e 174 176 177 ! North fold arrays used to minimise the use of allgather operations. Set in nemo_northcomms (nemogcm) so need to be public 178 INTEGER, PUBLIC, PARAMETER :: jpmaxngh = 8 ! Assumed maximum number of active neighbours 179 INTEGER, PUBLIC, PARAMETER :: jptyps = 5 ! Number of different neighbour lists to be used for northfold exchanges 180 INTEGER, PUBLIC, DIMENSION (jpmaxngh,jptyps) :: isendto 181 INTEGER, PUBLIC, DIMENSION (jptyps) :: nsndto 182 LOGICAL, PUBLIC :: ln_nnogather = .FALSE. ! namelist control of northfold comms 183 LOGICAL, PUBLIC :: l_north_nogather = .FALSE. ! internal control of northfold comms 184 INTEGER, PUBLIC :: ityp 175 185 !!---------------------------------------------------------------------- 176 186 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 203 213 ! 204 214 & ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk) , znorthgloio(jpi,4,jpk,jpni) , & 215 & zfoldwk(jpi,4,jpk) , & 205 216 ! 206 217 & ztab_2d(jpiglo,4) , znorthloc_2d(jpi,4) , znorthgloio_2d(jpi,4,jpni) , & 218 & zfoldwk_2d(jpi,4) , & 207 219 ! 208 220 & ztab_e(jpiglo,4+2*jpr2dj) , znorthloc_e(jpi,4+2*jpr2dj) , znorthgloio_e(jpi,4+2*jpr2dj,jpni) , & … … 232 244 LOGICAL :: mpi_was_called 233 245 ! 234 NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, jpnij 246 NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, jpnij, ln_nnogather 235 247 !!---------------------------------------------------------------------- 236 248 ! … … 269 281 WRITE(ldtxt(ii),*) ' number of local domains jpnij = ',jpnij; ii = ii +1 270 282 END IF 283 284 WRITE(ldtxt(ii),*) ' avoid use of mpi_allgather at the north fold ln_nnogather = ', ln_nnogather ; ii = ii + 1 271 285 272 286 CALL mpi_initialized ( mpi_was_called, code ) … … 441 455 CASE ( -1 ) 442 456 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 ) 443 CALL mpprecv( 1, t3ew(1,1,1,2), imigr )457 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea ) 444 458 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 445 459 CASE ( 0 ) 446 460 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 ) 447 461 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 ) 448 CALL mpprecv( 1, t3ew(1,1,1,2), imigr )449 CALL mpprecv( 2, t3we(1,1,1,2), imigr )462 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea ) 463 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe ) 450 464 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 451 465 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 452 466 CASE ( 1 ) 453 467 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 ) 454 CALL mpprecv( 2, t3we(1,1,1,2), imigr )468 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe ) 455 469 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 456 470 END SELECT … … 494 508 CASE ( -1 ) 495 509 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 ) 496 CALL mpprecv( 3, t3ns(1,1,1,2), imigr )510 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono ) 497 511 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 498 512 CASE ( 0 ) 499 513 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 ) 500 514 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 ) 501 CALL mpprecv( 3, t3ns(1,1,1,2), imigr )502 CALL mpprecv( 4, t3sn(1,1,1,2), imigr )515 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono ) 516 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso ) 503 517 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 504 518 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 505 519 CASE ( 1 ) 506 520 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 ) 507 CALL mpprecv( 4, t3sn(1,1,1,2), imigr )521 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso ) 508 522 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 509 523 END SELECT … … 635 649 CASE ( -1 ) 636 650 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 ) 637 CALL mpprecv( 1, t2ew(1,1,2), imigr )651 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea ) 638 652 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 639 653 CASE ( 0 ) 640 654 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 641 655 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 ) 642 CALL mpprecv( 1, t2ew(1,1,2), imigr )643 CALL mpprecv( 2, t2we(1,1,2), imigr )656 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea ) 657 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe ) 644 658 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 645 659 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 646 660 CASE ( 1 ) 647 661 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 648 CALL mpprecv( 2, t2we(1,1,2), imigr )662 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe ) 649 663 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 650 664 END SELECT … … 688 702 CASE ( -1 ) 689 703 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 ) 690 CALL mpprecv( 3, t2ns(1,1,2), imigr )704 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono ) 691 705 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 692 706 CASE ( 0 ) 693 707 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 694 708 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 ) 695 CALL mpprecv( 3, t2ns(1,1,2), imigr )696 CALL mpprecv( 4, t2sn(1,1,2), imigr )709 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono ) 710 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso ) 697 711 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 698 712 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 699 713 CASE ( 1 ) 700 714 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 701 CALL mpprecv( 4, t2sn(1,1,2), imigr )715 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso ) 702 716 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 703 717 END SELECT … … 816 830 CASE ( -1 ) 817 831 CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 ) 818 CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr )832 CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr, noea ) 819 833 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 820 834 CASE ( 0 ) 821 835 CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 822 836 CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req2 ) 823 CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr )824 CALL mpprecv( 2, t4we(1,1,1,1,2), imigr )837 CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr, noea ) 838 CALL mpprecv( 2, t4we(1,1,1,1,2), imigr, nowe ) 825 839 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 826 840 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 827 841 CASE ( 1 ) 828 842 CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 829 CALL mpprecv( 2, t4we(1,1,1,1,2), imigr )843 CALL mpprecv( 2, t4we(1,1,1,1,2), imigr, nowe ) 830 844 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 831 845 END SELECT … … 875 889 CASE ( -1 ) 876 890 CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req1 ) 877 CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr )891 CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr, nono ) 878 892 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 879 893 CASE ( 0 ) 880 894 CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 881 895 CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req2 ) 882 CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr )883 CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr )896 CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr, nono ) 897 CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr, noso ) 884 898 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 885 899 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 886 900 CASE ( 1 ) 887 901 CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 888 CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr )902 CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr, noso ) 889 903 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 890 904 END SELECT … … 1019 1033 CASE ( -1 ) 1020 1034 CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req1 ) 1021 CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )1035 CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea ) 1022 1036 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1023 1037 CASE ( 0 ) 1024 1038 CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 ) 1025 1039 CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req2 ) 1026 CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )1027 CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )1040 CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea ) 1041 CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr, nowe ) 1028 1042 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1029 1043 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1030 1044 CASE ( 1 ) 1031 1045 CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 ) 1032 CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )1046 CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr, nowe ) 1033 1047 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1034 1048 END SELECT … … 1072 1086 CASE ( -1 ) 1073 1087 CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req1 ) 1074 CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr )1088 CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono ) 1075 1089 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1076 1090 CASE ( 0 ) 1077 1091 CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 ) 1078 1092 CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req2 ) 1079 CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr )1080 CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr )1093 CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono ) 1094 CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr, noso ) 1081 1095 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1082 1096 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1083 1097 CASE ( 1 ) 1084 1098 CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 ) 1085 CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr )1099 CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr, noso ) 1086 1100 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1087 1101 END SELECT … … 1138 1152 1139 1153 1140 SUBROUTINE mpprecv( ktyp, pmess, kbytes )1154 SUBROUTINE mpprecv( ktyp, pmess, kbytes, ksource ) 1141 1155 !!---------------------------------------------------------------------- 1142 1156 !! *** routine mpprecv *** … … 1148 1162 INTEGER , INTENT(in ) :: kbytes ! suze of the array pmess 1149 1163 INTEGER , INTENT(in ) :: ktyp ! Tag of the recevied message 1164 INTEGER, OPTIONAL, INTENT(in) :: ksource ! source process number 1150 1165 !! 1151 1166 INTEGER :: istatus(mpi_status_size) 1152 1167 INTEGER :: iflag 1153 !!---------------------------------------------------------------------- 1154 ! 1155 CALL mpi_recv( pmess, kbytes, mpi_double_precision, mpi_any_source, ktyp, mpi_comm_opa, istatus, iflag ) 1168 INTEGER :: use_source 1169 !!---------------------------------------------------------------------- 1170 ! 1171 1172 ! If a specific process number has been passed to the receive call, 1173 ! use that one. Default is to use mpi_any_source 1174 use_source=mpi_any_source 1175 if(present(ksource)) then 1176 use_source=ksource 1177 end if 1178 1179 CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_source, ktyp, mpi_comm_opa, istatus, iflag ) 1156 1180 ! 1157 1181 END SUBROUTINE mpprecv … … 1833 1857 IF( nbondi == -1 ) THEN 1834 1858 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 ) 1835 CALL mpprecv( 1, t2ew(1,1,2), imigr )1859 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea ) 1836 1860 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 1837 1861 ELSEIF( nbondi == 0 ) THEN 1838 1862 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 1839 1863 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 ) 1840 CALL mpprecv( 1, t2ew(1,1,2), imigr )1841 CALL mpprecv( 2, t2we(1,1,2), imigr )1864 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea ) 1865 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe ) 1842 1866 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 1843 1867 IF(l_isend) CALL mpi_wait( ml_req2, ml_stat, ml_err ) 1844 1868 ELSEIF( nbondi == 1 ) THEN 1845 1869 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 1846 CALL mpprecv( 2, t2we(1,1,2), imigr )1870 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe ) 1847 1871 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 1848 1872 ENDIF … … 1879 1903 IF( nbondj == -1 ) THEN 1880 1904 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 ) 1881 CALL mpprecv( 3, t2ns(1,1,2), imigr )1905 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono ) 1882 1906 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 1883 1907 ELSEIF( nbondj == 0 ) THEN 1884 1908 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 1885 1909 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 ) 1886 CALL mpprecv( 3, t2ns(1,1,2), imigr )1887 CALL mpprecv( 4, t2sn(1,1,2), imigr )1910 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono ) 1911 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso ) 1888 1912 IF( l_isend ) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 1889 1913 IF( l_isend ) CALL mpi_wait( ml_req2, ml_stat, ml_err ) 1890 1914 ELSEIF( nbondj == 1 ) THEN 1891 1915 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 1892 CALL mpprecv( 4, t2sn(1,1,2), imigr )1916 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso) 1893 1917 IF( l_isend ) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 1894 1918 ENDIF … … 2209 2233 INTEGER :: ierr, itaille, ildi, ilei, iilb 2210 2234 INTEGER :: ijpj, ijpjm1, ij, iproc 2235 INTEGER, DIMENSION (jpmaxngh) :: ml_req_nf ! for mpi_isend when avoiding mpi_allgather 2236 INTEGER :: ml_err ! for mpi_isend when avoiding mpi_allgather 2237 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for mpi_isend when avoiding mpi_allgather 2211 2238 !!---------------------------------------------------------------------- 2212 2239 ! 2213 2240 ijpj = 4 2241 ityp = -1 2214 2242 ijpjm1 = 3 2215 2243 ztab(:,:,:) = 0.e0 … … 2222 2250 ! ! Build in procs of ncomm_north the znorthgloio 2223 2251 itaille = jpi * jpk * ijpj 2224 CALL MPI_ALLGATHER( znorthloc , itaille, MPI_DOUBLE_PRECISION, & 2225 & znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2226 ! 2227 ! ! recover the global north array 2228 DO jr = 1, ndim_rank_north 2229 iproc = nrank_north(jr) + 1 2230 ildi = nldit (iproc) 2231 ilei = nleit (iproc) 2232 iilb = nimppt(iproc) 2233 DO jj = 1, 4 2234 DO ji = ildi, ilei 2235 ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr) 2252 IF ( l_north_nogather ) THEN 2253 ! 2254 ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 2255 ! (in nemo_northcomms) as being involved in this process' northern boundary exchange 2256 ! 2257 DO jj = nlcj-ijpj+1, nlcj ! First put local values into the global array 2258 ij = jj - nlcj + ijpj 2259 DO ji = 1, nlci 2260 ztab(ji+nimpp-1,ij,:) = pt3d(ji,jj,:) 2236 2261 END DO 2237 2262 END DO 2238 END DO 2263 2264 ! 2265 ! Set the exchange type in order to access the correct list of active neighbours 2266 ! 2267 SELECT CASE ( cd_type ) 2268 CASE ( 'T' , 'W' ) 2269 ityp = 1 2270 CASE ( 'U' ) 2271 ityp = 2 2272 CASE ( 'V' ) 2273 ityp = 3 2274 CASE ( 'F' ) 2275 ityp = 4 2276 CASE ( 'I' ) 2277 ityp = 5 2278 CASE DEFAULT 2279 ityp = -1 ! Set a default value for unsupported types which 2280 ! will cause a fallback to the mpi_allgather method 2281 END SELECT 2282 IF ( ityp .gt. 0 ) THEN 2283 2284 DO jr = 1,nsndto(ityp) 2285 CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 2286 END DO 2287 DO jr = 1,nsndto(ityp) 2288 CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp)) 2289 iproc = isendto(jr,ityp) + 1 2290 ildi = nldit (iproc) 2291 ilei = nleit (iproc) 2292 iilb = nimppt(iproc) 2293 DO jj = 1, ijpj 2294 DO ji = ildi, ilei 2295 ztab(ji+iilb-1,jj,:) = zfoldwk(ji,jj,:) 2296 END DO 2297 END DO 2298 END DO 2299 IF (l_isend) THEN 2300 DO jr = 1,nsndto(ityp) 2301 CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2302 END DO 2303 ENDIF 2304 2305 ENDIF 2306 2307 ENDIF 2308 2309 IF ( ityp .lt. 0 ) THEN 2310 CALL MPI_ALLGATHER( znorthloc , itaille, MPI_DOUBLE_PRECISION, & 2311 & znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2312 ! 2313 DO jr = 1, ndim_rank_north ! recover the global north array 2314 iproc = nrank_north(jr) + 1 2315 ildi = nldit (iproc) 2316 ilei = nleit (iproc) 2317 iilb = nimppt(iproc) 2318 DO jj = 1, ijpj 2319 DO ji = ildi, ilei 2320 ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr) 2321 END DO 2322 END DO 2323 END DO 2324 ENDIF 2325 ! 2326 ! The ztab array has been either: 2327 ! a. Fully populated by the mpi_allgather operation or 2328 ! b. Had the active points for this domain and northern neighbours populated 2329 ! by peer to peer exchanges 2330 ! Either way the array may be folded by lbc_nfd and the result for the span of 2331 ! this domain will be identical. 2239 2332 ! 2240 2333 CALL lbc_nfd( ztab, cd_type, psgn ) ! North fold boundary condition … … 2272 2365 INTEGER :: ierr, itaille, ildi, ilei, iilb 2273 2366 INTEGER :: ijpj, ijpjm1, ij, iproc 2367 INTEGER, DIMENSION (jpmaxngh) :: ml_req_nf ! for mpi_isend when avoiding mpi_allgather 2368 INTEGER :: ml_err ! for mpi_isend when avoiding mpi_allgather 2369 INTEGER, DIMENSION(MPI_STATUS_SIZE):: ml_stat ! for mpi_isend when avoiding mpi_allgather 2274 2370 !!---------------------------------------------------------------------- 2275 2371 ! 2276 2372 ijpj = 4 2373 ityp = -1 2277 2374 ijpjm1 = 3 2278 2375 ztab_2d(:,:) = 0.e0 … … 2285 2382 ! ! Build in procs of ncomm_north the znorthgloio_2d 2286 2383 itaille = jpi * ijpj 2287 CALL MPI_ALLGATHER( znorthloc_2d , itaille, MPI_DOUBLE_PRECISION, & 2288 & znorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2289 ! 2290 DO jr = 1, ndim_rank_north ! recover the global north array 2291 iproc = nrank_north(jr) + 1 2292 ildi=nldit (iproc) 2293 ilei=nleit (iproc) 2294 iilb=nimppt(iproc) 2295 DO jj = 1, 4 2296 DO ji = ildi, ilei 2297 ztab_2d(ji+iilb-1,jj) = znorthgloio_2d(ji,jj,jr) 2384 IF ( l_north_nogather ) THEN 2385 ! 2386 ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 2387 ! (in nemo_northcomms) as being involved in this process' northern boundary exchange 2388 ! 2389 DO jj = nlcj-ijpj+1, nlcj ! First put local values into the global array 2390 ij = jj - nlcj + ijpj 2391 DO ji = 1, nlci 2392 ztab_2d(ji+nimpp-1,ij) = pt2d(ji,jj) 2298 2393 END DO 2299 2394 END DO 2300 END DO 2395 2396 ! 2397 ! Set the exchange type in order to access the correct list of active neighbours 2398 ! 2399 SELECT CASE ( cd_type ) 2400 CASE ( 'T' , 'W' ) 2401 ityp = 1 2402 CASE ( 'U' ) 2403 ityp = 2 2404 CASE ( 'V' ) 2405 ityp = 3 2406 CASE ( 'F' ) 2407 ityp = 4 2408 CASE ( 'I' ) 2409 ityp = 5 2410 CASE DEFAULT 2411 ityp = -1 ! Set a default value for unsupported types which 2412 ! will cause a fallback to the mpi_allgather method 2413 END SELECT 2414 2415 IF ( ityp .gt. 0 ) THEN 2416 2417 DO jr = 1,nsndto(ityp) 2418 CALL mppsend(5, znorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 2419 END DO 2420 DO jr = 1,nsndto(ityp) 2421 CALL mpprecv(5, zfoldwk_2d, itaille, isendto(jr,ityp)) 2422 iproc = isendto(jr,ityp) + 1 2423 ildi = nldit (iproc) 2424 ilei = nleit (iproc) 2425 iilb = nimppt(iproc) 2426 DO jj = 1, ijpj 2427 DO ji = ildi, ilei 2428 ztab_2d(ji+iilb-1,jj) = zfoldwk_2d(ji,jj) 2429 END DO 2430 END DO 2431 END DO 2432 IF (l_isend) THEN 2433 DO jr = 1,nsndto(ityp) 2434 CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2435 END DO 2436 ENDIF 2437 2438 ENDIF 2439 2440 ENDIF 2441 2442 IF ( ityp .lt. 0 ) THEN 2443 CALL MPI_ALLGATHER( znorthloc_2d , itaille, MPI_DOUBLE_PRECISION, & 2444 & znorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2445 ! 2446 DO jr = 1, ndim_rank_north ! recover the global north array 2447 iproc = nrank_north(jr) + 1 2448 ildi = nldit (iproc) 2449 ilei = nleit (iproc) 2450 iilb = nimppt(iproc) 2451 DO jj = 1, ijpj 2452 DO ji = ildi, ilei 2453 ztab_2d(ji+iilb-1,jj) = znorthgloio_2d(ji,jj,jr) 2454 END DO 2455 END DO 2456 END DO 2457 ENDIF 2458 ! 2459 ! The ztab array has been either: 2460 ! a. Fully populated by the mpi_allgather operation or 2461 ! b. Had the active points for this domain and northern neighbours populated 2462 ! by peer to peer exchanges 2463 ! Either way the array may be folded by lbc_nfd and the result for the span of 2464 ! this domain will be identical. 2301 2465 ! 2302 2466 CALL lbc_nfd( ztab_2d, cd_type, psgn ) ! North fold boundary condition -
branches/2011/dev_NOC_2011_MERGE/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r2986 r3009 293 293 CALL dom_init ! Domain 294 294 295 IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) 296 295 297 IF( ln_ctl ) CALL prt_ctl_init ! Print control 296 298 … … 622 624 END SUBROUTINE factorise 623 625 626 SUBROUTINE nemo_northcomms 627 !!====================================================================== 628 !! *** ROUTINE nemo_northcomms *** 629 !! nemo_northcomms : Setup for north fold exchanges with explicit peer to peer messaging 630 !!===================================================================== 631 !!---------------------------------------------------------------------- 632 !! 633 !! ** Purpose : Initialization of the northern neighbours lists. 634 !!---------------------------------------------------------------------- 635 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 636 !!---------------------------------------------------------------------- 637 638 INTEGER :: ji, jj, jk, ij, jtyp ! dummy loop indices 639 INTEGER :: ijpj ! number of rows involved in north-fold exchange 640 INTEGER :: northcomms_alloc ! allocate return status 641 REAL(wp), ALLOCATABLE, DIMENSION ( :,: ) :: znnbrs ! workspace 642 LOGICAL, ALLOCATABLE, DIMENSION ( : ) :: lrankset ! workspace 643 644 IF(lwp) WRITE(numout,*) 645 IF(lwp) WRITE(numout,*) 'nemo_northcomms : Initialization of the northern neighbours lists' 646 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 647 648 !!---------------------------------------------------------------------- 649 ALLOCATE( znnbrs(jpi,jpj), stat = northcomms_alloc ) 650 ALLOCATE( lrankset(jpnij), stat = northcomms_alloc ) 651 IF( northcomms_alloc /= 0 ) THEN 652 WRITE(numout,cform_war) 653 WRITE(numout,*) 'northcomms_alloc : failed to allocate arrays' 654 CALL ctl_stop( 'STOP', 'nemo_northcomms : unable to allocate temporary arrays' ) 655 ENDIF 656 nsndto = 0 657 isendto = -1 658 ijpj = 4 659 ! 660 ! This routine has been called because ln_nnogather has been set true ( nammpp ) 661 ! However, these first few exchanges have to use the mpi_allgather method to 662 ! establish the neighbour lists to use in subsequent peer to peer exchanges. 663 ! Consequently, set l_north_nogather to be false here and set it true only after 664 ! the lists have been established. 665 ! 666 l_north_nogather = .FALSE. 667 ! 668 ! Exchange and store ranks on northern rows 669 670 DO jtyp = 1,4 671 672 lrankset = .FALSE. 673 znnbrs = narea 674 SELECT CASE (jtyp) 675 CASE(1) 676 CALL lbc_lnk( znnbrs, 'T', 1. ) ! Type 1: T,W-points 677 CASE(2) 678 CALL lbc_lnk( znnbrs, 'U', 1. ) ! Type 2: U-point 679 CASE(3) 680 CALL lbc_lnk( znnbrs, 'V', 1. ) ! Type 3: V-point 681 CASE(4) 682 CALL lbc_lnk( znnbrs, 'F', 1. ) ! Type 4: F-point 683 END SELECT 684 685 IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 686 DO jj = nlcj-ijpj+1, nlcj 687 ij = jj - nlcj + ijpj 688 DO ji = 1,jpi 689 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 690 & lrankset(INT(znnbrs(ji,jj))) = .true. 691 END DO 692 END DO 693 694 DO jj = 1,jpnij 695 IF ( lrankset(jj) ) THEN 696 nsndto(jtyp) = nsndto(jtyp) + 1 697 IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 698 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 699 & ' jpmaxngh will need to be increased ') 700 ENDIF 701 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 702 ENDIF 703 END DO 704 ENDIF 705 706 END DO 707 708 ! 709 ! Type 5: I-point 710 ! 711 ! ICE point exchanges may involve some averaging. The neighbours list is 712 ! built up using two exchanges to ensure that the whole stencil is covered. 713 ! lrankset should not be reset between these 'J' and 'K' point exchanges 714 715 jtyp = 5 716 lrankset = .FALSE. 717 znnbrs = narea 718 CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point 719 720 IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 721 DO jj = nlcj-ijpj+1, nlcj 722 ij = jj - nlcj + ijpj 723 DO ji = 1,jpi 724 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 725 & lrankset(INT(znnbrs(ji,jj))) = .true. 726 END DO 727 END DO 728 ENDIF 729 730 znnbrs = narea 731 CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point 732 733 IF ( njmppt(narea) .EQ. MAXVAL( njmppt )) THEN 734 DO jj = nlcj-ijpj+1, nlcj 735 ij = jj - nlcj + ijpj 736 DO ji = 1,jpi 737 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 738 & lrankset( INT(znnbrs(ji,jj))) = .true. 739 END DO 740 END DO 741 742 DO jj = 1,jpnij 743 IF ( lrankset(jj) ) THEN 744 nsndto(jtyp) = nsndto(jtyp) + 1 745 IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 746 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 747 & ' jpmaxngh will need to be increased ') 748 ENDIF 749 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 750 ENDIF 751 END DO 752 ! 753 ! For northern row areas, set l_north_nogather so that all subsequent exchanges 754 ! can use peer to peer communications at the north fold 755 ! 756 l_north_nogather = .TRUE. 757 ! 758 ENDIF 759 DEALLOCATE( znnbrs ) 760 DEALLOCATE( lrankset ) 761 762 END SUBROUTINE nemo_northcomms 624 763 !!====================================================================== 625 764 END MODULE nemogcm
Note: See TracChangeset
for help on using the changeset viewer.