Changeset 14644 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/LBC/mppini.F90
- Timestamp:
- 2021-03-26T15:33:49+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/LBC/mppini.F90 (modified) (44 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette _wave@13990sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/LBC/mppini.F90
r14072 r14644 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 = 085 IF( jperio == 3 .OR. jperio == 4 ) npolj = 386 IF( jperio == 5 .OR. jperio == 6 ) npolj = 587 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 79 ! 90 80 CALL init_doloop ! set start/end indices or do-loop depending on the halo width value (nn_hls) … … 95 85 WRITE(numout,*) '~~~~~~~~ ' 96 86 WRITE(numout,*) ' l_Iperio = ', l_Iperio, ' l_Jperio = ', l_Jperio 97 WRITE(numout,*) ' n polj = ', npolj , ' njmpp = ', njmpp87 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 … … 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 … … 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, & … … 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 ! … … 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 … … 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' ) … … 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 … … 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 jpi = ijpi(ii,ij) 545 !!$ Nis0 = iis0(ii,ij) 546 !!$ Nie0 = iie0(ii,ij) 547 jpj = ijpj(ii,ij) 548 !!$ Njs0 = ijs0(ii,ij) 549 !!$ Nje0 = ije0(ii,ij) 550 nbondi = ibondi(ii,ij) 551 nbondj = ibondj(ii,ij) 552 nimpp = iimppt(ii,ij) 553 njmpp = ijmppt(ii,ij) 554 jpk = jpkglo ! third dim 555 556 ! set default neighbours 557 noso = ii_noso(narea) 558 nowe = ii_nowe(narea) 559 noea = ii_noea(narea) 560 nono = ii_nono(narea) 561 562 nones = -1 563 nonws = -1 564 noses = -1 565 nosws = -1 566 567 noner = -1 568 nonwr = -1 569 noser = -1 570 noswr = -1 571 572 IF((nbondi .eq. -1) .or. (nbondi .eq. 0)) THEN ! east neighbour exists 573 IF(ibondj(iin(noea+1),ijn(noea+1)) .eq. 0) THEN 574 nones = ii_nono(noea+1) ! east neighbour has north and south neighbours 575 noses = ii_noso(noea+1) 576 ELSEIF(ibondj(iin(noea+1),ijn(noea+1)) .eq. -1) THEN 577 nones = ii_nono(noea+1) ! east neighbour has north neighbour 578 ELSEIF(ibondj(iin(noea+1),ijn(noea+1)) .eq. 1) THEN 579 noses = ii_noso(noea+1) ! east neighbour has south neighbour 580 END IF 581 END IF 582 IF((nbondi .eq. 1) .or. (nbondi .eq. 0)) THEN ! west neighbour exists 583 IF(ibondj(iin(nowe+1),ijn(nowe+1)) .eq. 0) THEN 584 nonws = ii_nono(nowe+1) ! west neighbour has north and south neighbours 585 nosws = ii_noso(nowe+1) 586 ELSEIF(ibondj(iin(nowe+1),ijn(nowe+1)) .eq. -1) THEN 587 nonws = ii_nono(nowe+1) ! west neighbour has north neighbour 588 ELSEIF(ibondj(iin(nowe+1),ijn(nowe+1)) .eq. 1) THEN 589 nosws = ii_noso(nowe+1) ! west neighbour has north neighbour 590 END IF 591 END IF 592 593 IF((nbondj .eq. -1) .or. (nbondj .eq. 0)) THEN ! north neighbour exists 594 IF(ibondi(iin(nono+1),ijn(nono+1)) .eq. 0) THEN 595 noner = ii_noea(nono+1) ! north neighbour has east and west neighbours 596 nonwr = ii_nowe(nono+1) 597 ELSEIF(ibondi(iin(nono+1),ijn(nono+1)) .eq. -1) THEN 598 noner = ii_noea(nono+1) ! north neighbour has east neighbour 599 ELSEIF(ibondi(iin(nono+1),ijn(nono+1)) .eq. 1) THEN 600 nonwr = ii_nowe(nono+1) ! north neighbour has west neighbour 601 END IF 602 END IF 603 IF((nbondj .eq. 1) .or. (nbondj .eq. 0)) THEN ! south neighbour exists 604 IF(ibondi(iin(noso+1),ijn(noso+1)) .eq. 0) THEN 605 noser = ii_noea(noso+1) ! south neighbour has east and west neighbours 606 noswr = ii_nowe(noso+1) 607 ELSEIF(ibondi(iin(noso+1),ijn(noso+1)) .eq. -1) THEN 608 noser = ii_noea(noso+1) ! south neighbour has east neighbour 609 ELSEIF(ibondi(iin(noso+1),ijn(noso+1)) .eq. 1) THEN 610 noswr = ii_nowe(noso+1) ! south neighbour has west neighbour 611 END IF 612 END IF 613 614 ! 615 CALL init_doloop ! set start/end indices of do-loop, depending on the halo width value (nn_hls) 616 ! 617 jpim1 = jpi-1 ! inner domain indices 618 jpjm1 = jpj-1 ! " " 619 jpkm1 = MAX( 1, jpk-1 ) ! " " 620 jpij = jpi*jpj ! jpi x j 621 DO jproc = 1, jpnij 622 ii = iin(jproc) 623 ij = ijn(jproc) 624 jpiall (jproc) = ijpi(ii,ij) 625 nis0all(jproc) = iis0(ii,ij) 626 nie0all(jproc) = iie0(ii,ij) 627 jpjall (jproc) = ijpj(ii,ij) 628 njs0all(jproc) = ijs0(ii,ij) 629 nje0all(jproc) = ije0(ii,ij) 630 ibonit(jproc) = ibondi(ii,ij) 631 ibonjt(jproc) = ibondj(ii,ij) 632 nimppt(jproc) = iimppt(ii,ij) 633 njmppt(jproc) = ijmppt(ii,ij) 634 END DO 635 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 ! 636 439 ! Save processor layout in ascii file 637 440 IF (llwrtlay) THEN 638 441 CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 639 WRITE(inum,'(a)') ' jpnij jpimax jpjmax jpk jpiglo jpjglo'//& 640 & ' ( local: narea jpi jpj )' 641 WRITE(inum,'(6i8,a,3i8,a)') jpnij,jpimax,jpjmax,jpk,jpiglo,jpjglo,& 642 & ' ( local: ',narea,jpi,jpj,' )' 643 WRITE(inum,'(a)') 'nproc jpi jpj Nis0 Njs0 Nie0 Nje0 nimp njmp nono noso nowe noea nbondi nbondj ' 644 645 DO jproc = 1, jpnij 646 WRITE(inum,'(13i5,2i7)') jproc-1, jpiall(jproc), jpjall(jproc), & 647 & nis0all(jproc), njs0all(jproc), & 648 & nie0all(jproc), nje0all(jproc), & 649 & nimppt (jproc), njmppt (jproc), & 650 & ii_nono(jproc), ii_noso(jproc), & 651 & ii_nowe(jproc), ii_noea(jproc), & 652 & 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) 653 454 END DO 654 END IF 655 656 ! ! north fold parameter 657 ! Defined npolj, either 0, 3 , 4 , 5 , 6 658 ! In this case the important thing is that npolj /= 0 659 ! Because if we go through these line it is because jpni >1 and thus 660 ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0 661 npolj = 0 662 ij = ijn(narea) 663 IF( jperio == 3 .OR. jperio == 4 ) THEN 664 IF( ij == jpnj ) npolj = 3 665 ENDIF 666 IF( jperio == 5 .OR. jperio == 6 ) THEN 667 IF( ij == jpnj ) npolj = 5 668 ENDIF 669 ! 670 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 ! 671 492 IF(lwp) THEN 672 493 WRITE(numout,*) 673 494 WRITE(numout,*) ' resulting internal parameters : ' 674 WRITE(numout,*) ' nproc = ', nproc 675 WRITE(numout,*) ' nowe = ', nowe , ' noea = ', noea 676 WRITE(numout,*) ' nono = ', nono , ' noso = ', noso 677 WRITE(numout,*) ' nbondi = ', nbondi 678 WRITE(numout,*) ' nbondj = ', nbondj 679 WRITE(numout,*) ' npolj = ', npolj 680 WRITE(numout,*) ' l_Iperio = ', l_Iperio 681 WRITE(numout,*) ' l_Jperio = ', l_Jperio 682 WRITE(numout,*) ' nimpp = ', nimpp 683 WRITE(numout,*) ' njmpp = ', njmpp 684 ENDIF 685 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 686 501 ! ! Prepare mpp north fold 687 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 688 507 CALL mpp_ini_north 689 508 IF (lwp) THEN 690 509 WRITE(numout,*) 691 510 WRITE(numout,*) ' ==>>> North fold boundary prepared for jpni >1' 692 ! additional prints in layout.dat 693 ENDIF 694 IF (llwrtlay) THEN 511 ENDIF 512 IF (llwrtlay) THEN ! additional prints in layout.dat 695 513 WRITE(inum,*) 696 514 WRITE(inum,*) 697 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 698 516 WRITE(inum,*) 'Rank of the subdomains located along the north fold : ', ndim_rank_north 699 DO jp roc= 1, ndim_rank_north, 5700 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/) ) ) 701 519 END DO 702 520 ENDIF 703 ENDIF 704 705 ! 706 CALL mpp_ini_nc ! Initialize communicator for neighbourhood collective communications 707 ! 708 CALL init_ioipsl ! Prepare NetCDF output file (if necessary) 709 ! 710 IF (( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ).AND.( ln_nnogather )) THEN 711 CALL init_nfdcom ! northfold neighbour lists 712 IF (llwrtlay) THEN 713 WRITE(inum,*) 714 WRITE(inum,*) 715 WRITE(inum,*) 'north fold exchanges with explicit point-to-point messaging :' 716 WRITE(inum,*) 'nsndto : ', nsndto 717 WRITE(inum,*) 'isendto : ', isendto 718 ENDIF 719 ENDIF 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) 720 569 ! 721 570 IF (llwrtlay) CLOSE(inum) 722 571 ! 723 DEALLOCATE(iin, ijn, ii_nono, ii_noea, ii_noso, ii_nowe, & 724 & iimppt, ijmppt, ibondi, ibondj, ipproc, ipolj, & 725 & ijpi, ijpj, iie0, ije0, iis0, ijs0, & 726 & iono, ioea, ioso, iowe, llisoce) 572 DEALLOCATE(iin, ijn, iimppt, ijmppt, ijpi, ijpj, ipproc, inei, llnei, impi, llisOce) 727 573 ! 728 574 END SUBROUTINE mpp_init … … 791 637 CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 792 638 ENDIF 793 IF( jperio == 3 .OR. jperio == 4 .OR. jperio == 5 .OR. jperio == 6) THEN639 IF( l_NFold ) THEN 794 640 ! minimize the size of the last row to compensate for the north pole folding coast 795 IF( jperio == 3 .OR. jperio == 4) ijpjmin = 2+3*khls ! V and F folding must be outside of southern halos796 IF( jperio == 5 .OR. jperio == 6) ijpjmin = 1+3*khls ! V and F folding must be outside of southern halos797 irm = knbj - irestj 798 klcj(:,knbj) = MAX( ijpjmin, kjmax-irm ) 799 irm = irm - ( kjmax - klcj(1,knbj) ) 641 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 800 646 irestj = knbj - 1 - irm 801 647 klcj(:, irestj+1:knbj-1) = kjmax-1 … … 862 708 LOGICAL :: llist 863 709 LOGICAL, DIMENSION(:,:), ALLOCATABLE :: llmsk2d ! max size of the subdomains along i,j 864 LOGICAL, DIMENSION(:,:), ALLOCATABLE :: llis oce ! - -710 LOGICAL, DIMENSION(:,:), ALLOCATABLE :: llisOce ! - - 865 711 REAL(wp):: zpropland 866 712 !!---------------------------------------------------------------------- … … 885 731 iszimin = 4*nn_hls ! minimum size of the MPI subdomain so halos are always adressing neighbor inner domain 886 732 iszjmin = 4*nn_hls 887 IF( jperio == 3 .OR. jperio == 4) iszjmin = MAX(iszjmin, 2+3*nn_hls) ! V and F folding must be outside of southern halos888 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 889 735 ! 890 736 ! get the list of knbi that gives a smaller jpimax than knbi-1 … … 935 781 iszi1(ii) = iszi0(ji) 936 782 iszj1(ii) = iszj0(jj) 937 END 783 ENDIF 938 784 END DO 939 785 END DO … … 991 837 WRITE(numout,*) ' -----------------------------------------------------' 992 838 WRITE(numout,*) 993 END 839 ENDIF 994 840 ji = isz0 ! initialization with the largest value 995 ALLOCATE( llis oce(inbi0(ji), inbj0(ji)) )996 CALL mpp_is_ocean( llis oce ) ! Warning: must be call by all cores (call mpp_sum)997 inbijold = COUNT(llis oce)998 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 ) 999 845 DO ji =isz0-1,1,-1 1000 ALLOCATE( llis oce(inbi0(ji), inbj0(ji)) )1001 CALL mpp_is_ocean( llis oce ) ! Warning: must be call by all cores (call mpp_sum)1002 inbij = COUNT(llis oce)1003 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 ) 1004 850 IF(lwp .AND. inbij < inbijold) THEN 1005 851 WRITE(numout,'(a, i6, a, i6, a, f4.1, a, i9, a, i6, a, i6, a)') & … … 1008 854 & '%), largest oce domain: ', iszi0(ji)*iszj0(ji), ' ( ', iszi0(ji),' x ', iszj0(ji), ' )' 1009 855 inbijold = inbij 1010 END 856 ENDIF 1011 857 END DO 1012 858 DEALLOCATE( inbi0, inbj0, iszi0, iszj0 ) … … 1024 870 DO WHILE( inbij > knbij ) ! while the number of ocean subdomains exceed the number of procs 1025 871 ii = ii -1 1026 ALLOCATE( llis oce(inbi0(ii), inbj0(ii)) )1027 CALL mpp_is_ocean( llis oce ) ! must be done by all core1028 inbij = COUNT(llis oce)1029 DEALLOCATE( llis oce )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 ) 1030 876 END DO 1031 877 knbi = inbi0(ii) … … 1075 921 ! 1076 922 ALLOCATE( lloce(Ni0glo, ijsz) ) ! allocate the strip 1077 CALL read bot_strip( ijstr, ijsz, lloce )923 CALL read_mask( 1, ijstr, Ni0glo, ijsz, lloce ) 1078 924 inboce = COUNT(lloce) ! number of ocean point in the stripe 1079 925 DEALLOCATE(lloce) … … 1089 935 1090 936 1091 SUBROUTINE mpp_is_ocean( ld isoce )937 SUBROUTINE mpp_is_ocean( ldIsOce ) 1092 938 !!---------------------------------------------------------------------- 1093 939 !! *** ROUTINE mpp_is_ocean *** … … 1097 943 !! at least 1 ocean point. 1098 944 !! We must indeed ensure that each subdomain that is a neighbour 1099 !! of a land subdomain 945 !! of a land subdomain, has only land points on its boundary 1100 946 !! (inside the inner subdomain) with the land subdomain. 1101 947 !! This is needed to get the proper bondary conditions on … … 1104 950 !! ** Method : read inbj strips (of length Ni0glo) of the land-sea mask 1105 951 !!---------------------------------------------------------------------- 1106 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 1107 953 ! 1108 954 INTEGER :: idiv, iimax, ijmax, iarea … … 1117 963 ! do nothing if there is no land-sea mask 1118 964 IF( numbot == -1 .AND. numbdy == -1 ) THEN 1119 ld isoce(:,:) = .TRUE.965 ldIsOce(:,:) = .TRUE. 1120 966 RETURN 1121 967 ENDIF 1122 968 ! 1123 inbi = SIZE( ld isoce, dim = 1 )1124 inbj = SIZE( ld isoce, dim = 2 )969 inbi = SIZE( ldIsOce, dim = 1 ) 970 inbj = SIZE( ldIsOce, dim = 2 ) 1125 971 ! 1126 972 ! we want to read inbj strips of the land-sea mask. -> pick up inbj processes every idiv processes starting at 1 … … 1145 991 inry = iny - COUNT( (/ iarea == 1, iarea == inbj /) ) ! number of point to read in y-direction 1146 992 isty = 1 + COUNT( (/ iarea == 1 /) ) ! read from the first or the second line? 1147 CALL read bot_strip( ijmppt(1,iarea) - 2 + isty, inry, lloce(2:inx-1, isty:inry+isty-1) ) ! read the strip993 CALL read_mask( 1, ijmppt(1,iarea) - 2 + isty, Ni0glo, inry, lloce(2:inx-1, isty:inry+isty-1) ) ! read the strip 1148 994 ! 1149 995 IF( iarea == 1 ) THEN ! the first line was not read 1150 IF( jperio == 2 .OR. jperio == 7 ) THEN! north-south periodocity1151 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 1152 998 ELSE 1153 999 lloce(2:inx-1, 1) = .FALSE. ! closed boundary … … 1155 1001 ENDIF 1156 1002 IF( iarea == inbj ) THEN ! the last line was not read 1157 IF( jperio == 2 .OR. jperio == 7 ) THEN! north-south periodocity1158 CALL read bot_strip( 1, 1, lloce(2:inx-1,iny) )! read the first line -> last line of lloce1159 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 1160 1006 lloce(2,iny) = lloce(2,iny-2) ! here we have 1 halo (even if nn_hls>1) 1161 1007 DO ji = 3,inx-1 … … 1165 1011 lloce(ji,iny-1) = lloce(inx-ji+2,iny-1) 1166 1012 END DO 1167 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 1168 1014 lloce(inx/2+1,iny-1) = lloce(inx/2,iny-1) ! here we have 1 halo (even if nn_hls>1) 1169 1015 lloce(inx -1,iny-1) = lloce(2 ,iny-1) … … 1176 1022 ENDIF 1177 1023 ! ! first and last column were not read 1178 IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7) THEN1024 IF( l_Iperio ) THEN 1179 1025 lloce(1,:) = lloce(inx-1,:) ; lloce(inx,:) = lloce(2,:) ! east-west periodocity 1180 1026 ELSE … … 1195 1041 CALL mpp_sum( 'mppini', inboce_1d ) 1196 1042 inboce = RESHAPE(inboce_1d, (/inbi, inbj/)) 1197 ld isoce(:,:) = inboce(:,:) /= 01043 ldIsOce(:,:) = inboce(:,:) /= 0 1198 1044 DEALLOCATE(inboce, inboce_1d) 1199 1045 ! … … 1201 1047 1202 1048 1203 SUBROUTINE read bot_strip( kjstr, kjcnt, ldoce )1204 !!---------------------------------------------------------------------- 1205 !! *** ROUTINE read bot_strip***1049 SUBROUTINE read_mask( kistr, kjstr, kicnt, kjcnt, ldoce ) 1050 !!---------------------------------------------------------------------- 1051 !! *** ROUTINE read_mask *** 1206 1052 !! 1207 1053 !! ** Purpose : Read relevant bathymetric information in order to … … 1211 1057 !! ** Method : read stipe of size (Ni0glo,...) 1212 1058 !!---------------------------------------------------------------------- 1213 INTEGER , INTENT(in ) :: kjstr ! startingj position of the reading1214 INTEGER , INTENT(in ) :: kjcnt ! number of lines to read1215 LOGICAL, DIMENSION( Ni0glo,kjcnt), INTENT( out) :: ldoce! ldoce(i,j) = .true. if the point (i,j) is ocean1216 ! 1217 INTEGER :: inumsave! local logical unit1218 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 1219 1065 !!---------------------------------------------------------------------- 1220 1066 ! … … 1222 1068 ! 1223 1069 IF( numbot /= -1 ) THEN 1224 CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/ 1,kjstr/), kcount = (/Ni0glo, kjcnt/) )1070 CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/kistr,kjstr/), kcount = (/kicnt, kjcnt/) ) 1225 1071 ELSE 1226 1072 zbot(:,:) = 1._wp ! put a non-null value … … 1228 1074 ! 1229 1075 IF( numbdy /= -1 ) THEN ! Adjust with bdy_msk if it exists 1230 CALL iom_get ( numbdy, jpdom_unknown, 'bdy_msk', zbdy, kstart = (/ 1,kjstr/), kcount = (/Ni0glo, kjcnt/) )1076 CALL iom_get ( numbdy, jpdom_unknown, 'bdy_msk', zbdy, kstart = (/kistr,kjstr/), kcount = (/kicnt, kjcnt/) ) 1231 1077 zbot(:,:) = zbot(:,:) * zbdy(:,:) 1232 1078 ENDIF 1233 1079 ! 1234 ldoce(:,:) = zbot(:,:) > 0._wp1080 ldoce(:,:) = NINT(zbot(:,:)) > 0 1235 1081 numout = inumsave 1236 1082 ! 1237 END SUBROUTINE read bot_strip1238 1239 1240 SUBROUTINE mpp_getnum( ld isoce, kproc, kipos, kjpos )1083 END SUBROUTINE read_mask 1084 1085 1086 SUBROUTINE mpp_getnum( ldIsOce, kproc, kipos, kjpos ) 1241 1087 !!---------------------------------------------------------------------- 1242 1088 !! *** ROUTINE mpp_getnum *** … … 1246 1092 !! ** Method : start from bottom left. First skip land subdomain, and finally use them if needed 1247 1093 !!---------------------------------------------------------------------- 1248 LOGICAL, DIMENSION(:,:), INTENT(in ) :: ld isoce ! F if land process1249 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) 1250 1096 INTEGER, DIMENSION( :), INTENT( out) :: kipos ! i-position of the subdomain (from 1 to jpni) 1251 1097 INTEGER, DIMENSION( :), INTENT( out) :: kjpos ! j-position of the subdomain (from 1 to jpnj) … … 1255 1101 !!---------------------------------------------------------------------- 1256 1102 ! 1257 ini = SIZE(ld isoce, dim = 1)1258 inj = SIZE(ld isoce, dim = 2)1103 ini = SIZE(ldIsOce, dim = 1) 1104 inj = SIZE(ldIsOce, dim = 2) 1259 1105 inij = SIZE(kipos) 1260 1106 ! … … 1266 1112 ii = 1 + MOD(iarea0,ini) 1267 1113 ij = 1 + iarea0/ini 1268 IF( ld isoce(ii,ij) ) THEN1114 IF( ldIsOce(ii,ij) ) THEN 1269 1115 icont = icont + 1 1270 1116 kproc(ii,ij) = icont … … 1274 1120 END DO 1275 1121 ! if needed add some land subdomains to reach inij active subdomains 1276 i2add = inij - COUNT( ld isoce )1122 i2add = inij - COUNT( ldIsOce ) 1277 1123 DO jarea = 1, ini*inj 1278 1124 iarea0 = jarea - 1 1279 1125 ii = 1 + MOD(iarea0,ini) 1280 1126 ij = 1 + iarea0/ini 1281 IF( .NOT. ld isoce(ii,ij) .AND. i2add > 0 ) THEN1127 IF( .NOT. ldIsOce(ii,ij) .AND. i2add > 0 ) THEN 1282 1128 icont = icont + 1 1283 1129 kproc(ii,ij) = icont … … 1289 1135 ! 1290 1136 END SUBROUTINE mpp_getnum 1137 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 1291 1226 1292 1227 … … 1326 1261 ENDIF 1327 1262 ! 1328 CALL flio_dom_set ( jpnij, n proc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)1263 CALL flio_dom_set ( jpnij, narea-1, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom) 1329 1264 ! 1330 1265 END SUBROUTINE init_ioipsl … … 1345 1280 !!---------------------------------------------------------------------- 1346 1281 ! 1347 !initializes the north-fold communication variables 1348 isendto(:) = 0 1349 nsndto = 0 1350 ! 1351 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 1352 1292 ! 1353 !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 1354 sxM = jpiglo - nimppt(narea) - jpiall(narea) + 1 1355 !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 1356 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 1357 1295 ! 1358 ! loop over the other north-fold processes to find the processes 1359 ! 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 1360 1306 ! 1361 DO jn = 1, jpni 1362 ! 1363 sxT = nfimpp(jn) ! sxT = 1st point (in the global domain) of the jn process 1364 dxT = nfimpp(jn) + nfjpi(jn) - 1 ! dxT = last point (in the global domain) of the jn process 1365 ! 1366 IF ( sxT < sxM .AND. sxM < dxT ) THEN 1367 nsndto = nsndto + 1 1368 isendto(nsndto) = jn 1369 ELSEIF( sxM <= sxT .AND. dxM >= dxT ) THEN 1370 nsndto = nsndto + 1 1371 isendto(nsndto) = jn 1372 ELSEIF( dxM < dxT .AND. sxT < dxM ) THEN 1373 nsndto = nsndto + 1 1374 isendto(nsndto) = jn 1375 ENDIF 1376 ! 1377 END DO 1378 ! 1379 ENDIF 1380 l_north_nogather = .TRUE. 1307 END DO 1381 1308 ! 1382 1309 END SUBROUTINE init_nfdcom … … 1391 1318 !!---------------------------------------------------------------------- 1392 1319 ! 1393 Nis0 = 1+nn_hls ; Nis1 = Nis0-1 ; Nis2 = MAX( 1, Nis0-2) 1394 Njs0 = 1+nn_hls ; Njs1 = Njs0-1 ; Njs2 = MAX( 1, Njs0-2) 1395 ! 1396 Nie0 = jpi-nn_hls ; Nie1 = Nie0+1 ; Nie2 = MIN(jpi, Nie0+2) 1397 Nje0 = jpj-nn_hls ; Nje1 = Nje0+1 ; Nje2 = MIN(jpj, Nje0+2) 1398 ! 1399 IF( nn_hls == 1 ) THEN !* halo size of 1 1400 ! 1401 Nis1nxt2 = Nis0 ; Njs1nxt2 = Njs0 1402 Nie1nxt2 = Nie0 ; Nje1nxt2 = Nje0 1403 ! 1404 ELSE !* larger halo size... 1405 ! 1406 Nis1nxt2 = Nis1 ; Njs1nxt2 = Njs1 1407 Nie1nxt2 = Nie1 ; Nje1nxt2 = Nje1 1408 ! 1409 ENDIF 1320 Nis0 = 1+nn_hls 1321 Njs0 = 1+nn_hls 1322 Nie0 = jpi-nn_hls 1323 Nje0 = jpj-nn_hls 1410 1324 ! 1411 1325 Ni_0 = Nie0 - Nis0 + 1 1412 1326 Nj_0 = Nje0 - Njs0 + 1 1413 Ni_1 = Nie1 - Nis1 + 1 1414 Nj_1 = Nje1 - Njs1 + 1 1415 Ni_2 = Nie2 - Nis2 + 1 1416 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 ! " " 1417 1332 ! 1418 1333 END SUBROUTINE init_doloop
Note: See TracChangeset
for help on using the changeset viewer.
