- Timestamp:
- 2018-03-27T15:30:51+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r9367 r9436 16 16 !! nemo_closefile: close remaining open files 17 17 !! nemo_alloc : dynamical allocation 18 !! nemo_partition: calculate MPP domain decomposition19 !! factorise : calculate the factors of the no. of MPI processes20 !! nemo_nfdcom : Setup for north fold exchanges with explicit point-to-point messaging21 18 !!---------------------------------------------------------------------- 22 19 USE step_oce ! module used in the ocean time stepping module … … 175 172 INTEGER :: ji ! dummy loop indices 176 173 INTEGER :: ios, ilocal_comm ! local integers 177 INTEGER :: iiarea, ijarea ! - -178 INTEGER :: iirest, ijrest ! - -179 174 CHARACTER(len=120), DIMENSION(30) :: cltxt, cltxt2, clnam 180 175 CHARACTER(len=80) :: clname … … 273 268 ENDIF 274 269 275 ! If dimensions of processor grid weren't specified in the namelist file276 ! then we calculate them here now that we have our communicator size277 IF( jpni < 1 .OR. jpnj < 1 ) THEN278 #if defined key_mpp_mpi279 IF( Agrif_Root() ) CALL nemo_partition( mppsize )280 #else281 jpni = 1282 jpnj = 1283 jpnij = jpni*jpnj284 #endif285 ENDIF286 !287 #if defined key_agrif288 IF( .NOT. Agrif_Root() ) THEN ! AGRIF children: specific setting (cf. agrif_user.F90)289 jpiglo = nbcellsx + 2 + 2*nbghostcells290 jpjglo = nbcellsy + 2 + 2*nbghostcells291 jpi = ( jpiglo-2*nn_hls + (jpni-1+0) ) / jpni + 2*nn_hls292 jpj = ( jpjglo-2*nn_hls + (jpnj-1+0) ) / jpnj + 2*nn_hls293 jpimax = jpi294 jpjmax = jpj295 nperio = 0296 jperio = 0297 ln_use_jattr = .false.298 ENDIF299 #endif300 301 IF( Agrif_Root() ) THEN ! AGRIF mother: specific setting from jpni and jpnj302 iiarea = 1 + MOD( narea - 1 , jpni )303 ijarea = 1 + ( narea - 1 ) / jpni304 iirest = 1 + MOD( jpiglo - 2*nn_hls - 1 , jpni )305 ijrest = 1 + MOD( jpjglo - 2*nn_hls - 1 , jpnj )306 #if defined key_nemocice_decomp307 jpi = ( nx_global+2-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls ! first dim.308 jpj = ( ny_global+2-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls ! second dim.309 jpimax = jpi310 jpjmax = jpj311 IF( iiarea == jpni ) jpi = jpiglo - (jpni - 1) * (jpi - 2*nn_hls)312 IF( ijarea == jpnj ) jpj = jpjglo - (jpnj - 1) * (jpj - 2*nn_hls)313 #else314 jpi = ( jpiglo -2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls ! first dim.315 jpj = ( jpjglo -2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls ! second dim.316 jpimax = jpi317 jpjmax = jpj318 IF( iiarea > iirest ) jpi = jpi - 1319 IF( ijarea > ijrest ) jpj = jpj - 1320 #endif321 ENDIF322 323 jpk = jpkglo ! third dim324 325 #if defined key_agrif326 ! simple trick to use same vertical grid as parent but different number of levels:327 ! Save maximum number of levels in jpkglo, then define all vertical grids with this number.328 ! Suppress once vertical online interpolation is ok329 IF(.NOT.Agrif_Root()) jpkglo = Agrif_Parent( jpkglo )330 #endif331 jpim1 = jpi-1 ! inner domain indices332 jpjm1 = jpj-1 ! " "333 jpkm1 = MAX( 1, jpk-1 ) ! " "334 jpij = jpi*jpj ! jpi x j335 336 270 IF(lwp) THEN ! open listing units 337 271 ! … … 360 294 ! 361 295 ENDIF 296 ! ! Domain decomposition 297 CALL mpp_init ! MPP 362 298 363 299 ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays … … 369 305 370 306 CALL nemo_ctl ! Control prints 371 372 ! ! Domain decomposition373 CALL mpp_init ! MPP374 IF( ln_nnogather ) CALL nemo_nfdcom ! northfold neighbour lists375 !376 307 ! 377 308 ! ! General initialization … … 552 483 END SUBROUTINE nemo_alloc 553 484 554 555 SUBROUTINE nemo_partition( num_pes )556 !!----------------------------------------------------------------------557 !! *** ROUTINE nemo_partition ***558 !!559 !! ** Purpose :560 !!561 !! ** Method :562 !!----------------------------------------------------------------------563 INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have564 !565 INTEGER, PARAMETER :: nfactmax = 20566 INTEGER :: nfact ! The no. of factors returned567 INTEGER :: ierr ! Error flag568 INTEGER :: ji569 INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value570 INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors571 !!----------------------------------------------------------------------572 !573 ierr = 0574 !575 CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )576 !577 IF( nfact <= 1 ) THEN578 WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'579 WRITE (numout, *) ' : using grid of ',num_pes,' x 1'580 jpnj = 1581 jpni = num_pes582 ELSE583 ! Search through factors for the pair that are closest in value584 mindiff = 1000000585 imin = 1586 DO ji = 1, nfact-1, 2587 idiff = ABS( ifact(ji) - ifact(ji+1) )588 IF( idiff < mindiff ) THEN589 mindiff = idiff590 imin = ji591 ENDIF592 END DO593 jpnj = ifact(imin)594 jpni = ifact(imin + 1)595 ENDIF596 !597 jpnij = jpni*jpnj598 !599 END SUBROUTINE nemo_partition600 601 602 SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )603 !!----------------------------------------------------------------------604 !! *** ROUTINE factorise ***605 !!606 !! ** Purpose : return the prime factors of n.607 !! knfax factors are returned in array kfax which is of608 !! maximum dimension kmaxfax.609 !! ** Method :610 !!----------------------------------------------------------------------611 INTEGER , INTENT(in ) :: kn, kmaxfax612 INTEGER , INTENT( out) :: kerr, knfax613 INTEGER, DIMENSION(kmaxfax), INTENT( out) :: kfax614 !615 INTEGER :: ifac, jl, inu616 INTEGER, PARAMETER :: ntest = 14617 INTEGER, DIMENSION(ntest) :: ilfax618 !!----------------------------------------------------------------------619 !620 ! lfax contains the set of allowed factors.621 ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)622 !623 ! Clear the error flag and initialise output vars624 kerr = 0625 kfax = 1626 knfax = 0627 !628 IF( kn /= 1 ) THEN ! Find the factors of n629 !630 ! nu holds the unfactorised part of the number.631 ! knfax holds the number of factors found.632 ! l points to the allowed factor list.633 ! ifac holds the current factor.634 !635 inu = kn636 knfax = 0637 !638 DO jl = ntest, 1, -1639 !640 ifac = ilfax(jl)641 IF( ifac > inu ) CYCLE642 !643 ! Test whether the factor will divide.644 !645 IF( MOD(inu,ifac) == 0 ) THEN646 !647 knfax = knfax + 1 ! Add the factor to the list648 IF( knfax > kmaxfax ) THEN649 kerr = 6650 write (*,*) 'FACTOR: insufficient space in factor array ', knfax651 return652 ENDIF653 kfax(knfax) = ifac654 ! Store the other factor that goes with this one655 knfax = knfax + 1656 kfax(knfax) = inu / ifac657 !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)658 ENDIF659 !660 END DO661 !662 ENDIF663 !664 END SUBROUTINE factorise665 666 #if defined key_mpp_mpi667 668 SUBROUTINE nemo_nfdcom669 !!----------------------------------------------------------------------670 !! *** ROUTINE nemo_nfdcom ***671 !! ** Purpose : Setup for north fold exchanges with explicit672 !! point-to-point messaging673 !!674 !! ** Method : Initialization of the northern neighbours lists.675 !!----------------------------------------------------------------------676 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE)677 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)678 !!----------------------------------------------------------------------679 INTEGER :: sxM, dxM, sxT, dxT, jn680 INTEGER :: njmppmax681 !!----------------------------------------------------------------------682 !683 njmppmax = MAXVAL( njmppt )684 !685 !initializes the north-fold communication variables686 isendto(:) = 0687 nsndto = 0688 !689 IF ( njmpp == njmppmax ) THEN ! if I am a process in the north690 !691 !sxM is the first point (in the global domain) needed to compute the north-fold for the current process692 sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1693 !dxM is the last point (in the global domain) needed to compute the north-fold for the current process694 dxM = jpiglo - nimppt(narea) + 2695 !696 ! loop over the other north-fold processes to find the processes697 ! managing the points belonging to the sxT-dxT range698 !699 DO jn = 1, jpni700 !701 sxT = nfiimpp(jn, jpnj) ! sxT = 1st point (in the global domain) of the jn process702 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 ! dxT = last point (in the global domain) of the jn process703 !704 IF ( sxT < sxM .AND. sxM < dxT ) THEN705 nsndto = nsndto + 1706 isendto(nsndto) = jn707 ELSEIF( sxM <= sxT .AND. dxM >= dxT ) THEN708 nsndto = nsndto + 1709 isendto(nsndto) = jn710 ELSEIF( dxM < dxT .AND. sxT < dxM ) THEN711 nsndto = nsndto + 1712 isendto(nsndto) = jn713 ENDIF714 !715 END DO716 nfsloop = 1717 nfeloop = nlci718 DO jn = 2,jpni-1719 IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN720 IF( nfipproc(jn-1,jpnj) == -1 ) nfsloop = nldi721 IF( nfipproc(jn+1,jpnj) == -1 ) nfeloop = nlei722 ENDIF723 END DO724 !725 ENDIF726 l_north_nogather = .TRUE.727 !728 END SUBROUTINE nemo_nfdcom729 730 #else731 SUBROUTINE nemo_nfdcom ! Dummy routine732 WRITE(*,*) 'nemo_nfdcom: You should not have seen this print! error?'733 END SUBROUTINE nemo_nfdcom734 #endif735 736 485 !!====================================================================== 737 486 END MODULE nemogcm
Note: See TracChangeset
for help on using the changeset viewer.