- 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/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.