- Timestamp:
- 2021-11-28T18:59:49+01:00 (3 years ago)
- Location:
- NEMO/branches/2021/ticket2632_r14588_theta_sbcblk
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/LBC/mppini.F90 (modified) (20 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette@14244 sette 11 ^/utils/CI/sette@HEAD sette 12
-
- Property svn:externals
-
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/LBC/mppini.F90
r14433 r15548 23 23 USE bdy_oce ! open BounDarY 24 24 ! 25 USE lbcnfd , ONLY : isendto, nsndto! Setup of north fold exchanges25 USE lbcnfd ! Setup of north fold exchanges 26 26 USE lib_mpp ! distribued memory computing library 27 27 USE iom ! nemo I/O library … … 62 62 !!---------------------------------------------------------------------- 63 63 ! 64 nn_hls = 1 65 jpiglo = Ni0glo + 2 * nn_hls 66 jpjglo = Nj0glo + 2 * nn_hls 67 jpimax = jpiglo 68 jpjmax = jpjglo 69 jpi = jpiglo 70 jpj = jpjglo 71 jpk = MAX( 2, jpkglo ) 72 jpij = jpi*jpj 73 jpni = 1 74 jpnj = 1 75 jpnij = jpni*jpnj 76 nimpp = 1 77 njmpp = 1 78 nidom = FLIO_DOM_NONE 64 nn_comm = 1 65 nn_hls = 1 66 jpiglo = Ni0glo + 2 * nn_hls 67 jpjglo = Nj0glo + 2 * nn_hls 68 jpimax = jpiglo 69 jpjmax = jpjglo 70 jpi = jpiglo 71 jpj = jpjglo 72 jpk = MAX( 2, jpkglo ) 73 jpij = jpi*jpj 74 jpni = 1 75 jpnj = 1 76 jpnij = jpni*jpnj 77 nimpp = 1 78 njmpp = 1 79 nidom = FLIO_DOM_NONE 80 ! 81 mpiSnei(:,:) = -1 82 mpiRnei(:,:) = -1 83 l_SelfPerio(1:2) = l_Iperio ! west, east periodicity by itself 84 l_SelfPerio(3:4) = l_Jperio ! south, north periodicity by itself 85 l_SelfPerio(5:8) = l_Iperio .AND. l_Jperio ! corners bi-periodicity by itself 86 l_IdoNFold = l_NFold ! is this process doing North fold? 79 87 ! 80 88 CALL init_doloop ! set start/end indices or do-loop depending on the halo width value (nn_hls) … … 89 97 ! 90 98 #if defined key_agrif 91 IF (.NOT.agrif_root()) THEN92 99 call agrif_nemo_init() 93 ENDIF94 100 #endif 95 101 END SUBROUTINE mpp_init … … 162 168 IF(lwp) THEN 163 169 WRITE(numout,*) ' Namelist nammpp' 164 IF( jpni < 1 .OR. jpnj < 1 170 IF( jpni < 1 .OR. jpnj < 1 ) THEN 165 171 WRITE(numout,*) ' jpni and jpnj will be calculated automatically' 166 172 ELSE … … 307 313 308 314 #if defined key_agrif 309 IF( .NOT. Agrif_Root() ) THEN ! AGRIF children: specific setting (cf. agrif_user.F90)310 315 CALL agrif_nemo_init() 311 ENDIF312 316 #endif 313 317 ! … … 327 331 njmpp = ijmppt(ii,ij) 328 332 ! 329 CALL init_doloop ! set start/end indices of do-loop, depending on the halo width value (nn_hls) 333 CALL init_doloop ! set start/end indices of do-loop, depending on the halo width value (nn_hls) 334 CALL init_locglo ! define now functions needed to convert indices from/to global to/from local domains 330 335 ! 331 336 IF(lwp) THEN … … 499 504 WRITE(numout,*) ' mpi nei no-we = ', mpinei(jpnw) , ' mpi nei no-ea = ', mpinei(jpne) 500 505 ENDIF 501 ! ! Prepare mpp north fold502 !503 llmpiNFold = jpni > 1 .AND. l_NFold ! is the North fold done with an MPI communication?504 l_IdoNFold = ijn(narea) == jpnj .AND. l_NFold ! is this process doing North fold?505 !506 IF( llmpiNFold ) THEN507 CALL mpp_ini_north508 IF (lwp) THEN509 WRITE(numout,*)510 WRITE(numout,*) ' ==>>> North fold boundary prepared for jpni >1'511 ENDIF512 IF (llwrtlay) THEN ! additional prints in layout.dat513 WRITE(inum,*)514 WRITE(inum,*)515 WRITE(inum,*) 'Number of subdomains located along the north fold : ', ndim_rank_north516 WRITE(inum,*) 'Rank of the subdomains located along the north fold : ', ndim_rank_north517 DO jp = 1, ndim_rank_north, 5518 WRITE(inum,*) nrank_north( jp:MINVAL( (/jp+4,ndim_rank_north/) ) )519 END DO520 ENDIF521 IF ( l_IdoNFold .AND. ln_nnogather ) THEN522 CALL init_nfdcom ! northfold neighbour lists523 IF (llwrtlay) THEN524 WRITE(inum,*)525 WRITE(inum,*) 'north fold exchanges with explicit point-to-point messaging :'526 WRITE(inum,*) ' nsndto : ', nsndto527 WRITE(inum,*) ' isendto : ', isendto(1:nsndto)528 ENDIF529 ENDIF530 ENDIF531 506 ! 532 507 CALL mpp_ini_nc(nn_hls) ! Initialize communicator for neighbourhood collective communications … … 535 510 mpi_nc_com8(jh) = mpi_nc_com8(nn_hls) 536 511 END DO 537 ! 538 CALL init_excl_landpt ! exclude exchanges which contain only land points 539 ! 540 ! Save processor layout changes in ascii file 512 ! ! Exclude exchanges which contain only land points 513 ! 514 IF( jpnij > 1 ) CALL init_excl_landpt 515 ! 516 ! ! Prepare mpp north fold 517 ! 518 llmpiNFold = jpni > 1 .AND. l_NFold ! is the North fold done with an MPI communication? 519 l_IdoNFold = ijn(narea) == jpnj .AND. l_NFold ! is this process doing North fold? 520 ! 521 IF( llmpiNFold ) CALL init_nfdcom( llwrtlay, inum ) ! init northfold communication, must be done after init_excl_landpt 522 ! 523 ! ! Save processor layout changes in ascii file 524 ! 541 525 DO jh = 1, n_hlsmax ! different halo size 542 526 DO ji = 1, 8 … … 632 616 klci(1:iresti ,:) = kimax 633 617 klci(iresti+1:knbi ,:) = kimax-1 634 IF( MINVAL(klci) < 2*i2hls ) THEN635 WRITE(ctmp1,*) ' mpp_basesplit: minimum value of jpi must be >= ', 2*i2hls618 IF( MINVAL(klci) < 3*khls ) THEN 619 WRITE(ctmp1,*) ' mpp_basesplit: minimum value of jpi must be >= ', 3*khls 636 620 WRITE(ctmp2,*) ' We have ', MINVAL(klci) 637 CALL ctl_stop( 'STOP', ctmp1, ctmp2 )621 CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 638 622 ENDIF 639 623 IF( l_NFold ) THEN … … 650 634 ENDIF 651 635 klcj(:,1:irestj) = kjmax 652 IF( MINVAL(klcj) < 2*i2hls ) THEN653 WRITE(ctmp1,*) ' mpp_basesplit: minimum value of jpj must be >= ', 2*i2hls636 IF( MINVAL(klcj) < 3*khls ) THEN 637 WRITE(ctmp1,*) ' mpp_basesplit: minimum value of jpj must be >= ', 3*khls 654 638 WRITE(ctmp2,*) ' We have ', MINVAL(klcj) 655 639 CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) … … 729 713 iszjref = jpiglo*jpjglo+1 730 714 ! 731 iszimin = 4*nn_hls ! minimum size of the MPI subdomain so halos are always adressing neighbor inner domain 732 iszjmin = 4*nn_hls 715 ! WARNING, see also init_excl_landpt: minimum subdomain size defined here according to nn_hls (and not n_hlsmax) 716 ! --> If, one day, we want to use local halos largers than nn_hls, we must replace nn_hls by n_hlsmax 717 ! 718 iszimin = 3*nn_hls ! minimum size of the MPI subdomain so halos are always adressing neighbor inner domain 719 iszjmin = 3*nn_hls 733 720 IF( c_NFtype == 'T' ) iszjmin = MAX(iszjmin, 2+3*nn_hls) ! V and F folding must be outside of southern halos 734 721 IF( c_NFtype == 'F' ) iszjmin = MAX(iszjmin, 1+3*nn_hls) ! V and F folding must be outside of southern halos … … 760 747 ENDIF 761 748 END DO 749 IF( inbimax == 0 ) THEN 750 WRITE(ctmp1,'(a,i2,a,i2)') ' mpp_ini bestpartition: Ni0glo (', Ni0glo, ') is too small to be used with nn_hls = ', nn_hls 751 CALL ctl_stop( 'STOP', ctmp1 ) 752 ENDIF 753 IF( inbjmax == 0 ) THEN 754 WRITE(ctmp1,'(a,i2,a,i2)') ' mpp_ini bestpartition: Nj0glo (', Nj0glo, ') is too small to be used with nn_hls = ', nn_hls 755 CALL ctl_stop( 'STOP', ctmp1 ) 756 ENDIF 762 757 763 758 ! combine these 2 lists to get all possible knbi*knbj < inbijmax … … 1153 1148 INTEGER :: iiwe, iiea, iist, iisz 1154 1149 INTEGER :: ijso, ijno, ijst, ijsz 1155 LOGICAL :: llsave1156 1150 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zmsk 1157 1151 LOGICAL , DIMENSION(Ni_0,Nj_0,1) :: lloce … … 1162 1156 ! 1163 1157 ! Here we look only at communications excluding the NP folding. 1164 ! As lbcnfd not validated if halo size /= nn_hls, we switch if off temporary... 1165 llsave = l_IdoNFold 1158 ! --> we switch off lbcnfd at this stage (init_nfdcom called after init_excl_landpt)... 1166 1159 l_IdoNFold = .FALSE. 1167 1160 ! 1168 DO jh = 1, n_hlsmax ! different halo size 1161 ! WARNING, see also bestpartition: minimum subdomain size defined in bestpartition according to nn_hls. 1162 ! If, one day, we want to use local halos largers than nn_hls, we must replace nn_hls by n_hlsmax in bestpartition 1163 ! 1164 DO jh = 1, MIN(nn_hls, n_hlsmax) ! different halo size 1169 1165 ! 1170 1166 ipi = Ni_0 + 2*jh ! local domain size … … 1174 1170 zmsk(jh+1:jh+Ni_0,jh+1:jh+Nj_0) = REAL(COUNT(lloce, dim = 3), wp) ! define inner domain -> need REAL to use lbclnk 1175 1171 CALL lbc_lnk('mppini', zmsk, 'T', 1._wp, khls = jh) ! fill halos 1172 ! Beware, coastal F points can be used in the code -> we may need communications for these points F points even if tmask = 0 1173 ! -> the mask we must use here is equal to 1 as soon as one of the 4 neighbours is oce (sum of the mask, not multiplication) 1174 zmsk(jh+1:jh+Ni_0,jh+1:jh+Nj_0) = zmsk(jh+1:jh+Ni_0,jh+1 :jh+Nj_0 ) + zmsk(jh+1+1:jh+Ni_0+1,jh+1 :jh+Nj_0 ) & 1175 & + zmsk(jh+1:jh+Ni_0,jh+1+1:jh+Nj_0+1) + zmsk(jh+1+1:jh+Ni_0+1,jh+1+1:jh+Nj_0+1) 1176 CALL lbc_lnk('mppini', zmsk, 'T', 1._wp, khls = jh) ! fill halos again! 1176 1177 ! 1177 iiwe = jh ; iiea = Ni_0 ! bottom-left cor fer - 1 of the sent data1178 iiwe = jh ; iiea = Ni_0 ! bottom-left corner - 1 of the sent data 1178 1179 ijso = jh ; ijno = Nj_0 1179 1180 IF( nn_comm == 1 ) THEN 1180 1181 iist = 0 ; iisz = ipi 1181 ijst = 0 ; ijsz = ipj1182 ijst = jh ; ijsz = Nj_0 1182 1183 ELSE 1183 1184 iist = jh ; iisz = Ni_0 … … 1195 1196 IF( NINT(SUM( zmsk(iiea+1:iiea+jh ,ijno+1:ijno+jh ) )) == 0 ) mpiSnei(jh,jpne) = -1 1196 1197 ! 1197 iiwe = iiwe-jh ; iiea = iiea+jh ! bottom-left cor fer - 1 of the received data1198 iiwe = iiwe-jh ; iiea = iiea+jh ! bottom-left corner - 1 of the received data 1198 1199 ijso = ijso-jh ; ijno = ijno+jh 1199 1200 ! do not send if we send only land points … … 1221 1222 ! 1222 1223 END DO 1223 l_IdoNFold = llsave1224 1224 1225 1225 END SUBROUTINE init_excl_landpt … … 1266 1266 1267 1267 1268 SUBROUTINE init_nfdcom 1268 SUBROUTINE init_nfdcom( ldwrtlay, knum ) 1269 1269 !!---------------------------------------------------------------------- 1270 1270 !! *** ROUTINE init_nfdcom *** … … 1276 1276 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 1277 1277 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 1278 !!---------------------------------------------------------------------- 1279 INTEGER :: sxM, dxM, sxT, dxT, jn 1280 !!---------------------------------------------------------------------- 1281 ! 1282 !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 1283 sxM = jpiglo - nimpp - jpi + 1 1284 !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 1285 dxM = jpiglo - nimpp + 2 1286 ! 1287 ! loop over the other north-fold processes to find the processes 1288 ! managing the points belonging to the sxT-dxT range 1289 ! 1290 nsndto = 0 1291 DO jn = 1, jpni 1278 !! 3.0 ! 2021-09 complete rewrite using informations from gather north fold 1279 !!---------------------------------------------------------------------- 1280 LOGICAL, INTENT(in ) :: ldwrtlay ! true if additional prints in layout.dat 1281 INTEGER, INTENT(in ) :: knum ! layout.dat unit 1282 ! 1283 REAL(wp), DIMENSION(jpi,jpj,2,4) :: zinfo 1284 INTEGER , DIMENSION(10) :: irknei ! too many elements but safe... 1285 INTEGER :: ji, jj, jg, jn ! dummy loop indices 1286 LOGICAL :: lnew 1287 !!---------------------------------------------------------------------- 1288 ! 1289 IF (lwp) THEN 1290 WRITE(numout,*) 1291 WRITE(numout,*) ' ==>>> North fold boundary prepared for jpni >1' 1292 ENDIF 1293 ! 1294 CALL mpp_ini_northgather ! we need to init the nfd with gathering in all cases as it is used to define the no-gather case 1295 ! 1296 IF(ldwrtlay) THEN ! additional prints in layout.dat 1297 WRITE(knum,*) 1298 WRITE(knum,*) 1299 WRITE(knum,*) 'Number of subdomains located along the north fold : ', ndim_rank_north 1300 WRITE(knum,*) 'Rank of the subdomains located along the north fold : ', ndim_rank_north 1301 DO jn = 1, ndim_rank_north, 5 1302 WRITE(knum,*) nrank_north( jn:MINVAL( (/jn+4,ndim_rank_north/) ) ) 1303 END DO 1304 ENDIF 1305 1306 nfd_nbnei = 0 ! defaul def (useless?) 1307 IF( ln_nnogather ) THEN 1292 1308 ! 1293 sxT = nfimpp(jn) ! sxT = 1st point (in the global domain) of the jn process1294 dxT = nfimpp(jn) + nfjpi(jn) - 1 ! dxT = last point (in the global domain) of the jn process1309 ! Use the "gather nfd" to know how to do the nfd: for ji point, which process send data from which of its ji-index? 1310 ! Note that nfd is perfectly symetric: I receive data from X <=> I send data to X (-> no deadlock) 1295 1311 ! 1296 IF ( sxT < sxM .AND. sxM < dxT ) THEN 1297 nsndto = nsndto + 1 1298 isendto(nsndto) = jn 1299 ELSEIF( sxM <= sxT .AND. dxM >= dxT ) THEN 1300 nsndto = nsndto + 1 1301 isendto(nsndto) = jn 1302 ELSEIF( dxM < dxT .AND. sxT < dxM ) THEN 1303 nsndto = nsndto + 1 1304 isendto(nsndto) = jn 1305 ENDIF 1312 zinfo(:,:,:,:) = HUGE(0._wp) ! default def to make sure we don't use the halos 1313 DO jg = 1, 4 ! grid type: T, U, V, F 1314 DO jj = nn_hls+1, jpj-nn_hls ! inner domain (warning do_loop_substitute not yet defined) 1315 DO ji = nn_hls+1, jpi-nn_hls ! inner domain (warning do_loop_substitute not yet defined) 1316 zinfo(ji,jj,1,jg) = REAL(narea, wp) ! mpi_rank + 1 (as default lbc_lnk fill is 0 1317 zinfo(ji,jj,2,jg) = REAL(ji, wp) ! ji of this proc 1318 END DO 1319 END DO 1320 END DO 1306 1321 ! 1307 END DO 1322 ln_nnogather = .FALSE. ! force "classical" North pole folding to fill all halos -> should be no more HUGE values... 1323 CALL lbc_lnk( 'mppini', zinfo(:,:,:,1), 'T', 1._wp ) ! Do 4 calls instead of 1 to save memory as the nogather version 1324 CALL lbc_lnk( 'mppini', zinfo(:,:,:,2), 'U', 1._wp ) ! creates buffer arrays with jpiglo as the first dimension 1325 CALL lbc_lnk( 'mppini', zinfo(:,:,:,3), 'V', 1._wp ) ! 1326 CALL lbc_lnk( 'mppini', zinfo(:,:,:,4), 'F', 1._wp ) ! 1327 ln_nnogather = .TRUE. 1328 1329 IF( l_IdoNFold ) THEN ! only the procs involed in the NFD must take care of this 1330 1331 ALLOCATE( nfd_rksnd(jpi,4), nfd_jisnd(jpi,4) ) ! neighbour rand and remote ji-index for each grid (T, U, V, F) 1332 nfd_rksnd(:,:) = NINT( zinfo(:, jpj, 1, :) ) - 1 ! neighbour MPI rank 1333 nfd_jisnd(:,:) = NINT( zinfo(:, jpj, 2, :) ) - nn_hls ! neighbour ji index (shifted as we don't send the halos) 1334 WHERE( nfd_rksnd == -1 ) nfd_jisnd = 1 ! use ji=1 if no neighbour, see mpp_nfd_generic.h90 1335 1336 nfd_nbnei = 1 ! Number of neighbour sending data for the nfd. We have at least 1 neighbour! 1337 irknei(1) = nfd_rksnd(1,1) ! which is the 1st one (I can be neighbour of myself, exclude land-proc are also ok) 1338 DO jg = 1, 4 1339 DO ji = 1, jpi ! we must be able to fill the full line including halos 1340 lnew = .TRUE. ! new neighbour? 1341 DO jn = 1, nfd_nbnei 1342 IF( irknei(jn) == nfd_rksnd(ji,jg) ) lnew = .FALSE. ! already found 1343 END DO 1344 IF( lnew ) THEN 1345 jn = nfd_nbnei + 1 1346 nfd_nbnei = jn 1347 irknei(jn) = nfd_rksnd(ji,jg) 1348 ENDIF 1349 END DO 1350 END DO 1351 1352 ALLOCATE( nfd_rknei(nfd_nbnei) ) 1353 nfd_rknei(:) = irknei(1:nfd_nbnei) 1354 ! re-number nfd_rksnd according to the indexes of nfd_rknei 1355 DO jn = 1, nfd_nbnei 1356 WHERE( nfd_rksnd == nfd_rknei(jn) ) nfd_rksnd = jn 1357 END DO 1358 1359 IF( ldwrtlay ) THEN 1360 WRITE(knum,*) 1361 WRITE(knum,*) 'north fold exchanges with explicit point-to-point messaging :' 1362 WRITE(knum,*) ' number of neighbours for the NF: nfd_nbnei : ', nfd_nbnei 1363 IF( nfd_nbnei > 0 ) WRITE(knum,*) ' neighbours MPI ranks : ', nfd_rknei 1364 ENDIF 1365 1366 ENDIF ! l_IdoNFold 1367 ! 1368 ENDIF ! ln_nnogather 1308 1369 ! 1309 1370 END SUBROUTINE init_nfdcom … … 1326 1387 Nj_0 = Nje0 - Njs0 + 1 1327 1388 ! 1328 ! old indices to be removed...1329 jpim1 = jpi-1 ! inner domain indices1330 jpjm1 = jpj-1 ! " "1331 1389 jpkm1 = jpk-1 ! " " 1332 1390 ! 1333 1391 END SUBROUTINE init_doloop 1334 1392 1393 1394 SUBROUTINE init_locglo 1395 !!---------------------------------------------------------------------- 1396 !! *** ROUTINE init_locglo *** 1397 !! 1398 !! ** Purpose : initialization of global domain <--> local domain indices 1399 !! 1400 !! ** Method : 1401 !! 1402 !! ** Action : - mig , mjg : local domain indices ==> global domain, including halos, indices 1403 !! - mig0, mjg0: local domain indices ==> global domain, excluding halos, indices 1404 !! - mi0 , mi1 : global domain indices ==> local domain indices 1405 !! - mj0 , mj1 (if global point not in the local domain ==> mi0>mi1 and/or mj0>mj1) 1406 !!---------------------------------------------------------------------- 1407 INTEGER :: ji, jj ! dummy loop argument 1408 !!---------------------------------------------------------------------- 1409 ! 1410 ALLOCATE( mig(jpi), mjg(jpj), mig0(jpi), mjg0(jpj) ) 1411 ALLOCATE( mi0(jpiglo), mi1(jpiglo), mj0(jpjglo), mj1(jpjglo) ) 1412 ! 1413 DO ji = 1, jpi ! local domain indices ==> global domain indices, including halos 1414 mig(ji) = ji + nimpp - 1 1415 END DO 1416 DO jj = 1, jpj 1417 mjg(jj) = jj + njmpp - 1 1418 END DO 1419 ! ! local domain indices ==> global domain indices, excluding halos 1420 ! 1421 mig0(:) = mig(:) - nn_hls 1422 mjg0(:) = mjg(:) - nn_hls 1423 ! ! global domain, including halos, indices ==> local domain indices 1424 ! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 1425 ! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. 1426 DO ji = 1, jpiglo 1427 mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) ) 1428 mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi ) ) 1429 END DO 1430 DO jj = 1, jpjglo 1431 mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) ) 1432 mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj ) ) 1433 END DO 1434 ! 1435 END SUBROUTINE init_locglo 1436 1335 1437 !!====================================================================== 1336 1438 END MODULE mppini
Note: See TracChangeset
for help on using the changeset viewer.
