- Timestamp:
- 2020-06-03T16:26:23+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
utils/tools_dev_r12970_AGRIF_CMEMS/DOMAINcfg/src/nemogcm.F90
r12414 r13024 408 408 !!---------------------------------------------------------------------- 409 409 ! 410 ierr = dom_oce_alloc () ! ocean domain 410 ierr = 0 411 ierr = ierr + dom_oce_alloc () ! ocean domain 411 412 ! 412 413 CALL mpp_sum( 'nemogcm', ierr ) … … 416 417 417 418 419 SUBROUTINE nemo_partition( num_pes ) 420 !!---------------------------------------------------------------------- 421 !! *** ROUTINE nemo_partition *** 422 !! 423 !! ** Purpose : 424 !! 425 !! ** Method : 426 !!---------------------------------------------------------------------- 427 INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have 428 ! 429 INTEGER, PARAMETER :: nfactmax = 20 430 INTEGER :: nfact ! The no. of factors returned 431 INTEGER :: ierr ! Error flag 432 INTEGER :: ji 433 INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value 434 INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 435 !!---------------------------------------------------------------------- 436 ! 437 ierr = 0 438 ! 439 CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 440 ! 441 IF( nfact <= 1 ) THEN 442 WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' 443 WRITE (numout, *) ' : using grid of ',num_pes,' x 1' 444 jpnj = 1 445 jpni = num_pes 446 ELSE 447 ! Search through factors for the pair that are closest in value 448 mindiff = 1000000 449 imin = 1 450 DO ji = 1, nfact-1, 2 451 idiff = ABS( ifact(ji) - ifact(ji+1) ) 452 IF( idiff < mindiff ) THEN 453 mindiff = idiff 454 imin = ji 455 ENDIF 456 END DO 457 jpnj = ifact(imin) 458 jpni = ifact(imin + 1) 459 ENDIF 460 ! 461 jpnij = jpni*jpnj 462 ! 463 END SUBROUTINE nemo_partition 464 465 466 SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr ) 467 !!---------------------------------------------------------------------- 468 !! *** ROUTINE factorise *** 469 !! 470 !! ** Purpose : return the prime factors of n. 471 !! knfax factors are returned in array kfax which is of 472 !! maximum dimension kmaxfax. 473 !! ** Method : 474 !!---------------------------------------------------------------------- 475 INTEGER , INTENT(in ) :: kn, kmaxfax 476 INTEGER , INTENT( out) :: kerr, knfax 477 INTEGER, DIMENSION(kmaxfax), INTENT( out) :: kfax 478 ! 479 INTEGER :: ifac, jl, inu 480 INTEGER, PARAMETER :: ntest = 14 481 INTEGER, DIMENSION(ntest) :: ilfax 482 !!---------------------------------------------------------------------- 483 ! 484 ! lfax contains the set of allowed factors. 485 ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 486 ! 487 ! Clear the error flag and initialise output vars 488 kerr = 0 489 kfax = 1 490 knfax = 0 491 ! 492 ! Find the factors of n. 493 IF( kn == 1 ) GOTO 20 494 495 ! nu holds the unfactorised part of the number. 496 ! knfax holds the number of factors found. 497 ! l points to the allowed factor list. 498 ! ifac holds the current factor. 499 ! 500 inu = kn 501 knfax = 0 502 ! 503 DO jl = ntest, 1, -1 504 ! 505 ifac = ilfax(jl) 506 IF( ifac > inu ) CYCLE 507 508 ! Test whether the factor will divide. 509 510 IF( MOD(inu,ifac) == 0 ) THEN 511 ! 512 knfax = knfax + 1 ! Add the factor to the list 513 IF( knfax > kmaxfax ) THEN 514 kerr = 6 515 write (*,*) 'FACTOR: insufficient space in factor array ', knfax 516 return 517 ENDIF 518 kfax(knfax) = ifac 519 ! Store the other factor that goes with this one 520 knfax = knfax + 1 521 kfax(knfax) = inu / ifac 522 !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax) 523 ENDIF 524 ! 525 END DO 526 ! 527 20 CONTINUE ! Label 20 is the exit point from the factor search loop. 528 ! 529 END SUBROUTINE factorise 530 531 532 SUBROUTINE nemo_northcomms 533 !!---------------------------------------------------------------------- 534 !! *** ROUTINE nemo_northcomms *** 535 !! ** Purpose : Setup for north fold exchanges with explicit 536 !! point-to-point messaging 537 !! 538 !! ** Method : Initialization of the northern neighbours lists. 539 !!---------------------------------------------------------------------- 540 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 541 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 542 !!---------------------------------------------------------------------- 543 INTEGER :: sxM, dxM, sxT, dxT, jn 544 INTEGER :: njmppmax 545 !!---------------------------------------------------------------------- 546 ! 547 njmppmax = MAXVAL( njmppt ) 548 ! 549 !initializes the north-fold communication variables 550 isendto(:) = 0 551 nsndto = 0 552 ! 553 !if I am a process in the north 554 IF ( njmpp == njmppmax ) THEN 555 !sxM is the first point (in the global domain) needed to compute the 556 !north-fold for the current process 557 sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 558 !dxM is the last point (in the global domain) needed to compute the 559 !north-fold for the current process 560 dxM = jpiglo - nimppt(narea) + 2 561 562 !loop over the other north-fold processes to find the processes 563 !managing the points belonging to the sxT-dxT range 564 565 DO jn = 1, jpni 566 !sxT is the first point (in the global domain) of the jn 567 !process 568 sxT = nfiimpp(jn, jpnj) 569 !dxT is the last point (in the global domain) of the jn 570 !process 571 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 572 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 573 nsndto = nsndto + 1 574 isendto(nsndto) = jn 575 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 576 nsndto = nsndto + 1 577 isendto(nsndto) = jn 578 ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 579 nsndto = nsndto + 1 580 isendto(nsndto) = jn 581 END IF 582 END DO 583 nfsloop = 1 584 nfeloop = nlci 585 DO jn = 2,jpni-1 586 IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 587 IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 588 nfsloop = nldi 589 ENDIF 590 IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 591 nfeloop = nlei 592 ENDIF 593 ENDIF 594 END DO 595 596 ENDIF 597 #if defined key_mpp_mpi 598 l_north_nogather = .TRUE. 599 #endif 600 END SUBROUTINE nemo_northcomms 601 418 602 419 603 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.