- 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/SAO_SRC/nemogcm.F90
r9367 r9436 14 14 !! nemo_closefile: close remaining open files 15 15 !! nemo_alloc : dynamical allocation 16 !! nemo_partition: calculate MPP domain decomposition17 !! factorise : calculate the factors of the no. of MPI processes18 16 !!---------------------------------------------------------------------- 19 17 USE step_oce ! module used in the ocean time stepping module (step.F90) … … 93 91 INTEGER :: ji ! dummy loop indices 94 92 INTEGER :: ios, ilocal_comm ! local integer 95 INTEGER :: iiarea, ijarea ! local integers96 INTEGER :: iirest, ijrest ! local integers97 93 CHARACTER(len=120), DIMENSION(30) :: cltxt, cltxt2, clnam 98 94 ! … … 100 96 & nn_isplt , nn_jsplt, nn_jctls, nn_jctle, & 101 97 & ln_timing, ln_diacfl 102 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_ write_cfg, cn_domcfg_out, ln_use_jattr98 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 103 99 !!---------------------------------------------------------------------- 104 100 ! … … 136 132 ENDIF 137 133 ! 138 jpk = jpkglo139 !140 #if defined key_agrif141 IF( .NOT. Agrif_Root() ) THEN ! AGRIF children: specific setting (cf. agrif_user.F90)142 jpiglo = nbcellsx + 2 + 2*nbghostcells143 jpjglo = nbcellsy + 2 + 2*nbghostcells144 jpi = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci145 jpj = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj146 nperio = 0147 jperio = 0148 ln_use_jattr = .false.149 ENDIF150 #endif151 134 ! 152 135 ! !--------------------------------------------! … … 174 157 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 175 158 ELSE 176 ilocal_comm = 0 177 ! Nodes selection (control print return in cltxt) 159 ilocal_comm = 0 ! Nodes selection (control print return in cltxt) 178 160 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) 179 161 ENDIF … … 198 180 ENDIF 199 181 200 ! If dimensions of processor grid weren't specified in the namelist file201 ! then we calculate them here now that we have our communicator size202 IF( jpni < 1 .OR. jpnj < 1 ) THEN203 #if defined key_mpp_mpi204 IF( Agrif_Root() ) CALL nemo_partition( mppsize )205 #else206 jpni = 1207 jpnj = 1208 jpnij = jpni*jpnj209 #endif210 ENDIF211 !212 #if defined key_agrif213 IF( .NOT. Agrif_Root() ) THEN ! AGRIF children: specific setting (cf. agrif_user.F90)214 jpiglo = nbcellsx + 2 + 2*nbghostcells215 jpjglo = nbcellsy + 2 + 2*nbghostcells216 jpi = ( jpiglo-2*nn_hls + (jpni-1+0) ) / jpni + 2*nn_hls217 jpj = ( jpjglo-2*nn_hls + (jpnj-1+0) ) / jpnj + 2*nn_hls218 jpimax = jpi219 jpjmax = jpj220 nperio = 0221 jperio = 0222 ln_use_jattr = .false.223 ENDIF224 #endif225 226 IF( Agrif_Root() ) THEN ! AGRIF mother: specific setting from jpni and jpnj227 iiarea = 1 + MOD( narea - 1 , jpni )228 ijarea = 1 + ( narea - 1 ) / jpni229 iirest = 1 + MOD( jpiglo - 2*nn_hls - 1 , jpni )230 ijrest = 1 + MOD( jpjglo - 2*nn_hls - 1 , jpnj )231 #if defined key_nemocice_decomp232 jpi = ( nx_global+2-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls ! first dim.233 jpj = ( ny_global+2-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls ! second dim.234 jpimax = jpi235 jpjmax = jpj236 IF( iiarea == jpni ) jpi = jpiglo - (jpni - 1) * (jpi - 2*nn_hls)237 IF( ijarea == jpnj ) jpj = jpjglo - (jpnj - 1) * (jpj - 2*nn_hls)238 #else239 jpi = ( jpiglo -2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls ! first dim.240 jpj = ( jpjglo -2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls ! second dim.241 jpimax = jpi242 jpjmax = jpj243 IF( iiarea > iirest ) jpi = jpi - 1244 IF( ijarea > ijrest ) jpj = jpj - 1245 #endif246 ENDIF247 248 jpk = jpkglo ! third dim249 250 #if defined key_agrif251 ! simple trick to use same vertical grid as parent but different number of levels:252 ! Save maximum number of levels in jpkglo, then define all vertical grids with this number.253 ! Suppress once vertical online interpolation is ok254 IF(.NOT.Agrif_Root()) jpkglo = Agrif_Parent( jpkglo )255 #endif256 jpim1 = jpi-1 ! inner domain indices257 jpjm1 = jpj-1 ! " "258 jpkm1 = MAX( 1, jpk-1 ) ! " "259 jpij = jpi*jpj ! jpi x j260 261 182 IF(lwp) THEN ! open listing units 262 183 ! … … 267 188 WRITE(numout,*) ' NEMO team' 268 189 WRITE(numout,*) ' Stand Alone Observation operator' 269 WRITE(numout,*) ' NEMO version 3.7 (2015) '190 WRITE(numout,*) ' NEMO version 4.0 (2017) ' 270 191 WRITE(numout,*) 271 192 WRITE(numout,*) … … 282 203 ! 283 204 ENDIF 205 ! ! Domain decomposition 206 CALL mpp_init ! MPP 284 207 285 208 ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays … … 290 213 ! !-------------------------------! 291 214 292 CALL nemo_ctl ! Control prints & Benchmark 293 294 ! ! Domain decomposition 295 CALL mpp_init 296 ! 297 IF( ln_timing ) CALL timing_init ! timing by routine 215 CALL nemo_ctl ! Control prints 298 216 ! 299 217 ! ! General initialization 218 IF( ln_timing ) CALL timing_init ! timing 219 IF( ln_timing ) CALL timing_start( 'nemo_init') 220 ! 300 221 CALL phy_cst ! Physical constants 301 222 CALL eos_init ! Equation of state 302 223 CALL dom_init('SAO') ! Domain 303 224 304 IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined)305 225 306 226 IF( ln_ctl ) CALL prt_ctl_init ! Print control … … 322 242 WRITE(numout,*) 323 243 WRITE(numout,*) 'nemo_ctl: Control prints' 324 WRITE(numout,*) '~~~~~~~ 244 WRITE(numout,*) '~~~~~~~~' 325 245 WRITE(numout,*) ' Namelist namctl' 326 246 WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl … … 351 271 WRITE(numout,*) ' read domain configuration file ln_read_cfg = ', ln_read_cfg 352 272 WRITE(numout,*) ' filename to be read cn_domcfg = ', TRIM(cn_domcfg) 273 WRITE(numout,*) ' keep closed seas in the domain (if exist) ln_closea = ', ln_closea 353 274 WRITE(numout,*) ' write configuration definition file ln_write_cfg = ', ln_write_cfg 354 275 WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out) 355 276 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 356 277 ENDIF 278 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file 279 ! 357 280 ! ! Parameter control 358 281 ! … … 454 377 END SUBROUTINE nemo_alloc 455 378 456 457 SUBROUTINE nemo_partition( num_pes )458 !!----------------------------------------------------------------------459 !! *** ROUTINE nemo_partition ***460 !!461 !! ** Purpose :462 !!463 !! ** Method :464 !!----------------------------------------------------------------------465 INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have466 !467 INTEGER, PARAMETER :: nfactmax = 20468 INTEGER :: nfact ! The no. of factors returned469 INTEGER :: ierr ! Error flag470 INTEGER :: ji471 INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value472 INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors473 !!----------------------------------------------------------------------474 !475 ierr = 0476 !477 CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )478 !479 IF( nfact <= 1 ) THEN480 WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'481 WRITE (numout, *) ' : using grid of ',num_pes,' x 1'482 jpnj = 1483 jpni = num_pes484 ELSE485 ! Search through factors for the pair that are closest in value486 mindiff = 1000000487 imin = 1488 DO ji = 1, nfact-1, 2489 idiff = ABS( ifact(ji) - ifact(ji+1) )490 IF( idiff < mindiff ) THEN491 mindiff = idiff492 imin = ji493 ENDIF494 END DO495 jpnj = ifact(imin)496 jpni = ifact(imin + 1)497 ENDIF498 !499 jpnij = jpni*jpnj500 !501 END SUBROUTINE nemo_partition502 503 504 SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )505 !!----------------------------------------------------------------------506 !! *** ROUTINE factorise ***507 !!508 !! ** Purpose : return the prime factors of n.509 !! knfax factors are returned in array kfax which is of510 !! maximum dimension kmaxfax.511 !! ** Method :512 !!----------------------------------------------------------------------513 INTEGER , INTENT(in ) :: kn, kmaxfax514 INTEGER , INTENT( out) :: kerr, knfax515 INTEGER, DIMENSION(kmaxfax), INTENT( out) :: kfax516 !517 INTEGER :: ifac, jl, inu518 INTEGER, PARAMETER :: ntest = 14519 INTEGER, DIMENSION(ntest) :: ilfax520 !!----------------------------------------------------------------------521 !522 ! lfax contains the set of allowed factors.523 ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)524 !525 ! Clear the error flag and initialise output vars526 kerr = 0527 kfax = 1528 knfax = 0529 !530 ! Find the factors of n.531 IF( kn .NE. 1 ) THEN532 533 ! nu holds the unfactorised part of the number.534 ! knfax holds the number of factors found.535 ! l points to the allowed factor list.536 ! ifac holds the current factor.537 !538 inu = kn539 knfax = 0540 !541 DO jl = ntest, 1, -1542 !543 ifac = ilfax(jl)544 IF( ifac > inu ) CYCLE545 546 ! Test whether the factor will divide.547 548 IF( MOD(inu,ifac) == 0 ) THEN549 !550 knfax = knfax + 1 ! Add the factor to the list551 IF( knfax > kmaxfax ) THEN552 kerr = 6553 write (*,*) 'FACTOR: insufficient space in factor array ', knfax554 return555 ENDIF556 kfax(knfax) = ifac557 ! Store the other factor that goes with this one558 knfax = knfax + 1559 kfax(knfax) = inu / ifac560 !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)561 ENDIF562 !563 END DO564 !565 ENDIF566 !567 END SUBROUTINE factorise568 569 #if defined key_mpp_mpi570 571 SUBROUTINE nemo_northcomms572 !!----------------------------------------------------------------------573 !! *** ROUTINE nemo_northcomms ***574 !! ** Purpose : Setup for north fold exchanges with explicit575 !! point-to-point messaging576 !!577 !! ** Method : Initialization of the northern neighbours lists.578 !!----------------------------------------------------------------------579 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE)580 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)581 !!----------------------------------------------------------------------582 INTEGER :: sxM, dxM, sxT, dxT, jn583 INTEGER :: njmppmax584 !!----------------------------------------------------------------------585 !586 njmppmax = MAXVAL( njmppt )587 !588 !initializes the north-fold communication variables589 isendto(:) = 0590 nsndto = 0591 !592 !if I am a process in the north593 IF ( njmpp == njmppmax ) THEN594 !sxM is the first point (in the global domain) needed to compute the595 !north-fold for the current process596 sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1597 !dxM is the last point (in the global domain) needed to compute the598 !north-fold for the current process599 dxM = jpiglo - nimppt(narea) + 2600 601 !loop over the other north-fold processes to find the processes602 !managing the points belonging to the sxT-dxT range603 604 DO jn = 1, jpni605 !sxT is the first point (in the global domain) of the jn606 !process607 sxT = nfiimpp(jn, jpnj)608 !dxT is the last point (in the global domain) of the jn609 !process610 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1611 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN612 nsndto = nsndto + 1613 isendto(nsndto) = jn614 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN615 nsndto = nsndto + 1616 isendto(nsndto) = jn617 ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN618 nsndto = nsndto + 1619 isendto(nsndto) = jn620 ENDIF621 END DO622 nfsloop = 1623 nfeloop = nlci624 DO jn = 2,jpni-1625 IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN626 IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN627 nfsloop = nldi628 ENDIF629 IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN630 nfeloop = nlei631 ENDIF632 ENDIF633 END DO634 635 ENDIF636 l_north_nogather = .TRUE.637 END SUBROUTINE nemo_northcomms638 639 #else640 SUBROUTINE nemo_northcomms ! Dummy routine641 WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?'642 END SUBROUTINE nemo_northcomms643 #endif644 645 379 !!====================================================================== 646 380 END MODULE nemogcm
Note: See TracChangeset
for help on using the changeset viewer.
