Changeset 9436 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC
- Timestamp:
- 2018-03-27T15:30:51+02:00 (6 years ago)
- Location:
- branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r9169 r9436 239 239 ierr(:) = 0 240 240 ! 241 ALLOCATE( mig(jpi), mjg(jpj), nfiimpp(jpni,jpnj), & 242 & nfipproc(jpni,jpnj), nfilcit(jpni,jpnj), STAT=ierr(1) ) 243 ! 244 ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) , & 245 & njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) , & 246 & nleit(jpnij) , nlejt(jpnij) , & 247 & mi0(jpiglo) , mi1 (jpiglo), mj0(jpjglo) , mj1 (jpjglo) , & 241 ALLOCATE( mig(jpi), mjg(jpj), STAT=ierr(1) ) 242 ! 243 ALLOCATE( mi0(jpiglo) , mi1 (jpiglo), mj0(jpjglo) , mj1 (jpjglo) , & 248 244 & tpol(jpiglo) , fpol(jpiglo) , STAT=ierr(2) ) 249 245 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
r9190 r9436 8 8 !! 8.0 ! 1998-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions 9 9 !! NEMO 1.0 ! 2004-01 (G. Madec, J.M Molines) F90 : free form , north fold jpni > 1 10 !! 3.4 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) add mpp_init_nfdcom 11 !! 3. ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) mpp_init_nfdcom: setup avoiding MPI communication 10 12 !! 4.0 ! 2016-06 (G. Madec) use domain configuration file instead of bathymetry file 11 13 !! 4.0 ! 2017-06 (J.M. Molines, T. Lovato) merge of mppini and mppini_2 … … 13 15 14 16 !!---------------------------------------------------------------------- 15 !! mpp_init : Lay out the global domain over processors with/without land processor elimination 16 !! mpp_init_mask : 17 !! mpp_init_ioipsl: IOIPSL initialization in mpp 17 !! mpp_init : Lay out the global domain over processors with/without land processor elimination 18 !! mpp_init_mask : Read global bathymetric information to facilitate land suppression 19 !! mpp_init_ioipsl : IOIPSL initialization in mpp 20 !! mpp_init_partition: Calculate MPP domain decomposition 21 !! factorise : Calculate the factors of the no. of MPI processes 22 !! mpp_init_nfdcom : Setup for north fold exchanges with explicit point-to-point messaging 18 23 !!---------------------------------------------------------------------- 19 24 USE dom_oce ! ocean space and time domain 20 25 USE bdy_oce ! open BounDarY 21 26 ! 27 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 22 28 USE lib_mpp ! distribued memory computing library 23 29 USE iom ! nemo I/O library … … 52 58 !!---------------------------------------------------------------------- 53 59 ! 60 jpimax = jpiglo 61 jpjmax = jpjglo 62 jpi = jpiglo 63 jpj = jpjglo 64 jpk = jpjglo 65 jpim1 = jpi-1 ! inner domain indices 66 jpjm1 = jpj-1 ! " " 67 jpkm1 = MAX( 1, jpk-1 ) ! " " 68 jpij = jpi*jpj 69 jpni = 1 70 jpnj = 1 71 jpnij = jpni*jpnj 54 72 nimpp = 1 ! 55 73 njmpp = 1 … … 128 146 INTEGER :: iiea, ijea, iiwe, ijwe ! - - 129 147 INTEGER :: iresti, irestj, iproc ! - - 148 INTEGER :: ierr ! local logical unit 130 149 REAL(wp):: zidom, zjdom ! local scalars 131 INTEGER, DIMENSION(jpnij) :: iin, ii_nono, ii_noea ! 1D workspace132 INTEGER, DIMENSION(jpnij) :: ijn, ii_noso, ii_nowe ! - -150 INTEGER, DIMENSION(jpnij) :: iin, ii_nono, ii_noea ! 1D workspace 151 INTEGER, DIMENSION(jpnij) :: ijn, ii_noso, ii_nowe ! - - 133 152 INTEGER, DIMENSION(jpni,jpnj) :: iimppt, ilci, ibondi, ipproc ! 2D workspace 134 153 INTEGER, DIMENSION(jpni,jpnj) :: ijmppt, ilcj, ibondj, ipolj ! - - 135 154 INTEGER, DIMENSION(jpni,jpnj) :: ilei, ildi, iono, ioea ! - - 136 155 INTEGER, DIMENSION(jpni,jpnj) :: ilej, ildj, ioso, iowe ! - - 137 INTEGER, DIMENSION(jpiglo,jpjglo) :: imask ! 2D golbal domain workspace 138 !!---------------------------------------------------------------------- 156 INTEGER, DIMENSION(jpiglo,jpjglo) :: imask ! 2D global domain workspace 157 !!---------------------------------------------------------------------- 158 159 ! If dimensions of processor grid weren't specified in the namelist file 160 ! then we calculate them here now that we have our communicator size 161 IF( jpni < 1 .OR. jpnj < 1 ) THEN 162 IF( Agrif_Root() ) CALL mpp_init_partition( mppsize ) 163 ENDIF 164 ! 165 #if defined key_agrif 166 IF( jpnij /= jpni*jpnj ) CALL ctl_stop( 'STOP', 'Cannot remove land proc with AGRIF' ) 167 #endif 168 169 ! 170 ALLOCATE( nfiimpp(jpni,jpnj), nfipproc(jpni,jpnj), nfilcit(jpni,jpnj) , & 171 & nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) , & 172 & njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) , & 173 & nleit(jpnij) , nlejt(jpnij) , STAT=ierr ) 174 CALL mpp_sum( ierr ) 175 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'mpp_init: unable to allocate standard ocean arrays' ) 176 177 ! 178 #if defined key_agrif 179 IF( .NOT. Agrif_Root() ) THEN ! AGRIF children: specific setting (cf. agrif_user.F90) 180 jpiglo = nbcellsx + 2 + 2*nbghostcells 181 jpjglo = nbcellsy + 2 + 2*nbghostcells 182 jpimax = ( jpiglo-2*nn_hls + (jpni-1+0) ) / jpni + 2*nn_hls 183 jpjmax = ( jpjglo-2*nn_hls + (jpnj-1+0) ) / jpnj + 2*nn_hls 184 nperio = 0 185 jperio = 0 186 ln_use_jattr = .false. 187 ENDIF 188 #endif 189 190 IF( Agrif_Root() ) THEN ! AGRIF mother: specific setting from jpni and jpnj 191 #if defined key_nemocice_decomp 192 jpimax = ( nx_global+2-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls ! first dim. 193 jpjmax = ( ny_global+2-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls ! second dim. 194 #else 195 jpimax = ( jpiglo - 2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls ! first dim. 196 jpjmax = ( jpjglo - 2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls ! second dim. 197 #endif 198 ENDIF 199 139 200 ! 140 201 IF ( jpni * jpnj == jpnij ) THEN ! regular domain lay out over processors … … 158 219 irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj ) 159 220 ! 160 ! Need to use jpimax and jpjmax here since jpi and jpj have already been 161 ! shrunk to local sizes in nemogcm 221 ! Need to use jpimax and jpjmax here since jpi and jpj not yet defined 162 222 #if defined key_nemocice_decomp 163 223 ! Change padding to be consistent with CICE … … 174 234 ilcj(:, irestj+1:jpnj) = jpjmax-1 175 235 #endif 176 !177 nfilcit(:,:) = ilci(:,:)178 236 ! 179 237 zidom = nreci + sum(ilci(:,1) - nreci ) … … 233 291 IF( jpni == 1 ) ibondi(ii,ij) = 2 234 292 235 ! Subdomain neighbors 293 ! Subdomain neighbors (get their zone number): default definition 236 294 iproc = jarea - 1 237 295 ioso(ii,ij) = iproc - jpni … … 241 299 ildi(ii,ij) = 1 + nn_hls 242 300 ilei(ii,ij) = ili - nn_hls 243 244 IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1245 IF( ibondi(ii,ij) == 1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili246 301 ildj(ii,ij) = 1 + nn_hls 247 302 ilej(ii,ij) = ilj - nn_hls 248 IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1 249 IF( ibondj(ii,ij) == 1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj 250 251 ! warning ii*ij (zone) /= nproc (processors)! 252 303 304 ! East-West periodicity: change ibondi, ioea, iowe 253 305 IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 ) THEN 254 306 IF( jpni == 1 )THEN … … 265 317 ENDIF 266 318 ENDIF 319 320 ! North fold: define ipolj, change iono. Warning: we do not change ibondj... 267 321 ipolj(ii,ij) = 0 268 322 IF( jperio == 3 .OR. jperio == 4 ) THEN … … 304 358 WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj' 305 359 WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1 306 CALL ctl_stop( ' mpp_init: Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )360 CALL ctl_stop( 'STOP', 'mpp_init: Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 ) 307 361 ENDIF 308 362 … … 333 387 ENDIF 334 388 335 ! 5. neighbour treatment 389 ! 5. neighbour treatment: change ibondi, ibondj if next to a land zone 336 390 ! ---------------------- 337 391 DO jarea = 1, jpni*jpnj … … 371 425 END DO 372 426 427 ! Update il[de][ij] according to modified ibond[ij] 428 ! ---------------------- 429 DO jarea = 1, jpni*jpnj 430 ii = iin(narea) 431 ij = ijn(narea) 432 IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1 433 IF( ibondi(ii,ij) == 1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ilci(ii,ij) 434 IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1 435 IF( ibondj(ii,ij) == 1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilcj(ii,ij) 436 END DO 437 373 438 ! just to save nono etc for all proc 439 ! warning ii*ij (zone) /= nproc (processors)! 440 ! ioso = zone number, ii_noso = proc number 374 441 ii_noso(:) = -1 375 442 ii_nono(:) = -1 376 443 ii_noea(:) = -1 377 444 ii_nowe(:) = -1 378 nproc = narea-1379 445 DO jarea = 1, jpnij 380 446 ii = iin(jarea) … … 383 449 iiso = 1 + MOD( ioso(ii,ij) , jpni ) 384 450 ijso = 1 + ioso(ii,ij) / jpni 385 noso = ipproc(iiso,ijso) 386 ii_noso(jarea)= noso 451 ii_noso(jarea) = ipproc(iiso,ijso) 387 452 ENDIF 388 453 IF( 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN 389 454 iiwe = 1 + MOD( iowe(ii,ij) , jpni ) 390 455 ijwe = 1 + iowe(ii,ij) / jpni 391 nowe = ipproc(iiwe,ijwe) 392 ii_nowe(jarea)= nowe 456 ii_nowe(jarea) = ipproc(iiwe,ijwe) 393 457 ENDIF 394 458 IF( 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN 395 459 iiea = 1 + MOD( ioea(ii,ij) , jpni ) 396 460 ijea = 1 + ioea(ii,ij) / jpni 397 noea = ipproc(iiea,ijea) 398 ii_noea(jarea)= noea 461 ii_noea(jarea)= ipproc(iiea,ijea) 399 462 ENDIF 400 463 IF( 0 <= iono(ii,ij) .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN 401 464 iino = 1 + MOD( iono(ii,ij) , jpni ) 402 465 ijno = 1 + iono(ii,ij) / jpni 403 nono = ipproc(iino,ijno) 404 ii_nono(jarea)= nono 466 ii_nono(jarea)= ipproc(iino,ijno) 405 467 ENDIF 406 468 END DO … … 408 470 ! 6. Change processor name 409 471 ! ------------------------ 410 nproc = narea-1411 472 ii = iin(narea) 412 473 ij = ijn(narea) … … 417 478 noea = ii_noea(narea) 418 479 nono = ii_nono(narea) 419 nlcj = ilcj(ii,ij)420 480 nlci = ilci(ii,ij) 421 481 nldi = ildi(ii,ij) 422 482 nlei = ilei(ii,ij) 483 nlcj = ilcj(ii,ij) 423 484 nldj = ildj(ii,ij) 424 485 nlej = ilej(ii,ij) … … 426 487 nbondj = ibondj(ii,ij) 427 488 nimpp = iimppt(ii,ij) 428 njmpp = ijmppt(ii,ij) 489 njmpp = ijmppt(ii,ij) 490 jpi = nlci 491 jpj = nlcj 492 jpk = jpkglo ! third dim 493 #if defined key_agrif 494 ! simple trick to use same vertical grid as parent but different number of levels: 495 ! Save maximum number of levels in jpkglo, then define all vertical grids with this number. 496 ! Suppress once vertical online interpolation is ok 497 IF(.NOT.Agrif_Root()) jpkglo = Agrif_Parent( jpkglo ) 498 #endif 499 jpim1 = jpi-1 ! inner domain indices 500 jpjm1 = jpj-1 ! " " 501 jpkm1 = MAX( 1, jpk-1 ) ! " " 502 jpij = jpi*jpj ! jpi x j 429 503 DO jproc = 1, jpnij 430 504 ii = iin(jproc) 431 505 ij = ijn(jproc) 432 nimppt(jproc) = iimppt(ii,ij)433 njmppt(jproc) = ijmppt(ii,ij)434 nlcjt(jproc) = ilcj(ii,ij)435 506 nlcit(jproc) = ilci(ii,ij) 436 507 nldit(jproc) = ildi(ii,ij) 437 508 nleit(jproc) = ilei(ii,ij) 509 nlcjt(jproc) = ilcj(ii,ij) 438 510 nldjt(jproc) = ildj(ii,ij) 439 511 nlejt(jproc) = ilej(ii,ij) 512 ibonit(jproc) = ibondi(ii,ij) 513 ibonjt(jproc) = ibondj(ii,ij) 514 nimppt(jproc) = iimppt(ii,ij) 515 njmppt(jproc) = ijmppt(ii,ij) 516 nfilcit(ii,ij) = ilci(ii,ij) 440 517 END DO 441 518 … … 444 521 CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 445 522 WRITE(inum,'(a)') ' jpnij jpimax jpjmax jpk jpiglo jpjglo'//& 446 & ' ( local: narea jpi jpj )'523 & ' ( local: narea jpi jpj )' 447 524 WRITE(inum,'(6i8,a,3i8,a)') jpnij,jpimax,jpjmax,jpk,jpiglo,jpjglo,& 448 525 & ' ( local: ',narea,jpi,jpj,' )' 449 WRITE(inum,'(a)') ' NAREAnlci nlcj nldi nldj nlei nlej nimp njmp nono noso nowe noea nbondi nbondj '526 WRITE(inum,'(a)') 'nproc nlci nlcj nldi nldj nlei nlej nimp njmp nono noso nowe noea nbondi nbondj ' 450 527 451 528 DO jproc = 1, jpnij 452 529 ii = iin(jproc) 453 530 ij = ijn(jproc) 454 WRITE(inum,'(1 5i5)')jproc-1, nlcit (jproc), nlcjt (jproc), &455 & nldit (jproc), nldjt (jproc), &456 & nleit (jproc), nlejt (jproc), &457 & nimppt (jproc), njmppt (jproc), &458 & ii_nono(jproc), ii_noso(jproc), &459 & ii_nowe(jproc), ii_noea(jproc), &460 & ibondi (ii,ij), ibondj (ii,ij)531 WRITE(inum,'(13i5,2i7)') jproc-1, nlcit (jproc), nlcjt (jproc), & 532 & nldit (jproc), nldjt (jproc), & 533 & nleit (jproc), nlejt (jproc), & 534 & nimppt (jproc), njmppt (jproc), & 535 & ii_nono(jproc), ii_noso(jproc), & 536 & ii_nowe(jproc), ii_noea(jproc), & 537 & ibondi (ii,ij), ibondj (ii,ij) 461 538 END DO 462 539 CLOSE(inum) … … 477 554 ENDIF 478 555 ! 556 nproc = narea-1 479 557 IF(lwp) THEN 480 558 WRITE(numout,*) … … 510 588 CALL mpp_init_ioipsl ! Prepare NetCDF output file (if necessary) 511 589 ! 590 IF( ln_nnogather ) CALL mpp_init_nfdcom ! northfold neighbour lists 591 ! 512 592 END SUBROUTINE mpp_init 513 593 … … 619 699 END SUBROUTINE mpp_init_ioipsl 620 700 701 702 SUBROUTINE mpp_init_partition( num_pes ) 703 !!---------------------------------------------------------------------- 704 !! *** ROUTINE mpp_init_partition *** 705 !! 706 !! ** Purpose : 707 !! 708 !! ** Method : 709 !!---------------------------------------------------------------------- 710 INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have 711 ! 712 INTEGER, PARAMETER :: nfactmax = 20 713 INTEGER :: nfact ! The no. of factors returned 714 INTEGER :: ierr ! Error flag 715 INTEGER :: ji 716 INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value 717 INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 718 !!---------------------------------------------------------------------- 719 ! 720 ierr = 0 721 ! 722 CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 723 ! 724 IF( nfact <= 1 ) THEN 725 WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' 726 WRITE (numout, *) ' : using grid of ',num_pes,' x 1' 727 jpnj = 1 728 jpni = num_pes 729 ELSE 730 ! Search through factors for the pair that are closest in value 731 mindiff = 1000000 732 imin = 1 733 DO ji = 1, nfact-1, 2 734 idiff = ABS( ifact(ji) - ifact(ji+1) ) 735 IF( idiff < mindiff ) THEN 736 mindiff = idiff 737 imin = ji 738 ENDIF 739 END DO 740 jpnj = ifact(imin) 741 jpni = ifact(imin + 1) 742 ENDIF 743 ! 744 jpnij = jpni*jpnj 745 ! 746 END SUBROUTINE mpp_init_partition 747 748 749 SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr ) 750 !!---------------------------------------------------------------------- 751 !! *** ROUTINE factorise *** 752 !! 753 !! ** Purpose : return the prime factors of n. 754 !! knfax factors are returned in array kfax which is of 755 !! maximum dimension kmaxfax. 756 !! ** Method : 757 !!---------------------------------------------------------------------- 758 INTEGER , INTENT(in ) :: kn, kmaxfax 759 INTEGER , INTENT( out) :: kerr, knfax 760 INTEGER, DIMENSION(kmaxfax), INTENT( out) :: kfax 761 ! 762 INTEGER :: ifac, jl, inu 763 INTEGER, PARAMETER :: ntest = 14 764 INTEGER, DIMENSION(ntest) :: ilfax 765 !!---------------------------------------------------------------------- 766 ! 767 ! lfax contains the set of allowed factors. 768 ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 769 ! 770 ! Clear the error flag and initialise output vars 771 kerr = 0 772 kfax = 1 773 knfax = 0 774 ! 775 IF( kn /= 1 ) THEN ! Find the factors of n 776 ! 777 ! nu holds the unfactorised part of the number. 778 ! knfax holds the number of factors found. 779 ! l points to the allowed factor list. 780 ! ifac holds the current factor. 781 ! 782 inu = kn 783 knfax = 0 784 ! 785 DO jl = ntest, 1, -1 786 ! 787 ifac = ilfax(jl) 788 IF( ifac > inu ) CYCLE 789 ! 790 ! Test whether the factor will divide. 791 ! 792 IF( MOD(inu,ifac) == 0 ) THEN 793 ! 794 knfax = knfax + 1 ! Add the factor to the list 795 IF( knfax > kmaxfax ) THEN 796 kerr = 6 797 write (*,*) 'FACTOR: insufficient space in factor array ', knfax 798 return 799 ENDIF 800 kfax(knfax) = ifac 801 ! Store the other factor that goes with this one 802 knfax = knfax + 1 803 kfax(knfax) = inu / ifac 804 !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax) 805 ENDIF 806 ! 807 END DO 808 ! 809 ENDIF 810 ! 811 END SUBROUTINE factorise 812 813 814 SUBROUTINE mpp_init_nfdcom 815 !!---------------------------------------------------------------------- 816 !! *** ROUTINE mpp_init_nfdcom *** 817 !! ** Purpose : Setup for north fold exchanges with explicit 818 !! point-to-point messaging 819 !! 820 !! ** Method : Initialization of the northern neighbours lists. 821 !!---------------------------------------------------------------------- 822 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 823 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 824 !!---------------------------------------------------------------------- 825 INTEGER :: sxM, dxM, sxT, dxT, jn 826 INTEGER :: njmppmax 827 !!---------------------------------------------------------------------- 828 ! 829 njmppmax = MAXVAL( njmppt ) 830 ! 831 !initializes the north-fold communication variables 832 isendto(:) = 0 833 nsndto = 0 834 ! 835 IF ( njmpp == njmppmax ) THEN ! if I am a process in the north 836 ! 837 !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 838 sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 839 !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 840 dxM = jpiglo - nimppt(narea) + 2 841 ! 842 ! loop over the other north-fold processes to find the processes 843 ! managing the points belonging to the sxT-dxT range 844 ! 845 DO jn = 1, jpni 846 ! 847 sxT = nfiimpp(jn, jpnj) ! sxT = 1st point (in the global domain) of the jn process 848 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 ! dxT = last point (in the global domain) of the jn process 849 ! 850 IF ( sxT < sxM .AND. sxM < dxT ) THEN 851 nsndto = nsndto + 1 852 isendto(nsndto) = jn 853 ELSEIF( sxM <= sxT .AND. dxM >= dxT ) THEN 854 nsndto = nsndto + 1 855 isendto(nsndto) = jn 856 ELSEIF( dxM < dxT .AND. sxT < dxM ) THEN 857 nsndto = nsndto + 1 858 isendto(nsndto) = jn 859 ENDIF 860 ! 861 END DO 862 nfsloop = 1 863 nfeloop = nlci 864 DO jn = 2,jpni-1 865 IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN 866 IF( nfipproc(jn-1,jpnj) == -1 ) nfsloop = nldi 867 IF( nfipproc(jn+1,jpnj) == -1 ) nfeloop = nlei 868 ENDIF 869 END DO 870 ! 871 ENDIF 872 l_north_nogather = .TRUE. 873 ! 874 END SUBROUTINE mpp_init_nfdcom 875 876 621 877 #endif 622 878 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r9367 r9436 28 28 !! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 29 29 !! 3.3.1! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 30 !! 3.4 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_nfdcom31 30 !! - ! 2011-11 (C. Harris) decomposition changes for running with CICE 32 31 !! 3.6 ! 2012-05 (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 33 !! - ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) nemo_nfdcom: setup avoiding MPI communication34 32 !! - ! 2014-12 (G. Madec) remove KPP scheme and cross-land advection (cla) 35 33 !! 4.0 ! 2016-10 (G. Madec, S. Flavoni) domain configuration / user defined interface … … 42 40 !! nemo_closefile: close remaining open files 43 41 !! nemo_alloc : dynamical allocation 44 !! nemo_partition: calculate MPP domain decomposition45 !! factorise : calculate the factors of the no. of MPI processes46 !! nemo_nfdcom : Setup for north fold exchanges with explicit point-to-point messaging47 42 !!---------------------------------------------------------------------- 48 43 USE step_oce ! module used in the ocean time stepping module (step.F90) … … 239 234 INTEGER :: ji ! dummy loop indices 240 235 INTEGER :: ios, ilocal_comm ! local integers 241 INTEGER :: iiarea, ijarea ! - -242 INTEGER :: iirest, ijrest ! - -243 236 CHARACTER(len=120), DIMENSION(30) :: cltxt, cltxt2, clnam 244 237 !! … … 329 322 ENDIF 330 323 331 ! If dimensions of processor grid weren't specified in the namelist file332 ! then we calculate them here now that we have our communicator size333 IF( jpni < 1 .OR. jpnj < 1 ) THEN334 #if defined key_mpp_mpi335 IF( Agrif_Root() ) CALL nemo_partition( mppsize )336 #else337 jpni = 1338 jpnj = 1339 jpnij = jpni*jpnj340 #endif341 ENDIF342 !343 #if defined key_agrif344 IF( .NOT. Agrif_Root() ) THEN ! AGRIF children: specific setting (cf. agrif_user.F90)345 jpiglo = nbcellsx + 2 + 2*nbghostcells346 jpjglo = nbcellsy + 2 + 2*nbghostcells347 jpi = ( jpiglo-2*nn_hls + (jpni-1+0) ) / jpni + 2*nn_hls348 jpj = ( jpjglo-2*nn_hls + (jpnj-1+0) ) / jpnj + 2*nn_hls349 jpimax = jpi350 jpjmax = jpj351 nperio = 0352 jperio = 0353 ln_use_jattr = .false.354 ENDIF355 #endif356 357 IF( Agrif_Root() ) THEN ! AGRIF mother: specific setting from jpni and jpnj358 iiarea = 1 + MOD( narea - 1 , jpni )359 ijarea = 1 + ( narea - 1 ) / jpni360 iirest = 1 + MOD( jpiglo - 2*nn_hls - 1 , jpni )361 ijrest = 1 + MOD( jpjglo - 2*nn_hls - 1 , jpnj )362 #if defined key_nemocice_decomp363 jpi = ( nx_global+2-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls ! first dim.364 jpj = ( ny_global+2-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls ! second dim.365 jpimax = jpi366 jpjmax = jpj367 IF( iiarea == jpni ) jpi = jpiglo - (jpni - 1) * (jpi - 2*nn_hls)368 IF( ijarea == jpnj ) jpj = jpjglo - (jpnj - 1) * (jpj - 2*nn_hls)369 #else370 jpi = ( jpiglo -2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls ! first dim.371 jpj = ( jpjglo -2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls ! second dim.372 jpimax = jpi373 jpjmax = jpj374 IF( iiarea > iirest ) jpi = jpi - 1375 IF( ijarea > ijrest ) jpj = jpj - 1376 #endif377 ENDIF378 379 jpk = jpkglo ! third dim380 381 #if defined key_agrif382 ! simple trick to use same vertical grid as parent but different number of levels:383 ! Save maximum number of levels in jpkglo, then define all vertical grids with this number.384 ! Suppress once vertical online interpolation is ok385 IF(.NOT.Agrif_Root()) jpkglo = Agrif_Parent( jpkglo )386 #endif387 jpim1 = jpi-1 ! inner domain indices388 jpjm1 = jpj-1 ! " "389 jpkm1 = MAX( 1, jpk-1 ) ! " "390 jpij = jpi*jpj ! jpi x j391 392 324 IF(lwp) THEN ! open listing units 393 325 ! … … 413 345 ! 414 346 ENDIF 347 ! ! Domain decomposition 348 CALL mpp_init ! MPP 415 349 416 350 ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays … … 422 356 423 357 CALL nemo_ctl ! Control prints 424 425 ! ! Domain decomposition426 CALL mpp_init ! MPP427 IF( ln_nnogather ) CALL nemo_nfdcom ! northfold neighbour lists428 358 ! 429 359 ! ! General initialization … … 681 611 END SUBROUTINE nemo_alloc 682 612 683 684 SUBROUTINE nemo_partition( num_pes )685 !!----------------------------------------------------------------------686 !! *** ROUTINE nemo_partition ***687 !!688 !! ** Purpose :689 !!690 !! ** Method :691 !!----------------------------------------------------------------------692 INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have693 !694 INTEGER, PARAMETER :: nfactmax = 20695 INTEGER :: nfact ! The no. of factors returned696 INTEGER :: ierr ! Error flag697 INTEGER :: ji698 INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value699 INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors700 !!----------------------------------------------------------------------701 !702 ierr = 0703 !704 CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )705 !706 IF( nfact <= 1 ) THEN707 WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'708 WRITE (numout, *) ' : using grid of ',num_pes,' x 1'709 jpnj = 1710 jpni = num_pes711 ELSE712 ! Search through factors for the pair that are closest in value713 mindiff = 1000000714 imin = 1715 DO ji = 1, nfact-1, 2716 idiff = ABS( ifact(ji) - ifact(ji+1) )717 IF( idiff < mindiff ) THEN718 mindiff = idiff719 imin = ji720 ENDIF721 END DO722 jpnj = ifact(imin)723 jpni = ifact(imin + 1)724 ENDIF725 !726 jpnij = jpni*jpnj727 !728 END SUBROUTINE nemo_partition729 730 731 SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )732 !!----------------------------------------------------------------------733 !! *** ROUTINE factorise ***734 !!735 !! ** Purpose : return the prime factors of n.736 !! knfax factors are returned in array kfax which is of737 !! maximum dimension kmaxfax.738 !! ** Method :739 !!----------------------------------------------------------------------740 INTEGER , INTENT(in ) :: kn, kmaxfax741 INTEGER , INTENT( out) :: kerr, knfax742 INTEGER, DIMENSION(kmaxfax), INTENT( out) :: kfax743 !744 INTEGER :: ifac, jl, inu745 INTEGER, PARAMETER :: ntest = 14746 INTEGER, DIMENSION(ntest) :: ilfax747 !!----------------------------------------------------------------------748 !749 ! lfax contains the set of allowed factors.750 ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)751 !752 ! Clear the error flag and initialise output vars753 kerr = 0754 kfax = 1755 knfax = 0756 !757 IF( kn /= 1 ) THEN ! Find the factors of n758 !759 ! nu holds the unfactorised part of the number.760 ! knfax holds the number of factors found.761 ! l points to the allowed factor list.762 ! ifac holds the current factor.763 !764 inu = kn765 knfax = 0766 !767 DO jl = ntest, 1, -1768 !769 ifac = ilfax(jl)770 IF( ifac > inu ) CYCLE771 !772 ! Test whether the factor will divide.773 !774 IF( MOD(inu,ifac) == 0 ) THEN775 !776 knfax = knfax + 1 ! Add the factor to the list777 IF( knfax > kmaxfax ) THEN778 kerr = 6779 write (*,*) 'FACTOR: insufficient space in factor array ', knfax780 return781 ENDIF782 kfax(knfax) = ifac783 ! Store the other factor that goes with this one784 knfax = knfax + 1785 kfax(knfax) = inu / ifac786 !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)787 ENDIF788 !789 END DO790 !791 ENDIF792 !793 END SUBROUTINE factorise794 795 #if defined key_mpp_mpi796 797 SUBROUTINE nemo_nfdcom798 !!----------------------------------------------------------------------799 !! *** ROUTINE nemo_nfdcom ***800 !! ** Purpose : Setup for north fold exchanges with explicit801 !! point-to-point messaging802 !!803 !! ** Method : Initialization of the northern neighbours lists.804 !!----------------------------------------------------------------------805 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE)806 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)807 !!----------------------------------------------------------------------808 INTEGER :: sxM, dxM, sxT, dxT, jn809 INTEGER :: njmppmax810 !!----------------------------------------------------------------------811 !812 njmppmax = MAXVAL( njmppt )813 !814 !initializes the north-fold communication variables815 isendto(:) = 0816 nsndto = 0817 !818 IF ( njmpp == njmppmax ) THEN ! if I am a process in the north819 !820 !sxM is the first point (in the global domain) needed to compute the north-fold for the current process821 sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1822 !dxM is the last point (in the global domain) needed to compute the north-fold for the current process823 dxM = jpiglo - nimppt(narea) + 2824 !825 ! loop over the other north-fold processes to find the processes826 ! managing the points belonging to the sxT-dxT range827 !828 DO jn = 1, jpni829 !830 sxT = nfiimpp(jn, jpnj) ! sxT = 1st point (in the global domain) of the jn process831 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 ! dxT = last point (in the global domain) of the jn process832 !833 IF ( sxT < sxM .AND. sxM < dxT ) THEN834 nsndto = nsndto + 1835 isendto(nsndto) = jn836 ELSEIF( sxM <= sxT .AND. dxM >= dxT ) THEN837 nsndto = nsndto + 1838 isendto(nsndto) = jn839 ELSEIF( dxM < dxT .AND. sxT < dxM ) THEN840 nsndto = nsndto + 1841 isendto(nsndto) = jn842 ENDIF843 !844 END DO845 nfsloop = 1846 nfeloop = nlci847 DO jn = 2,jpni-1848 IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN849 IF( nfipproc(jn-1,jpnj) == -1 ) nfsloop = nldi850 IF( nfipproc(jn+1,jpnj) == -1 ) nfeloop = nlei851 ENDIF852 END DO853 !854 ENDIF855 l_north_nogather = .TRUE.856 !857 END SUBROUTINE nemo_nfdcom858 859 #else860 SUBROUTINE nemo_nfdcom ! Dummy routine861 WRITE(*,*) 'nemo_nfdcom: You should not have seen this print! error?'862 END SUBROUTINE nemo_nfdcom863 #endif864 865 613 !!====================================================================== 866 614 END MODULE nemogcm
Note: See TracChangeset
for help on using the changeset viewer.