Changeset 14789 for NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/LBC/mppini.F90
- Timestamp:
- 2021-05-05T13:18:04+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/LBC/mppini.F90 (modified) (51 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev _r12970_AGRIF_CMEMSext/AGRIF5 ^/vendors/AGRIF/dev@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 ^/vendors/PPR@HEAD ext/PPR 8 9 9 10 # SETTE 10 ^/utils/CI/sette@1 3559sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/LBC/mppini.F90
r13490 r14789 9 9 !! NEMO 1.0 ! 2004-01 (G. Madec, J.M Molines) F90 : free form , north fold jpni > 1 10 10 !! 3.4 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) add init_nfdcom 11 !! 3. ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) init_nfdcom: setup avoiding MPI communication 11 !! 3. ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) init_nfdcom: setup avoiding MPI communication 12 12 !! 4.0 ! 2016-06 (G. Madec) use domain configuration file instead of bathymetry file 13 13 !! 4.0 ! 2017-06 (J.M. Molines, T. Lovato) merge of mppini and mppini_2 … … 16 16 !!---------------------------------------------------------------------- 17 17 !! mpp_init : Lay out the global domain over processors with/without land processor elimination 18 !! init_ioipsl: IOIPSL initialization in mpp 18 !! init_ioipsl: IOIPSL initialization in mpp 19 19 !! init_nfdcom: Setup for north fold exchanges with explicit point-to-point messaging 20 !! init_doloop: set the starting/ending indices of DO-loop used in do_loop_substitute 20 !! init_doloop: set the starting/ending indices of DO-loop used in do_loop_substitute 21 21 !!---------------------------------------------------------------------- 22 22 USE dom_oce ! ocean space and time domain 23 USE bdy_oce ! open BounDarY 23 USE bdy_oce ! open BounDarY 24 24 ! 25 USE lbcnfd , ONLY : isendto, nsndto ! Setup of north fold exchanges 25 USE lbcnfd , ONLY : isendto, nsndto ! Setup of north fold exchanges 26 26 USE lib_mpp ! distribued memory computing library 27 USE iom ! nemo I/O library 27 USE iom ! nemo I/O library 28 28 USE ioipsl ! I/O IPSL library 29 29 USE in_out_manager ! I/O Manager … … 36 36 PUBLIC mpp_basesplit ! called by prtctl 37 37 PUBLIC mpp_is_ocean ! called by prtctl 38 38 39 39 INTEGER :: numbot = -1 ! 'bottom_level' local logical unit 40 40 INTEGER :: numbdy = -1 ! 'bdy_msk' local logical unit 41 41 42 42 !!---------------------------------------------------------------------- 43 43 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 44 !! $Id$ 44 !! $Id$ 45 45 !! Software governed by the CeCILL license (see ./LICENSE) 46 46 !!---------------------------------------------------------------------- 47 47 CONTAINS 48 48 49 #if ! defined key_mpp_mpi49 #if defined key_mpi_off 50 50 !!---------------------------------------------------------------------- 51 51 !! Default option : shared memory computing … … 69 69 jpi = jpiglo 70 70 jpj = jpjglo 71 jpk = jpkglo 72 jpim1 = jpi-1 ! inner domain indices 73 jpjm1 = jpj-1 ! " " 74 jpkm1 = MAX( 1, jpk-1 ) ! " " 71 jpk = MAX( 2, jpkglo ) 75 72 jpij = jpi*jpj 76 73 jpni = 1 … … 79 76 nimpp = 1 80 77 njmpp = 1 81 nbondi = 282 nbondj = 283 78 nidom = FLIO_DOM_NONE 84 npolj = 0 85 IF( jperio == 3 .OR. jperio == 4 ) npolj = 3 86 IF( jperio == 5 .OR. jperio == 6 ) npolj = 5 87 l_Iperio = jpni == 1 .AND. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7) 88 l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7) 89 ! 90 CALL init_doloop ! set start/end indices or do-loop depending on the halo width value (nn_hls) 79 ! 80 CALL init_doloop ! set start/end indices or do-loop depending on the halo width value (nn_hls) 91 81 ! 92 82 IF(lwp) THEN … … 94 84 WRITE(numout,*) 'mpp_init : NO massively parallel processing' 95 85 WRITE(numout,*) '~~~~~~~~ ' 96 WRITE(numout,*) ' l_Iperio = ', l_Iperio, ' l_Jperio = ', l_Jperio 97 WRITE(numout,*) ' n polj = ', npolj , ' njmpp = ', njmpp86 WRITE(numout,*) ' l_Iperio = ', l_Iperio, ' l_Jperio = ', l_Jperio 87 WRITE(numout,*) ' njmpp = ', njmpp 98 88 ENDIF 99 89 ! … … 107 97 #else 108 98 !!---------------------------------------------------------------------- 109 !! 'key_mpp_mpi'MPI massively parallel processing99 !! MPI massively parallel processing 110 100 !!---------------------------------------------------------------------- 111 101 … … 114 104 !!---------------------------------------------------------------------- 115 105 !! *** ROUTINE mpp_init *** 116 !! 106 !! 117 107 !! ** Purpose : Lay out the global domain over processors. 118 108 !! If land processors are to be eliminated, this program requires the … … 123 113 !! ** Method : Global domain is distributed in smaller local domains. 124 114 !! Periodic condition is a function of the local domain position 125 !! (global boundary or neighbouring domain) and of the global 126 !! periodic 127 !! Type : jperio global periodic condition 115 !! (global boundary or neighbouring domain) and of the global periodic 128 116 !! 129 117 !! ** Action : - set domain parameters 130 !! nimpp : longitudinal index 118 !! nimpp : longitudinal index 131 119 !! njmpp : latitudinal index 132 120 !! narea : number for local area 133 !! nbondi : mark for "east-west local boundary" 134 !! nbondj : mark for "north-south local boundary" 135 !! nproc : number for local processor 136 !! noea : number for local neighboring processor 137 !! nowe : number for local neighboring processor 138 !! noso : number for local neighboring processor 139 !! nono : number for local neighboring processor 140 !!---------------------------------------------------------------------- 141 INTEGER :: ji, jj, jn, jproc, jarea ! dummy loop indices 142 INTEGER :: inijmin 143 INTEGER :: inum ! local logical unit 144 INTEGER :: idir, ifreq ! local integers 145 INTEGER :: ii, il1, ili, imil ! - - 146 INTEGER :: ij, il2, ilj, ijm1 ! - - 147 INTEGER :: iino, ijno, iiso, ijso ! - - 148 INTEGER :: iiea, ijea, iiwe, ijwe ! - - 149 INTEGER :: iarea0 ! - - 150 INTEGER :: ierr, ios ! 151 INTEGER :: inbi, inbj, iimax, ijmax, icnt1, icnt2 121 !! mpinei : number of neighboring domains (starting at 0, -1 if no neighbourg) 122 !!---------------------------------------------------------------------- 123 INTEGER :: ji, jj, jn, jp, jh 124 INTEGER :: ii, ij, ii2, ij2 125 INTEGER :: inijmin ! number of oce subdomains 126 INTEGER :: inum, inum0 127 INTEGER :: ifreq, il1, imil, il2, ijm1 128 INTEGER :: ierr, ios 129 INTEGER :: inbi, inbj, iimax, ijmax, icnt1, icnt2 130 INTEGER, DIMENSION(16*n_hlsmax) :: ichanged 131 INTEGER, ALLOCATABLE, DIMENSION(: ) :: iin, ijn 132 INTEGER, ALLOCATABLE, DIMENSION(:,: ) :: iimppt, ijpi, ipproc 133 INTEGER, ALLOCATABLE, DIMENSION(:,: ) :: ijmppt, ijpj 134 INTEGER, ALLOCATABLE, DIMENSION(:,: ) :: impi 135 INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: inei 152 136 LOGICAL :: llbest, llauto 153 137 LOGICAL :: llwrtlay 138 LOGICAL :: llmpi_Iperio, llmpi_Jperio, llmpiNFold 154 139 LOGICAL :: ln_listonly 155 INTEGER, ALLOCATABLE, DIMENSION(:) :: iin, ii_nono, ii_noea ! 1D workspace 156 INTEGER, ALLOCATABLE, DIMENSION(:) :: ijn, ii_noso, ii_nowe ! - - 157 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iimppt, ijpi, ibondi, ipproc ! 2D workspace 158 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ijmppt, ijpj, ibondj, ipolj ! - - 159 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iie0, iis0, iono, ioea ! - - 160 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ije0, ijs0, ioso, iowe ! - - 161 LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: llisoce ! - - 140 LOGICAL, ALLOCATABLE, DIMENSION(:,: ) :: llisOce ! is not land-domain only? 141 LOGICAL, ALLOCATABLE, DIMENSION(:,:,:) :: llnei ! are neighbourgs existing? 162 142 NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file, & 163 143 & ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta, & 164 & cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta, & 144 & cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta, & 165 145 & ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, & 166 146 & cn_ice, nn_ice_dta, & 167 147 & ln_vol, nn_volctl, nn_rimwidth 168 NAMELIST/nammpp/ jpni, jpnj, nn_hls, ln_nnogather, ln_listonly 148 NAMELIST/nammpp/ jpni, jpnj, nn_hls, ln_nnogather, ln_listonly, nn_comm 169 149 !!---------------------------------------------------------------------- 170 150 ! … … 177 157 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in reference namelist' ) 178 158 READ ( numnam_cfg, nammpp, IOSTAT = ios, ERR = 902 ) 179 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist' ) 159 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist' ) 180 160 ! 181 161 nn_hls = MAX(1, nn_hls) ! nn_hls must be > 0 … … 194 174 IF(lwm) WRITE( numond, nammpp ) 195 175 ! 196 !!!------------------------------------197 !!! nn_hls shloud be read in nammpp198 !!!------------------------------------199 176 jpiglo = Ni0glo + 2 * nn_hls 200 177 jpjglo = Nj0glo + 2 * nn_hls … … 214 191 ! ----------------------------------- 215 192 ! 216 ! If dimensions of processors grid weren't specified in the namelist file193 ! If dimensions of MPI processes grid weren't specified in the namelist file 217 194 ! then we calculate them here now that we have our communicator size 218 195 IF(lwp) THEN 196 WRITE(numout,*) 219 197 WRITE(numout,*) 'mpp_init:' 220 198 WRITE(numout,*) '~~~~~~~~ ' 221 WRITE(numout,*)222 199 ENDIF 223 200 IF( jpni < 1 .OR. jpnj < 1 ) THEN … … 259 236 ENDIF 260 237 ENDIF 261 238 262 239 ! look for land mpi subdomains... 263 ALLOCATE( llis oce(jpni,jpnj) )264 CALL mpp_is_ocean( llis oce )265 inijmin = COUNT( llis oce ) ! number of oce subdomains240 ALLOCATE( llisOce(jpni,jpnj) ) 241 CALL mpp_is_ocean( llisOce ) 242 inijmin = COUNT( llisOce ) ! number of oce subdomains 266 243 267 244 IF( mppsize < inijmin ) THEN ! too many oce subdomains: can happen only if jpni and jpnj are prescribed... … … 320 297 9003 FORMAT (a, i5) 321 298 322 ALLOCATE( nfimpp(jpni ) , nfproc(jpni ) , nfjpi(jpni ) , & 323 & nimppt(jpnij) , ibonit(jpnij) , jpiall(jpnij) , jpjall(jpnij) , & 324 & njmppt(jpnij) , ibonjt(jpnij) , nis0all(jpnij) , njs0all(jpnij) , & 325 & nie0all(jpnij) , nje0all(jpnij) , & 326 & iin(jpnij), ii_nono(jpnij), ii_noea(jpnij), & 327 & ijn(jpnij), ii_noso(jpnij), ii_nowe(jpnij), & 328 & iimppt(jpni,jpnj), ijpi(jpni,jpnj), ibondi(jpni,jpnj), ipproc(jpni,jpnj), & 329 & ijmppt(jpni,jpnj), ijpj(jpni,jpnj), ibondj(jpni,jpnj), ipolj(jpni,jpnj), & 330 & iie0(jpni,jpnj), iis0(jpni,jpnj), iono(jpni,jpnj), ioea(jpni,jpnj), & 331 & ije0(jpni,jpnj), ijs0(jpni,jpnj), ioso(jpni,jpnj), iowe(jpni,jpnj), & 332 & STAT=ierr ) 299 ALLOCATE( nfimpp(jpni), nfproc(jpni), nfjpi(jpni), & 300 & iin(jpnij), ijn(jpnij), & 301 & iimppt(jpni,jpnj), ijmppt(jpni,jpnj), ijpi(jpni,jpnj), ijpj(jpni,jpnj), ipproc(jpni,jpnj), & 302 & inei(8,jpni,jpnj), llnei(8,jpni,jpnj), & 303 & impi(8,jpnij), & 304 & STAT=ierr ) 333 305 CALL mpp_sum( 'mppini', ierr ) 334 306 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'mpp_init: unable to allocate standard ocean arrays' ) 335 307 336 308 #if defined key_agrif 337 309 IF( .NOT. Agrif_Root() ) THEN ! AGRIF children: specific setting (cf. agrif_user.F90) … … 344 316 ! 345 317 CALL mpp_basesplit( jpiglo, jpjglo, nn_hls, jpni, jpnj, jpimax, jpjmax, iimppt, ijmppt, ijpi, ijpj ) 346 CALL mpp_getnum( llisoce, ipproc, iin, ijn ) 347 ! 348 !DO jn = 1, jpni 349 ! jproc = ipproc(jn,jpnj) 350 ! ii = iin(jproc+1) 351 ! ij = ijn(jproc+1) 352 ! nfproc(jn) = jproc 353 ! nfimpp(jn) = iimppt(ii,ij) 354 ! nfjpi (jn) = ijpi(ii,ij) 355 !END DO 356 nfproc(:) = ipproc(:,jpnj) 357 nfimpp(:) = iimppt(:,jpnj) 358 nfjpi (:) = ijpi(:,jpnj) 318 CALL mpp_getnum( llisOce, ipproc, iin, ijn ) 319 ! 320 ii = iin(narea) 321 ij = ijn(narea) 322 jpi = ijpi(ii,ij) 323 jpj = ijpj(ii,ij) 324 jpk = MAX( 2, jpkglo ) 325 jpij = jpi*jpj 326 nimpp = iimppt(ii,ij) 327 njmpp = ijmppt(ii,ij) 328 ! 329 CALL init_doloop ! set start/end indices of do-loop, depending on the halo width value (nn_hls) 359 330 ! 360 331 IF(lwp) THEN … … 363 334 WRITE(numout,*) 364 335 WRITE(numout,*) ' defines mpp subdomains' 365 WRITE(numout,*) ' jpni = ', jpni 336 WRITE(numout,*) ' jpni = ', jpni 366 337 WRITE(numout,*) ' jpnj = ', jpnj 367 338 WRITE(numout,*) ' jpnij = ', jpnij 339 WRITE(numout,*) ' nimpp = ', nimpp 340 WRITE(numout,*) ' njmpp = ', njmpp 368 341 WRITE(numout,*) 369 342 WRITE(numout,*) ' sum ijpi(i,1) = ', sum(ijpi(:,1)), ' jpiglo = ', jpiglo 370 WRITE(numout,*) ' sum ijpj(1,j) = ', sum(ijpj(1,:)), ' jpjglo = ', jpjglo 371 ENDIF 372 373 ! 3. Subdomain description in the Regular Case 374 ! -------------------------------------------- 375 ! specific cases where there is no communication -> must do the periodicity by itself 376 ! Warning: because of potential land-area suppression, do not use nbond[ij] == 2 377 l_Iperio = jpni == 1 .AND. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7) 378 l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7) 379 380 DO jarea = 1, jpni*jpnj 381 ! 382 iarea0 = jarea - 1 383 ii = 1 + MOD(iarea0,jpni) 384 ij = 1 + iarea0/jpni 385 ili = ijpi(ii,ij) 386 ilj = ijpj(ii,ij) 387 ibondi(ii,ij) = 0 ! default: has e-w neighbours 388 IF( ii == 1 ) ibondi(ii,ij) = -1 ! first column, has only e neighbour 389 IF( ii == jpni ) ibondi(ii,ij) = 1 ! last column, has only w neighbour 390 IF( jpni == 1 ) ibondi(ii,ij) = 2 ! has no e-w neighbour 391 ibondj(ii,ij) = 0 ! default: has n-s neighbours 392 IF( ij == 1 ) ibondj(ii,ij) = -1 ! first row, has only n neighbour 393 IF( ij == jpnj ) ibondj(ii,ij) = 1 ! last row, has only s neighbour 394 IF( jpnj == 1 ) ibondj(ii,ij) = 2 ! has no n-s neighbour 395 396 ! Subdomain neighbors (get their zone number): default definition 397 ioso(ii,ij) = iarea0 - jpni 398 iowe(ii,ij) = iarea0 - 1 399 ioea(ii,ij) = iarea0 + 1 400 iono(ii,ij) = iarea0 + jpni 401 iis0(ii,ij) = 1 + nn_hls 402 iie0(ii,ij) = ili - nn_hls 403 ijs0(ii,ij) = 1 + nn_hls 404 ije0(ii,ij) = ilj - nn_hls 405 406 ! East-West periodicity: change ibondi, ioea, iowe 407 IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 ) THEN 408 IF( jpni /= 1 ) ibondi(ii,ij) = 0 ! redefine: all have e-w neighbours 409 IF( ii == 1 ) iowe(ii,ij) = iarea0 + (jpni-1) ! redefine: first column, address of w neighbour 410 IF( ii == jpni ) ioea(ii,ij) = iarea0 - (jpni-1) ! redefine: last column, address of e neighbour 411 ENDIF 412 413 ! Simple North-South periodicity: change ibondj, ioso, iono 414 IF( jperio == 2 .OR. jperio == 7 ) THEN 415 IF( jpnj /= 1 ) ibondj(ii,ij) = 0 ! redefine: all have n-s neighbours 416 IF( ij == 1 ) ioso(ii,ij) = iarea0 + jpni * (jpnj-1) ! redefine: first row, address of s neighbour 417 IF( ij == jpnj ) iono(ii,ij) = iarea0 - jpni * (jpnj-1) ! redefine: last row, address of n neighbour 418 ENDIF 419 420 ! North fold: define ipolj, change iono. Warning: we do not change ibondj... 421 ipolj(ii,ij) = 0 422 IF( jperio == 3 .OR. jperio == 4 ) THEN 423 ijm1 = jpni*(jpnj-1) 424 imil = ijm1+(jpni+1)/2 425 IF( jarea > ijm1 ) ipolj(ii,ij) = 3 426 IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4 427 IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1 ! MPI rank of northern neighbour 428 ENDIF 429 IF( jperio == 5 .OR. jperio == 6 ) THEN 430 ijm1 = jpni*(jpnj-1) 431 imil = ijm1+(jpni+1)/2 432 IF( jarea > ijm1) ipolj(ii,ij) = 5 433 IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6 434 IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1 ! MPI rank of northern neighbour 435 ENDIF 436 ! 437 END DO 438 439 ! 4. deal with land subdomains 440 ! ---------------------------- 441 ! 442 ! neighbour treatment: change ibondi, ibondj if next to a land zone 443 DO jarea = 1, jpni*jpnj 444 ii = 1 + MOD( jarea-1 , jpni ) 445 ij = 1 + (jarea-1) / jpni 446 ! land-only area with an active n neigbour 447 IF ( ipproc(ii,ij) == -1 .AND. 0 <= iono(ii,ij) .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN 448 iino = 1 + MOD( iono(ii,ij) , jpni ) ! ii index of this n neigbour 449 ijno = 1 + iono(ii,ij) / jpni ! ij index of this n neigbour 450 ! In case of north fold exchange: I am the n neigbour of my n neigbour!! (#1057) 451 ! --> for northern neighbours of northern row processors (in case of north-fold) 452 ! need to reverse the LOGICAL direction of communication 453 idir = 1 ! we are indeed the s neigbour of this n neigbour 454 IF( ij == jpnj .AND. ijno == jpnj ) idir = -1 ! both are on the last row, we are in fact the n neigbour 455 IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno) = 2 ! this n neigbour had only a s/n neigbour -> no more 456 IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir ! this n neigbour had both, n-s neighbours -> keep 1 457 ENDIF 458 ! land-only area with an active s neigbour 459 IF( ipproc(ii,ij) == -1 .AND. 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN 460 iiso = 1 + MOD( ioso(ii,ij) , jpni ) ! ii index of this s neigbour 461 ijso = 1 + ioso(ii,ij) / jpni ! ij index of this s neigbour 462 IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2 ! this s neigbour had only a n neigbour -> no more neigbour 463 IF( ibondj(iiso,ijso) == 0 ) ibondj(iiso,ijso) = 1 ! this s neigbour had both, n-s neighbours -> keep s neigbour 464 ENDIF 465 ! land-only area with an active e neigbour 466 IF( ipproc(ii,ij) == -1 .AND. 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= jpni*jpnj-1 ) THEN 467 iiea = 1 + MOD( ioea(ii,ij) , jpni ) ! ii index of this e neigbour 468 ijea = 1 + ioea(ii,ij) / jpni ! ij index of this e neigbour 469 IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2 ! this e neigbour had only a w neigbour -> no more neigbour 470 IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1 ! this e neigbour had both, e-w neighbours -> keep e neigbour 471 ENDIF 472 ! land-only area with an active w neigbour 473 IF( ipproc(ii,ij) == -1 .AND. 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN 474 iiwe = 1 + MOD( iowe(ii,ij) , jpni ) ! ii index of this w neigbour 475 ijwe = 1 + iowe(ii,ij) / jpni ! ij index of this w neigbour 476 IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2 ! this w neigbour had only a e neigbour -> no more neigbour 477 IF( ibondi(iiwe,ijwe) == 0 ) ibondi(iiwe,ijwe) = 1 ! this w neigbour had both, e-w neighbours -> keep w neigbour 478 ENDIF 479 END DO 480 481 ! 5. Subdomain print 482 ! ------------------ 483 IF(lwp) THEN 343 WRITE(numout,*) ' sum ijpj(1,j) = ', SUM(ijpj(1,:)), ' jpjglo = ', jpjglo 344 345 ! Subdomain grid print 484 346 ifreq = 4 485 347 il1 = 1 … … 504 366 9404 FORMAT(' * ' ,20(' ' ,i4,' * ') ) 505 367 ENDIF 506 507 ! just to save nono etc for all proc 508 ! warning ii*ij (zone) /= nproc (processors)! 509 ! ioso = zone number, ii_noso = proc number 510 ii_noso(:) = -1 511 ii_nono(:) = -1 512 ii_noea(:) = -1 513 ii_nowe(:) = -1 514 DO jproc = 1, jpnij 515 ii = iin(jproc) 516 ij = ijn(jproc) 517 IF( 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 518 iiso = 1 + MOD( ioso(ii,ij) , jpni ) 519 ijso = 1 + ioso(ii,ij) / jpni 520 ii_noso(jproc) = ipproc(iiso,ijso) 521 ENDIF 522 IF( 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN 523 iiwe = 1 + MOD( iowe(ii,ij) , jpni ) 524 ijwe = 1 + iowe(ii,ij) / jpni 525 ii_nowe(jproc) = ipproc(iiwe,ijwe) 526 ENDIF 527 IF( 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN 528 iiea = 1 + MOD( ioea(ii,ij) , jpni ) 529 ijea = 1 + ioea(ii,ij) / jpni 530 ii_noea(jproc)= ipproc(iiea,ijea) 531 ENDIF 532 IF( 0 <= iono(ii,ij) .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN 533 iino = 1 + MOD( iono(ii,ij) , jpni ) 534 ijno = 1 + iono(ii,ij) / jpni 535 ii_nono(jproc)= ipproc(iino,ijno) 536 ENDIF 537 END DO 538 539 ! 6. Change processor name 540 ! ------------------------ 541 ii = iin(narea) 542 ij = ijn(narea) 543 ! 544 ! set default neighbours 545 noso = ii_noso(narea) 546 nowe = ii_nowe(narea) 547 noea = ii_noea(narea) 548 nono = ii_nono(narea) 549 jpi = ijpi(ii,ij) 550 !!$ Nis0 = iis0(ii,ij) 551 !!$ Nie0 = iie0(ii,ij) 552 jpj = ijpj(ii,ij) 553 !!$ Njs0 = ijs0(ii,ij) 554 !!$ Nje0 = ije0(ii,ij) 555 nbondi = ibondi(ii,ij) 556 nbondj = ibondj(ii,ij) 557 nimpp = iimppt(ii,ij) 558 njmpp = ijmppt(ii,ij) 559 jpk = jpkglo ! third dim 560 ! 561 CALL init_doloop ! set start/end indices of do-loop, depending on the halo width value (nn_hls) 562 ! 563 jpim1 = jpi-1 ! inner domain indices 564 jpjm1 = jpj-1 ! " " 565 jpkm1 = MAX( 1, jpk-1 ) ! " " 566 jpij = jpi*jpj ! jpi x j 567 DO jproc = 1, jpnij 568 ii = iin(jproc) 569 ij = ijn(jproc) 570 jpiall (jproc) = ijpi(ii,ij) 571 nis0all(jproc) = iis0(ii,ij) 572 nie0all(jproc) = iie0(ii,ij) 573 jpjall (jproc) = ijpj(ii,ij) 574 njs0all(jproc) = ijs0(ii,ij) 575 nje0all(jproc) = ije0(ii,ij) 576 ibonit(jproc) = ibondi(ii,ij) 577 ibonjt(jproc) = ibondj(ii,ij) 578 nimppt(jproc) = iimppt(ii,ij) 579 njmppt(jproc) = ijmppt(ii,ij) 580 END DO 581 368 ! 369 ! Store informations for the north pole folding communications 370 nfproc(:) = ipproc(:,jpnj) 371 nfimpp(:) = iimppt(:,jpnj) 372 nfjpi (:) = ijpi(:,jpnj) 373 ! 374 ! 3. Define Western, Eastern, Southern and Northern neighbors + corners in the subdomain grid reference 375 ! ------------------------------------------------------------------------------------------------------ 376 ! 377 ! note that North fold is has specific treatment for its MPI communications. 378 ! This must not be treated as a "usual" communication with a northern neighbor. 379 ! -> North fold processes have no Northern neighbor in the definition done bellow 380 ! 381 llmpi_Iperio = jpni > 1 .AND. l_Iperio ! do i-periodicity with an MPI communication? 382 llmpi_Jperio = jpnj > 1 .AND. l_Jperio ! do j-periodicity with an MPI communication? 383 ! 384 l_SelfPerio(1:2) = l_Iperio .AND. jpni == 1 ! west, east periodicity by itself 385 l_SelfPerio(3:4) = l_Jperio .AND. jpnj == 1 ! south, north periodicity by itself 386 l_SelfPerio(5:8) = l_SelfPerio(jpwe) .AND. l_SelfPerio(jpso) ! corners bi-periodicity by itself 387 ! 388 ! define neighbors mapping (1/2): default definition: ignore if neighbours are land-only subdomains or not 389 DO jj = 1, jpnj 390 DO ji = 1, jpni 391 ! 392 IF ( llisOce(ji,jj) ) THEN ! this subdomain has some ocean: it has neighbours 393 ! 394 inum0 = ji - 1 + ( jj - 1 ) * jpni ! index in the subdomains grid. start at 0 395 ! 396 ! Is there a neighbor? 397 llnei(jpwe,ji,jj) = ji > 1 .OR. llmpi_Iperio ! West nei exists if not the first column or llmpi_Iperio 398 llnei(jpea,ji,jj) = ji < jpni .OR. llmpi_Iperio ! East nei exists if not the last column or llmpi_Iperio 399 llnei(jpso,ji,jj) = jj > 1 .OR. llmpi_Jperio ! South nei exists if not the first line or llmpi_Jperio 400 llnei(jpno,ji,jj) = jj < jpnj .OR. llmpi_Jperio ! North nei exists if not the last line or llmpi_Jperio 401 llnei(jpsw,ji,jj) = llnei(jpwe,ji,jj) .AND. llnei(jpso,ji,jj) ! So-We nei exists if both South and West nei exist 402 llnei(jpse,ji,jj) = llnei(jpea,ji,jj) .AND. llnei(jpso,ji,jj) ! So-Ea nei exists if both South and East nei exist 403 llnei(jpnw,ji,jj) = llnei(jpwe,ji,jj) .AND. llnei(jpno,ji,jj) ! No-We nei exists if both North and West nei exist 404 llnei(jpne,ji,jj) = llnei(jpea,ji,jj) .AND. llnei(jpno,ji,jj) ! No-Ea nei exists if both North and East nei exist 405 ! 406 ! Which index (starting at 0) have neighbors in the subdomains grid? 407 IF( llnei(jpwe,ji,jj) ) inei(jpwe,ji,jj) = inum0 - 1 + jpni * COUNT( (/ ji == 1 /) ) 408 IF( llnei(jpea,ji,jj) ) inei(jpea,ji,jj) = inum0 + 1 - jpni * COUNT( (/ ji == jpni /) ) 409 IF( llnei(jpso,ji,jj) ) inei(jpso,ji,jj) = inum0 - jpni + jpni * jpnj * COUNT( (/ jj == 1 /) ) 410 IF( llnei(jpno,ji,jj) ) inei(jpno,ji,jj) = inum0 + jpni - jpni * jpnj * COUNT( (/ jj == jpnj /) ) 411 IF( llnei(jpsw,ji,jj) ) inei(jpsw,ji,jj) = inei(jpso,ji,jj) - 1 + jpni * COUNT( (/ ji == 1 /) ) 412 IF( llnei(jpse,ji,jj) ) inei(jpse,ji,jj) = inei(jpso,ji,jj) + 1 - jpni * COUNT( (/ ji == jpni /) ) 413 IF( llnei(jpnw,ji,jj) ) inei(jpnw,ji,jj) = inei(jpno,ji,jj) - 1 + jpni * COUNT( (/ ji == 1 /) ) 414 IF( llnei(jpne,ji,jj) ) inei(jpne,ji,jj) = inei(jpno,ji,jj) + 1 - jpni * COUNT( (/ ji == jpni /) ) 415 ! 416 ELSE ! land-only domain has no neighbour 417 llnei(:,ji,jj) = .FALSE. 418 ENDIF 419 ! 420 END DO 421 END DO 422 ! 423 ! define neighbors mapping (2/2): check if neighbours are not land-only subdomains 424 DO jj = 1, jpnj 425 DO ji = 1, jpni 426 DO jn = 1, 8 427 IF( llnei(jn,ji,jj) ) THEN ! if a neighbour is existing -> this should not be a land-only domain 428 ii = 1 + MOD( inei(jn,ji,jj) , jpni ) 429 ij = 1 + inei(jn,ji,jj) / jpni 430 llnei(jn,ji,jj) = llisOce( ii, ij ) 431 ENDIF 432 END DO 433 END DO 434 END DO 435 ! 436 ! update index of the neighbours in the subdomains grid 437 WHERE( .NOT. llnei ) inei = -1 438 ! 582 439 ! Save processor layout in ascii file 583 440 IF (llwrtlay) THEN 584 441 CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 585 WRITE(inum,'(a)') ' jpnij jpimax jpjmax jpk jpiglo jpjglo'//& 586 & ' ( local: narea jpi jpj )' 587 WRITE(inum,'(6i8,a,3i8,a)') jpnij,jpimax,jpjmax,jpk,jpiglo,jpjglo,& 588 & ' ( local: ',narea,jpi,jpj,' )' 589 WRITE(inum,'(a)') 'nproc jpi jpj Nis0 Njs0 Nie0 Nje0 nimp njmp nono noso nowe noea nbondi nbondj ' 590 591 DO jproc = 1, jpnij 592 WRITE(inum,'(13i5,2i7)') jproc-1, jpiall(jproc), jpjall(jproc), & 593 & nis0all(jproc), njs0all(jproc), & 594 & nie0all(jproc), nje0all(jproc), & 595 & nimppt (jproc), njmppt (jproc), & 596 & ii_nono(jproc), ii_noso(jproc), & 597 & ii_nowe(jproc), ii_noea(jproc), & 598 & ibonit (jproc), ibonjt (jproc) 442 WRITE(inum,'(a)') ' jpnij jpimax jpjmax jpk jpiglo jpjglo ( local: narea jpi jpj )' 443 WRITE(inum,'(6i7,a,3i7,a)') jpnij,jpimax,jpjmax,jpk,jpiglo,jpjglo,' ( local: ',narea,jpi,jpj,' )' 444 WRITE(inum,*) 445 WRITE(inum, *) '------------------------------------' 446 WRITE(inum,'(a,i2)') ' Mapping of the default neighnourgs ' 447 WRITE(inum, *) '------------------------------------' 448 WRITE(inum,*) 449 WRITE(inum,'(a)') ' rank ii ij jpi jpj nimpp njmpp mpiwe mpiea mpiso mpino mpisw mpise mpinw mpine' 450 DO jp = 1, jpnij 451 ii = iin(jp) 452 ij = ijn(jp) 453 WRITE(inum,'(15i6)') jp-1, ii, ij, ijpi(ii,ij), ijpj(ii,ij), iimppt(ii,ij), ijmppt(ii,ij), inei(:,ii,ij) 599 454 END DO 600 END IF 601 602 ! ! north fold parameter 603 ! Defined npolj, either 0, 3 , 4 , 5 , 6 604 ! In this case the important thing is that npolj /= 0 605 ! Because if we go through these line it is because jpni >1 and thus 606 ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0 607 npolj = 0 608 ij = ijn(narea) 609 IF( jperio == 3 .OR. jperio == 4 ) THEN 610 IF( ij == jpnj ) npolj = 3 611 ENDIF 612 IF( jperio == 5 .OR. jperio == 6 ) THEN 613 IF( ij == jpnj ) npolj = 5 614 ENDIF 615 ! 616 nproc = narea-1 455 ENDIF 456 457 ! 458 ! 4. Define Western, Eastern, Southern and Northern neighbors + corners for each mpi process 459 ! ------------------------------------------------------------------------------------------ 460 ! 461 ! rewrite information from "subdomain grid" to mpi process list 462 ! Warning, for example: 463 ! position of the northern neighbor in the "subdomain grid" 464 ! position of the northern neighbor in the "mpi process list" 465 466 ! default definition: no neighbors 467 impi(:,:) = -1 ! (starting at 0, -1 if no neighbourg) 468 469 DO jp = 1, jpnij 470 ii = iin(jp) 471 ij = ijn(jp) 472 DO jn = 1, 8 473 IF( llnei(jn,ii,ij) ) THEN ! must be tested as some land-domain can be kept to fit mppsize 474 ii2 = 1 + MOD( inei(jn,ii,ij) , jpni ) 475 ij2 = 1 + inei(jn,ii,ij) / jpni 476 impi(jn,jp) = ipproc( ii2, ij2 ) 477 ENDIF 478 END DO 479 END DO 480 481 ! 482 ! 4. keep information for the local process 483 ! ----------------------------------------- 484 ! 485 ! set default neighbours 486 mpinei(:) = impi(:,narea) 487 DO jh = 1, n_hlsmax 488 mpiSnei(jh,:) = impi(:,narea) ! default definition 489 mpiRnei(jh,:) = impi(:,narea) 490 END DO 491 ! 617 492 IF(lwp) THEN 618 493 WRITE(numout,*) 619 494 WRITE(numout,*) ' resulting internal parameters : ' 620 WRITE(numout,*) ' nproc = ', nproc 621 WRITE(numout,*) ' nowe = ', nowe , ' noea = ', noea 622 WRITE(numout,*) ' nono = ', nono , ' noso = ', noso 623 WRITE(numout,*) ' nbondi = ', nbondi 624 WRITE(numout,*) ' nbondj = ', nbondj 625 WRITE(numout,*) ' npolj = ', npolj 626 WRITE(numout,*) ' l_Iperio = ', l_Iperio 627 WRITE(numout,*) ' l_Jperio = ', l_Jperio 628 WRITE(numout,*) ' nimpp = ', nimpp 629 WRITE(numout,*) ' njmpp = ', njmpp 630 ENDIF 631 495 WRITE(numout,*) ' narea = ', narea 496 WRITE(numout,*) ' mpi nei west = ', mpinei(jpwe) , ' mpi nei east = ', mpinei(jpea) 497 WRITE(numout,*) ' mpi nei south = ', mpinei(jpso) , ' mpi nei north = ', mpinei(jpno) 498 WRITE(numout,*) ' mpi nei so-we = ', mpinei(jpsw) , ' mpi nei so-ea = ', mpinei(jpse) 499 WRITE(numout,*) ' mpi nei no-we = ', mpinei(jpnw) , ' mpi nei no-ea = ', mpinei(jpne) 500 ENDIF 632 501 ! ! Prepare mpp north fold 633 IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN 502 ! 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 ) THEN 634 507 CALL mpp_ini_north 635 508 IF (lwp) THEN 636 509 WRITE(numout,*) 637 510 WRITE(numout,*) ' ==>>> North fold boundary prepared for jpni >1' 638 ! additional prints in layout.dat 639 ENDIF 640 IF (llwrtlay) THEN 511 ENDIF 512 IF (llwrtlay) THEN ! additional prints in layout.dat 641 513 WRITE(inum,*) 642 514 WRITE(inum,*) 643 WRITE(inum,*) ' number of subdomains located along the north fold : ', ndim_rank_north515 WRITE(inum,*) 'Number of subdomains located along the north fold : ', ndim_rank_north 644 516 WRITE(inum,*) 'Rank of the subdomains located along the north fold : ', ndim_rank_north 645 DO jp roc= 1, ndim_rank_north, 5646 WRITE(inum,*) nrank_north( jp roc:MINVAL( (/jproc+4,ndim_rank_north/) ) )517 DO jp = 1, ndim_rank_north, 5 518 WRITE(inum,*) nrank_north( jp:MINVAL( (/jp+4,ndim_rank_north/) ) ) 647 519 END DO 648 520 ENDIF 649 ENDIF 650 ! 651 CALL init_ioipsl ! Prepare NetCDF output file (if necessary) 652 ! 653 IF (( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ).AND.( ln_nnogather )) THEN 654 CALL init_nfdcom ! northfold neighbour lists 655 IF (llwrtlay) THEN 656 WRITE(inum,*) 657 WRITE(inum,*) 658 WRITE(inum,*) 'north fold exchanges with explicit point-to-point messaging :' 659 WRITE(inum,*) 'nsndto : ', nsndto 660 WRITE(inum,*) 'isendto : ', isendto 661 ENDIF 662 ENDIF 663 ! 664 IF (llwrtlay) CLOSE(inum) 665 ! 666 DEALLOCATE(iin, ijn, ii_nono, ii_noea, ii_noso, ii_nowe, & 667 & iimppt, ijmppt, ibondi, ibondj, ipproc, ipolj, & 668 & ijpi, ijpj, iie0, ije0, iis0, ijs0, & 669 & iono, ioea, ioso, iowe, llisoce) 521 IF ( l_IdoNFold .AND. ln_nnogather ) THEN 522 CALL init_nfdcom ! northfold neighbour lists 523 IF (llwrtlay) THEN 524 WRITE(inum,*) 525 WRITE(inum,*) 'north fold exchanges with explicit point-to-point messaging :' 526 WRITE(inum,*) ' nsndto : ', nsndto 527 WRITE(inum,*) ' isendto : ', isendto(1:nsndto) 528 ENDIF 529 ENDIF 530 ENDIF 531 ! 532 CALL mpp_ini_nc(nn_hls) ! Initialize communicator for neighbourhood collective communications 533 DO jh = 1, n_hlsmax 534 mpi_nc_com4(jh) = mpi_nc_com4(nn_hls) ! default definition 535 mpi_nc_com8(jh) = mpi_nc_com8(nn_hls) 536 END DO 537 ! 538 CALL init_excl_landpt ! exclude exchanges which contain only land points 539 ! 540 ! Save processor layout changes in ascii file 541 DO jh = 1, n_hlsmax ! different halo size 542 DO ji = 1, 8 543 ichanged(16*(jh-1) +ji) = COUNT( mpinei(ji:ji) /= mpiSnei(jh,ji:ji) ) 544 ichanged(16*(jh-1)+8+ji) = COUNT( mpinei(ji:ji) /= mpiRnei(jh,ji:ji) ) 545 END DO 546 END DO 547 CALL mpp_sum( "mpp_init", ichanged ) ! must be called by all processes 548 IF (llwrtlay) THEN 549 WRITE(inum,*) 550 WRITE(inum, *) '----------------------------------------------------------------------' 551 WRITE(inum,'(a,i2)') ' Mapping of the neighnourgs once excluding comm with only land points ' 552 WRITE(inum, *) '----------------------------------------------------------------------' 553 DO jh = 1, n_hlsmax ! different halo size 554 WRITE(inum,*) 555 WRITE(inum,'(a,i2)') 'halo size: ', jh 556 WRITE(inum, *) '---------' 557 WRITE(inum,'(a)') ' rank ii ij mpiwe mpiea mpiso mpino mpisw mpise mpinw mpine' 558 WRITE(inum, '(11i6,a)') narea-1, iin(narea), ijn(narea), mpinei(:), ' <- Org' 559 WRITE(inum,'(18x,8i6,a,i1,a)') mpiSnei(jh,:), ' <- Send ', COUNT( mpinei(:) /= mpiSnei(jh,:) ), ' modif' 560 WRITE(inum,'(18x,8i6,a,i1,a)') mpiRnei(jh,:), ' <- Recv ', COUNT( mpinei(:) /= mpiRnei(jh,:) ), ' modif' 561 WRITE(inum,*) ' total changes among all mpi tasks:' 562 WRITE(inum,*) ' mpiwe mpiea mpiso mpino mpisw mpise mpinw mpine' 563 WRITE(inum,'(a,8i6)') ' Send: ', ichanged(jh*16-15:jh*16-8) 564 WRITE(inum,'(a,8i6)') ' Recv: ', ichanged(jh*16 -7:jh*16 ) 565 END DO 566 ENDIF 567 ! 568 CALL init_ioipsl ! Prepare NetCDF output file (if necessary) 569 ! 570 IF (llwrtlay) CLOSE(inum) 571 ! 572 DEALLOCATE(iin, ijn, iimppt, ijmppt, ijpi, ijpj, ipproc, inei, llnei, impi, llisOce) 670 573 ! 671 574 END SUBROUTINE mpp_init … … 676 579 !!---------------------------------------------------------------------- 677 580 !! *** ROUTINE mpp_basesplit *** 678 !! 581 !! 679 582 !! ** Purpose : Lay out the global domain over processors. 680 583 !! … … 695 598 ! 696 599 INTEGER :: ji, jj 697 INTEGER :: i2hls 600 INTEGER :: i2hls 698 601 INTEGER :: iresti, irestj, irm, ijpjmin 699 602 !!---------------------------------------------------------------------- … … 702 605 #if defined key_nemocice_decomp 703 606 kimax = ( nx_global+2-i2hls + (knbi-1) ) / knbi + i2hls ! first dim. 704 kjmax = ( ny_global+2-i2hls + (knbj-1) ) / knbj + i2hls ! second dim. 607 kjmax = ( ny_global+2-i2hls + (knbj-1) ) / knbj + i2hls ! second dim. 705 608 #else 706 609 kimax = ( kiglo - i2hls + (knbi-1) ) / knbi + i2hls ! first dim. … … 734 637 CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 735 638 ENDIF 736 IF( jperio == 3 .OR. jperio == 4 .OR. jperio == 5 .OR. jperio == 6) THEN639 IF( l_NFold ) THEN 737 640 ! minimize the size of the last row to compensate for the north pole folding coast 738 IF( jperio == 3 .OR. jperio == 4) ijpjmin = 2+3*khls ! V and F folding must be outside of southern halos739 IF( jperio == 5 .OR. jperio == 6) ijpjmin = 1+3*khls ! V and F folding must be outside of southern halos740 irm = knbj - irestj 741 klcj(:,knbj) = MAX( ijpjmin, kjmax-irm ) 742 irm = irm - ( kjmax - klcj(1,knbj) ) ! remaining number of lines to remove641 IF( c_NFtype == 'T' ) ijpjmin = 2+3*khls ! V and F folding must be outside of southern halos 642 IF( c_NFtype == 'F' ) ijpjmin = 1+3*khls ! V and F folding must be outside of southern halos 643 irm = knbj - irestj ! total number of lines to be removed 644 klcj(:,knbj) = MAX( ijpjmin, kjmax-irm ) ! we must have jpj >= ijpjmin in the last row 645 irm = irm - ( kjmax - klcj(1,knbj) ) ! remaining number of lines to remove 743 646 irestj = knbj - 1 - irm 744 647 klcj(:, irestj+1:knbj-1) = kjmax-1 … … 774 677 END DO 775 678 ENDIF 776 679 777 680 END SUBROUTINE mpp_basesplit 778 681 … … 805 708 LOGICAL :: llist 806 709 LOGICAL, DIMENSION(:,:), ALLOCATABLE :: llmsk2d ! max size of the subdomains along i,j 807 LOGICAL, DIMENSION(:,:), ALLOCATABLE :: llis oce ! - -710 LOGICAL, DIMENSION(:,:), ALLOCATABLE :: llisOce ! - - 808 711 REAL(wp):: zpropland 809 712 !!---------------------------------------------------------------------- … … 828 731 iszimin = 4*nn_hls ! minimum size of the MPI subdomain so halos are always adressing neighbor inner domain 829 732 iszjmin = 4*nn_hls 830 IF( jperio == 3 .OR. jperio == 4) iszjmin = MAX(iszjmin, 2+3*nn_hls) ! V and F folding must be outside of southern halos831 IF( jperio == 5 .OR. jperio == 6) iszjmin = MAX(iszjmin, 1+3*nn_hls) ! V and F folding must be outside of southern halos733 IF( c_NFtype == 'T' ) iszjmin = MAX(iszjmin, 2+3*nn_hls) ! V and F folding must be outside of southern halos 734 IF( c_NFtype == 'F' ) iszjmin = MAX(iszjmin, 1+3*nn_hls) ! V and F folding must be outside of southern halos 832 735 ! 833 736 ! get the list of knbi that gives a smaller jpimax than knbi-1 834 737 ! get the list of knbj that gives a smaller jpjmax than knbj-1 835 DO ji = 1, inbijmax 738 DO ji = 1, inbijmax 836 739 #if defined key_nemocice_decomp 837 740 iszitst = ( nx_global+2-2*nn_hls + (ji-1) ) / ji + 2*nn_hls ! first dim. … … 878 781 iszi1(ii) = iszi0(ji) 879 782 iszj1(ii) = iszj0(jj) 880 END 783 ENDIF 881 784 END DO 882 785 END DO … … 901 804 ! extract only the partitions which reduce the subdomain size in comparison with smaller partitions 902 805 ALLOCATE( indexok(isz1) ) ! to store indices of the best partitions 903 isz0 = 0 ! number of best partitions 806 isz0 = 0 ! number of best partitions 904 807 inbij = 1 ! start with the min value of inbij1 => 1 905 808 iszij = jpiglo*jpjglo+1 ! default: larger than global domain … … 934 837 WRITE(numout,*) ' -----------------------------------------------------' 935 838 WRITE(numout,*) 936 END 839 ENDIF 937 840 ji = isz0 ! initialization with the largest value 938 ALLOCATE( llis oce(inbi0(ji), inbj0(ji)) )939 CALL mpp_is_ocean( llis oce ) ! Warning: must be call by all cores (call mpp_sum)940 inbijold = COUNT(llis oce)941 DEALLOCATE( llis oce )841 ALLOCATE( llisOce(inbi0(ji), inbj0(ji)) ) 842 CALL mpp_is_ocean( llisOce ) ! Warning: must be call by all cores (call mpp_sum) 843 inbijold = COUNT(llisOce) 844 DEALLOCATE( llisOce ) 942 845 DO ji =isz0-1,1,-1 943 ALLOCATE( llis oce(inbi0(ji), inbj0(ji)) )944 CALL mpp_is_ocean( llis oce ) ! Warning: must be call by all cores (call mpp_sum)945 inbij = COUNT(llis oce)946 DEALLOCATE( llis oce )846 ALLOCATE( llisOce(inbi0(ji), inbj0(ji)) ) 847 CALL mpp_is_ocean( llisOce ) ! Warning: must be call by all cores (call mpp_sum) 848 inbij = COUNT(llisOce) 849 DEALLOCATE( llisOce ) 947 850 IF(lwp .AND. inbij < inbijold) THEN 948 851 WRITE(numout,'(a, i6, a, i6, a, f4.1, a, i9, a, i6, a, i6, a)') & … … 951 854 & '%), largest oce domain: ', iszi0(ji)*iszj0(ji), ' ( ', iszi0(ji),' x ', iszj0(ji), ' )' 952 855 inbijold = inbij 953 END 856 ENDIF 954 857 END DO 955 858 DEALLOCATE( inbi0, inbj0, iszi0, iszj0 ) … … 961 864 CALL mppstop( ld_abort = .TRUE. ) 962 865 ENDIF 963 866 964 867 DEALLOCATE( iszi0, iszj0 ) 965 868 inbij = inbijmax + 1 ! default: larger than possible 966 869 ii = isz0+1 ! start from the end of the list (smaller subdomains) 967 870 DO WHILE( inbij > knbij ) ! while the number of ocean subdomains exceed the number of procs 968 ii = ii -1 969 ALLOCATE( llis oce(inbi0(ii), inbj0(ii)) )970 CALL mpp_is_ocean( llis oce ) ! must be done by all core971 inbij = COUNT(llis oce)972 DEALLOCATE( llis oce )871 ii = ii -1 872 ALLOCATE( llisOce(inbi0(ii), inbj0(ii)) ) 873 CALL mpp_is_ocean( llisOce ) ! must be done by all core 874 inbij = COUNT(llisOce) 875 DEALLOCATE( llisOce ) 973 876 END DO 974 877 knbi = inbi0(ii) … … 978 881 ! 979 882 END SUBROUTINE bestpartition 980 981 883 884 982 885 SUBROUTINE mpp_init_landprop( propland ) 983 886 !!---------------------------------------------------------------------- … … 1002 905 ENDIF 1003 906 1004 ! number of processes reading the bathymetry file 907 ! number of processes reading the bathymetry file 1005 908 iproc = MINVAL( (/mppsize, Nj0glo/2, 100/) ) ! read a least 2 lines, no more that 100 processes reading at the same time 1006 909 1007 910 ! we want to read iproc strips of the land-sea mask. -> pick up iproc processes every idiv processes starting at 1 1008 911 IF( iproc == 1 ) THEN ; idiv = mppsize … … 1018 921 ! 1019 922 ALLOCATE( lloce(Ni0glo, ijsz) ) ! allocate the strip 1020 CALL read bot_strip( ijstr, ijsz, lloce )923 CALL read_mask( 1, ijstr, Ni0glo, ijsz, lloce ) 1021 924 inboce = COUNT(lloce) ! number of ocean point in the stripe 1022 925 DEALLOCATE(lloce) … … 1027 930 CALL mpp_sum( 'mppini', inboce ) ! total number of ocean points over the global domain 1028 931 ! 1029 propland = REAL( Ni0glo*Nj0glo - inboce, wp ) / REAL( Ni0glo*Nj0glo, wp ) 932 propland = REAL( Ni0glo*Nj0glo - inboce, wp ) / REAL( Ni0glo*Nj0glo, wp ) 1030 933 ! 1031 934 END SUBROUTINE mpp_init_landprop 1032 1033 1034 SUBROUTINE mpp_is_ocean( ld isoce )935 936 937 SUBROUTINE mpp_is_ocean( ldIsOce ) 1035 938 !!---------------------------------------------------------------------- 1036 939 !! *** ROUTINE mpp_is_ocean *** … … 1040 943 !! at least 1 ocean point. 1041 944 !! We must indeed ensure that each subdomain that is a neighbour 1042 !! of a land subdomain 945 !! of a land subdomain, has only land points on its boundary 1043 946 !! (inside the inner subdomain) with the land subdomain. 1044 947 !! This is needed to get the proper bondary conditions on … … 1047 950 !! ** Method : read inbj strips (of length Ni0glo) of the land-sea mask 1048 951 !!---------------------------------------------------------------------- 1049 LOGICAL, DIMENSION(:,:), INTENT( out) :: ld isoce ! .true. if a sub domain constains 1 ocean point952 LOGICAL, DIMENSION(:,:), INTENT( out) :: ldIsOce ! .true. if a sub domain constains 1 ocean point 1050 953 ! 1051 954 INTEGER :: idiv, iimax, ijmax, iarea … … 1056 959 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iimppt, ijpi 1057 960 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ijmppt, ijpj 1058 LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: lloce ! lloce(i,j) = .true. if the point (i,j) is ocean 961 LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: lloce ! lloce(i,j) = .true. if the point (i,j) is ocean 1059 962 !!---------------------------------------------------------------------- 1060 963 ! do nothing if there is no land-sea mask 1061 964 IF( numbot == -1 .AND. numbdy == -1 ) THEN 1062 ld isoce(:,:) = .TRUE.965 ldIsOce(:,:) = .TRUE. 1063 966 RETURN 1064 967 ENDIF 1065 968 ! 1066 inbi = SIZE( ld isoce, dim = 1 )1067 inbj = SIZE( ld isoce, dim = 2 )969 inbi = SIZE( ldIsOce, dim = 1 ) 970 inbj = SIZE( ldIsOce, dim = 2 ) 1068 971 ! 1069 972 ! we want to read inbj strips of the land-sea mask. -> pick up inbj processes every idiv processes starting at 1 … … 1088 991 inry = iny - COUNT( (/ iarea == 1, iarea == inbj /) ) ! number of point to read in y-direction 1089 992 isty = 1 + COUNT( (/ iarea == 1 /) ) ! read from the first or the second line? 1090 CALL read bot_strip( ijmppt(1,iarea) - 2 + isty, inry, lloce(2:inx-1, isty:inry+isty-1) ) ! read the strip1091 ! 993 CALL read_mask( 1, ijmppt(1,iarea) - 2 + isty, Ni0glo, inry, lloce(2:inx-1, isty:inry+isty-1) ) ! read the strip 994 ! 1092 995 IF( iarea == 1 ) THEN ! the first line was not read 1093 IF( jperio == 2 .OR. jperio == 7 ) THEN! north-south periodocity1094 CALL read bot_strip( Nj0glo, 1, lloce(2:inx-1, 1) ) ! read the last line -> first line of lloce996 IF( l_Jperio ) THEN ! north-south periodocity 997 CALL read_mask( 1, Nj0glo, Ni0glo, 1, lloce(2:inx-1, 1) ) ! read the last line -> first line of lloce 1095 998 ELSE 1096 999 lloce(2:inx-1, 1) = .FALSE. ! closed boundary … … 1098 1001 ENDIF 1099 1002 IF( iarea == inbj ) THEN ! the last line was not read 1100 IF( jperio == 2 .OR. jperio == 7 ) THEN! north-south periodocity1101 CALL read bot_strip( 1, 1, lloce(2:inx-1,iny) )! read the first line -> last line of lloce1102 ELSEIF( jperio == 3 .OR. jperio == 4 ) THEN ! north-pole folding T-pivot, T-point1003 IF( l_Jperio ) THEN ! north-south periodocity 1004 CALL read_mask( 1, 1, Ni0glo, 1, lloce(2:inx-1,iny) ) ! read the first line -> last line of lloce 1005 ELSEIF( c_NFtype == 'T' ) THEN ! north-pole folding T-pivot, T-point 1103 1006 lloce(2,iny) = lloce(2,iny-2) ! here we have 1 halo (even if nn_hls>1) 1104 1007 DO ji = 3,inx-1 … … 1108 1011 lloce(ji,iny-1) = lloce(inx-ji+2,iny-1) 1109 1012 END DO 1110 ELSEIF( jperio == 5 .OR. jperio == 6 ) THEN! north-pole folding F-pivot, T-point, 1 halo1013 ELSEIF( c_NFtype == 'F' ) THEN ! north-pole folding F-pivot, T-point, 1 halo 1111 1014 lloce(inx/2+1,iny-1) = lloce(inx/2,iny-1) ! here we have 1 halo (even if nn_hls>1) 1112 1015 lloce(inx -1,iny-1) = lloce(2 ,iny-1) … … 1119 1022 ENDIF 1120 1023 ! ! first and last column were not read 1121 IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7) THEN1024 IF( l_Iperio ) THEN 1122 1025 lloce(1,:) = lloce(inx-1,:) ; lloce(inx,:) = lloce(2,:) ! east-west periodocity 1123 1026 ELSE … … 1134 1037 ENDIF 1135 1038 END DO 1136 1039 1137 1040 inboce_1d = RESHAPE(inboce, (/ inbi*inbj /)) 1138 1041 CALL mpp_sum( 'mppini', inboce_1d ) 1139 1042 inboce = RESHAPE(inboce_1d, (/inbi, inbj/)) 1140 ld isoce(:,:) = inboce(:,:) /= 01043 ldIsOce(:,:) = inboce(:,:) /= 0 1141 1044 DEALLOCATE(inboce, inboce_1d) 1142 1045 ! 1143 1046 END SUBROUTINE mpp_is_ocean 1144 1145 1146 SUBROUTINE read bot_strip( kjstr, kjcnt, ldoce )1147 !!---------------------------------------------------------------------- 1148 !! *** ROUTINE read bot_strip***1047 1048 1049 SUBROUTINE read_mask( kistr, kjstr, kicnt, kjcnt, ldoce ) 1050 !!---------------------------------------------------------------------- 1051 !! *** ROUTINE read_mask *** 1149 1052 !! 1150 1053 !! ** Purpose : Read relevant bathymetric information in order to … … 1154 1057 !! ** Method : read stipe of size (Ni0glo,...) 1155 1058 !!---------------------------------------------------------------------- 1156 INTEGER , INTENT(in ) :: kjstr ! startingj position of the reading1157 INTEGER , INTENT(in ) :: kjcnt ! number of lines to read1158 LOGICAL, DIMENSION( Ni0glo,kjcnt), INTENT( out) :: ldoce ! ldoce(i,j) = .true. if the point (i,j) is ocean1159 ! 1160 INTEGER :: inumsave! local logical unit1161 REAL(wp), DIMENSION( Ni0glo,kjcnt) :: zbot, zbdy1059 INTEGER , INTENT(in ) :: kistr, kjstr ! starting i and j position of the reading 1060 INTEGER , INTENT(in ) :: kicnt, kjcnt ! number of points to read in i and j directions 1061 LOGICAL, DIMENSION(kicnt,kjcnt), INTENT( out) :: ldoce ! ldoce(i,j) = .true. if the point (i,j) is ocean 1062 ! 1063 INTEGER :: inumsave ! local logical unit 1064 REAL(wp), DIMENSION(kicnt,kjcnt) :: zbot, zbdy 1162 1065 !!---------------------------------------------------------------------- 1163 1066 ! 1164 1067 inumsave = numout ; numout = numnul ! redirect all print to /dev/null 1165 1068 ! 1166 IF( numbot /= -1 ) THEN 1167 CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/ 1,kjstr/), kcount = (/Ni0glo, kjcnt/) )1069 IF( numbot /= -1 ) THEN 1070 CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/kistr,kjstr/), kcount = (/kicnt, kjcnt/) ) 1168 1071 ELSE 1169 1072 zbot(:,:) = 1._wp ! put a non-null value 1170 1073 ENDIF 1171 1074 ! 1172 IF( numbdy /= -1 ) THEN ! Adjust with bdy_msk if it exists 1173 CALL iom_get ( numbdy, jpdom_unknown, 'bdy_msk', zbdy, kstart = (/ 1,kjstr/), kcount = (/Ni0glo, kjcnt/) )1075 IF( numbdy /= -1 ) THEN ! Adjust with bdy_msk if it exists 1076 CALL iom_get ( numbdy, jpdom_unknown, 'bdy_msk', zbdy, kstart = (/kistr,kjstr/), kcount = (/kicnt, kjcnt/) ) 1174 1077 zbot(:,:) = zbot(:,:) * zbdy(:,:) 1175 1078 ENDIF 1176 1079 ! 1177 ldoce(:,:) = zbot(:,:) > 0._wp1080 ldoce(:,:) = NINT(zbot(:,:)) > 0 1178 1081 numout = inumsave 1179 1082 ! 1180 END SUBROUTINE read bot_strip1181 1182 1183 SUBROUTINE mpp_getnum( ld isoce, kproc, kipos, kjpos )1083 END SUBROUTINE read_mask 1084 1085 1086 SUBROUTINE mpp_getnum( ldIsOce, kproc, kipos, kjpos ) 1184 1087 !!---------------------------------------------------------------------- 1185 1088 !! *** ROUTINE mpp_getnum *** … … 1189 1092 !! ** Method : start from bottom left. First skip land subdomain, and finally use them if needed 1190 1093 !!---------------------------------------------------------------------- 1191 LOGICAL, DIMENSION(:,:), INTENT(in ) :: ld isoce ! F if land process1192 INTEGER, DIMENSION(:,:), INTENT( out) :: kproc ! subdomain number (-1 if supressed, starting at 0)1094 LOGICAL, DIMENSION(:,:), INTENT(in ) :: ldIsOce ! F if land process 1095 INTEGER, DIMENSION(:,:), INTENT( out) :: kproc ! subdomain number (-1 if not existing, starting at 0) 1193 1096 INTEGER, DIMENSION( :), INTENT( out) :: kipos ! i-position of the subdomain (from 1 to jpni) 1194 1097 INTEGER, DIMENSION( :), INTENT( out) :: kjpos ! j-position of the subdomain (from 1 to jpnj) … … 1198 1101 !!---------------------------------------------------------------------- 1199 1102 ! 1200 ini = SIZE(ld isoce, dim = 1)1201 inj = SIZE(ld isoce, dim = 2)1103 ini = SIZE(ldIsOce, dim = 1) 1104 inj = SIZE(ldIsOce, dim = 2) 1202 1105 inij = SIZE(kipos) 1203 1106 ! … … 1209 1112 ii = 1 + MOD(iarea0,ini) 1210 1113 ij = 1 + iarea0/ini 1211 IF( ld isoce(ii,ij) ) THEN1114 IF( ldIsOce(ii,ij) ) THEN 1212 1115 icont = icont + 1 1213 1116 kproc(ii,ij) = icont … … 1217 1120 END DO 1218 1121 ! if needed add some land subdomains to reach inij active subdomains 1219 i2add = inij - COUNT( ld isoce )1122 i2add = inij - COUNT( ldIsOce ) 1220 1123 DO jarea = 1, ini*inj 1221 1124 iarea0 = jarea - 1 1222 1125 ii = 1 + MOD(iarea0,ini) 1223 1126 ij = 1 + iarea0/ini 1224 IF( .NOT. ld isoce(ii,ij) .AND. i2add > 0 ) THEN1127 IF( .NOT. ldIsOce(ii,ij) .AND. i2add > 0 ) THEN 1225 1128 icont = icont + 1 1226 1129 kproc(ii,ij) = icont … … 1234 1137 1235 1138 1139 SUBROUTINE init_excl_landpt 1140 !!---------------------------------------------------------------------- 1141 !! *** ROUTINE *** 1142 !! 1143 !! ** Purpose : exclude exchanges which contain only land points 1144 !! 1145 !! ** Method : if a send or receive buffer constains only land point we 1146 !! flag off the corresponding communication 1147 !! Warning: this selection depend on the halo size -> loop on halo size 1148 !! 1149 !!---------------------------------------------------------------------- 1150 INTEGER :: inumsave 1151 INTEGER :: jh 1152 INTEGER :: ipi, ipj 1153 INTEGER :: iiwe, iiea, iist, iisz 1154 INTEGER :: ijso, ijno, ijst, ijsz 1155 LOGICAL :: llsave 1156 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zmsk 1157 LOGICAL , DIMENSION(Ni_0,Nj_0,1) :: lloce 1158 !!---------------------------------------------------------------------- 1159 ! 1160 ! read the land-sea mask on the inner domain 1161 CALL read_mask( nimpp, njmpp, Ni_0, Nj_0, lloce(:,:,1) ) 1162 ! 1163 ! 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 1166 l_IdoNFold = .FALSE. 1167 ! 1168 DO jh = 1, n_hlsmax ! different halo size 1169 ! 1170 ipi = Ni_0 + 2*jh ! local domain size 1171 ipj = Nj_0 + 2*jh 1172 ! 1173 ALLOCATE( zmsk(ipi,ipj) ) 1174 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 CALL lbc_lnk('mppini', zmsk, 'T', 1._wp, khls = jh) ! fill halos 1176 ! 1177 iiwe = jh ; iiea = Ni_0 ! bottom-left corfer - 1 of the sent data 1178 ijso = jh ; ijno = Nj_0 1179 IF( nn_comm == 1 ) THEN 1180 iist = 0 ; iisz = ipi 1181 ijst = 0 ; ijsz = ipj 1182 ELSE 1183 iist = jh ; iisz = Ni_0 1184 ijst = jh ; ijsz = Nj_0 1185 ENDIF 1186 IF( nn_comm == 1 ) THEN ! SM: NOT WORKING FOR NEIGHBOURHOOD COLLECTIVE COMMUNICATIONS, I DON'T KNOW WHY... 1187 ! do not send if we send only land points 1188 IF( NINT(SUM( zmsk(iiwe+1:iiwe+jh ,ijst+1:ijst+ijsz) )) == 0 ) mpiSnei(jh,jpwe) = -1 1189 IF( NINT(SUM( zmsk(iiea+1:iiea+jh ,ijst+1:ijst+ijsz) )) == 0 ) mpiSnei(jh,jpea) = -1 1190 IF( NINT(SUM( zmsk(iist+1:iist+iisz,ijso+1:ijso+jh ) )) == 0 ) mpiSnei(jh,jpso) = -1 1191 IF( NINT(SUM( zmsk(iist+1:iist+iisz,ijno+1:ijno+jh ) )) == 0 ) mpiSnei(jh,jpno) = -1 1192 IF( NINT(SUM( zmsk(iiwe+1:iiwe+jh ,ijso+1:ijso+jh ) )) == 0 ) mpiSnei(jh,jpsw) = -1 1193 IF( NINT(SUM( zmsk(iiea+1:iiea+jh ,ijso+1:ijso+jh ) )) == 0 ) mpiSnei(jh,jpse) = -1 1194 IF( NINT(SUM( zmsk(iiwe+1:iiwe+jh ,ijno+1:ijno+jh ) )) == 0 ) mpiSnei(jh,jpnw) = -1 1195 IF( NINT(SUM( zmsk(iiea+1:iiea+jh ,ijno+1:ijno+jh ) )) == 0 ) mpiSnei(jh,jpne) = -1 1196 ! 1197 iiwe = iiwe-jh ; iiea = iiea+jh ! bottom-left corfer - 1 of the received data 1198 ijso = ijso-jh ; ijno = ijno+jh 1199 ! do not send if we send only land points 1200 IF( NINT(SUM( zmsk(iiwe+1:iiwe+jh ,ijst+1:ijst+ijsz) )) == 0 ) mpiRnei(jh,jpwe) = -1 1201 IF( NINT(SUM( zmsk(iiea+1:iiea+jh ,ijst+1:ijst+ijsz) )) == 0 ) mpiRnei(jh,jpea) = -1 1202 IF( NINT(SUM( zmsk(iist+1:iist+iisz,ijso+1:ijso+jh ) )) == 0 ) mpiRnei(jh,jpso) = -1 1203 IF( NINT(SUM( zmsk(iist+1:iist+iisz,ijno+1:ijno+jh ) )) == 0 ) mpiRnei(jh,jpno) = -1 1204 IF( NINT(SUM( zmsk(iiwe+1:iiwe+jh ,ijso+1:ijso+jh ) )) == 0 ) mpiRnei(jh,jpsw) = -1 1205 IF( NINT(SUM( zmsk(iiea+1:iiea+jh ,ijso+1:ijso+jh ) )) == 0 ) mpiRnei(jh,jpse) = -1 1206 IF( NINT(SUM( zmsk(iiwe+1:iiwe+jh ,ijno+1:ijno+jh ) )) == 0 ) mpiRnei(jh,jpnw) = -1 1207 IF( NINT(SUM( zmsk(iiea+1:iiea+jh ,ijno+1:ijno+jh ) )) == 0 ) mpiRnei(jh,jpne) = -1 1208 ENDIF 1209 ! 1210 ! Specific (and rare) problem in corner treatment because we do 1st West-East comm, next South-North comm 1211 IF( nn_comm == 1 ) THEN 1212 IF( mpiSnei(jh,jpwe) > -1 ) mpiSnei(jh, (/jpsw,jpnw/) ) = -1 ! SW and NW corners already sent through West nei 1213 IF( mpiSnei(jh,jpea) > -1 ) mpiSnei(jh, (/jpse,jpne/) ) = -1 ! SE and NE corners already sent through East nei 1214 IF( mpiRnei(jh,jpso) > -1 ) mpiRnei(jh, (/jpsw,jpse/) ) = -1 ! SW and SE corners will be received through South nei 1215 IF( mpiRnei(jh,jpno) > -1 ) mpiRnei(jh, (/jpnw,jpne/) ) = -1 ! NW and NE corners will be received through North nei 1216 ENDIF 1217 ! 1218 DEALLOCATE( zmsk ) 1219 ! 1220 CALL mpp_ini_nc(jh) ! Initialize/Update communicator for neighbourhood collective communications 1221 ! 1222 END DO 1223 l_IdoNFold = llsave 1224 1225 END SUBROUTINE init_excl_landpt 1226 1227 1236 1228 SUBROUTINE init_ioipsl 1237 1229 !!---------------------------------------------------------------------- 1238 1230 !! *** ROUTINE init_ioipsl *** 1239 1231 !! 1240 !! ** Purpose : 1241 !! 1242 !! ** Method : 1232 !! ** Purpose : 1233 !! 1234 !! ** Method : 1243 1235 !! 1244 1236 !! History : 1245 !! 9.0 ! 04-03 (G. Madec ) MPP-IOIPSL 1237 !! 9.0 ! 04-03 (G. Madec ) MPP-IOIPSL 1246 1238 !! " " ! 08-12 (A. Coward) addition in case of jpni*jpnj < jpnij 1247 1239 !!---------------------------------------------------------------------- … … 1269 1261 ENDIF 1270 1262 ! 1271 CALL flio_dom_set ( jpnij, n proc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)1272 ! 1273 END SUBROUTINE init_ioipsl 1263 CALL flio_dom_set ( jpnij, narea-1, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom) 1264 ! 1265 END SUBROUTINE init_ioipsl 1274 1266 1275 1267 … … 1277 1269 !!---------------------------------------------------------------------- 1278 1270 !! *** ROUTINE init_nfdcom *** 1279 !! ** Purpose : Setup for north fold exchanges with explicit 1271 !! ** Purpose : Setup for north fold exchanges with explicit 1280 1272 !! point-to-point messaging 1281 1273 !! … … 1283 1275 !!---------------------------------------------------------------------- 1284 1276 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 1285 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 1277 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 1286 1278 !!---------------------------------------------------------------------- 1287 1279 INTEGER :: sxM, dxM, sxT, dxT, jn 1288 1280 !!---------------------------------------------------------------------- 1289 1281 ! 1290 !initializes the north-fold communication variables 1291 isendto(:) = 0 1292 nsndto = 0 1293 ! 1294 IF ( njmpp == MAXVAL( njmppt ) ) THEN ! if I am a process in the north 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 1295 1292 ! 1296 !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 1297 sxM = jpiglo - nimppt(narea) - jpiall(narea) + 1 1298 !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 1299 dxM = jpiglo - nimppt(narea) + 2 1293 sxT = nfimpp(jn) ! sxT = 1st point (in the global domain) of the jn process 1294 dxT = nfimpp(jn) + nfjpi(jn) - 1 ! dxT = last point (in the global domain) of the jn process 1300 1295 ! 1301 ! loop over the other north-fold processes to find the processes 1302 ! managing the points belonging to the sxT-dxT range 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 1303 1306 ! 1304 DO jn = 1, jpni 1305 ! 1306 sxT = nfimpp(jn) ! sxT = 1st point (in the global domain) of the jn process 1307 dxT = nfimpp(jn) + nfjpi(jn) - 1 ! dxT = last point (in the global domain) of the jn process 1308 ! 1309 IF ( sxT < sxM .AND. sxM < dxT ) THEN 1310 nsndto = nsndto + 1 1311 isendto(nsndto) = jn 1312 ELSEIF( sxM <= sxT .AND. dxM >= dxT ) THEN 1313 nsndto = nsndto + 1 1314 isendto(nsndto) = jn 1315 ELSEIF( dxM < dxT .AND. sxT < dxM ) THEN 1316 nsndto = nsndto + 1 1317 isendto(nsndto) = jn 1318 ENDIF 1319 ! 1320 END DO 1321 ! 1322 ENDIF 1323 l_north_nogather = .TRUE. 1307 END DO 1324 1308 ! 1325 1309 END SUBROUTINE init_nfdcom … … 1334 1318 !!---------------------------------------------------------------------- 1335 1319 ! 1336 Nis0 = 1+nn_hls ; Nis1 = Nis0-1 ; Nis2 = MAX( 1, Nis0-2) 1337 Njs0 = 1+nn_hls ; Njs1 = Njs0-1 ; Njs2 = MAX( 1, Njs0-2) 1338 ! 1339 Nie0 = jpi-nn_hls ; Nie1 = Nie0+1 ; Nie2 = MIN(jpi, Nie0+2) 1340 Nje0 = jpj-nn_hls ; Nje1 = Nje0+1 ; Nje2 = MIN(jpj, Nje0+2) 1341 ! 1342 IF( nn_hls == 1 ) THEN !* halo size of 1 1343 ! 1344 Nis1nxt2 = Nis0 ; Njs1nxt2 = Njs0 1345 Nie1nxt2 = Nie0 ; Nje1nxt2 = Nje0 1346 ! 1347 ELSE !* larger halo size... 1348 ! 1349 Nis1nxt2 = Nis1 ; Njs1nxt2 = Njs1 1350 Nie1nxt2 = Nie1 ; Nje1nxt2 = Nje1 1351 ! 1352 ENDIF 1320 Nis0 = 1+nn_hls 1321 Njs0 = 1+nn_hls 1322 Nie0 = jpi-nn_hls 1323 Nje0 = jpj-nn_hls 1353 1324 ! 1354 1325 Ni_0 = Nie0 - Nis0 + 1 1355 1326 Nj_0 = Nje0 - Njs0 + 1 1356 Ni_1 = Nie1 - Nis1 + 1 1357 Nj_1 = Nje1 - Njs1 + 1 1358 Ni_2 = Nie2 - Nis2 + 1 1359 Nj_2 = Nje2 - Njs2 + 1 1327 ! 1328 ! old indices to be removed... 1329 jpim1 = jpi-1 ! inner domain indices 1330 jpjm1 = jpj-1 ! " " 1331 jpkm1 = jpk-1 ! " " 1360 1332 ! 1361 1333 END SUBROUTINE init_doloop 1362 1334 1363 1335 !!====================================================================== 1364 1336 END MODULE mppini
Note: See TracChangeset
for help on using the changeset viewer.
