Changeset 2652
- Timestamp:
- 2011-03-04T13:04:09+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
r2648 r2652 379 379 !! ** Method : 380 380 !!---------------------------------------------------------------------- 381 USE par_oce382 381 INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have 383 ! Local variables382 ! 384 383 INTEGER, PARAMETER :: nfactmax = 20 385 384 INTEGER :: nfact ! The no. of factors returned 386 385 INTEGER :: ierr ! Error flag 387 INTEGER :: i386 INTEGER :: ji 388 387 INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value 389 388 INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors … … 403 402 mindiff = 1000000 404 403 imin = 1 405 DO i=1,nfact-1,2406 idiff = ABS( ifact(i) - ifact(i+1))407 IF( idiff < mindiff)THEN404 DO ji = 1, nfact-1, 2 405 idiff = ABS( ifact(ji) - ifact(ji+1) ) 406 IF( idiff < mindiff ) THEN 408 407 mindiff = idiff 409 imin = i410 END 408 imin = ji 409 ENDIF 411 410 END DO 412 411 jpnj = ifact(imin) … … 419 418 END SUBROUTINE nemo_partition 420 419 421 422 SUBROUTINE factorise( ifax, maxfax, nfax, n, ierr ) 420 SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr ) 423 421 !!---------------------------------------------------------------------- 424 422 !! *** ROUTINE factorise *** 425 423 !! 426 424 !! ** Purpose : return the prime factors of n. 427 !! nfax factors are returned in array ifax which is of428 !! maximum dimension maxfax.425 !! knfax factors are returned in array kfax which is of 426 !! maximum dimension kmaxfax. 429 427 !! ** Method : 430 428 !!---------------------------------------------------------------------- 431 INTEGER , INTENT(in) :: n,maxfax432 INTEGER , INTENT(Out) :: ierr,nfax433 INTEGER, INTENT(out) :: ifax(maxfax)434 ! Local variables.435 INTEGER :: i , ifac, l,nu429 INTEGER , INTENT(in ) :: kn, kmaxfax 430 INTEGER , INTENT( out) :: kerr, knfax 431 INTEGER, DIMENSION(kmaxfax), INTENT( out) :: kfax 432 ! 433 INTEGER :: ifac, jl, inu 436 434 INTEGER, PARAMETER :: ntest = 14 437 INTEGER :: lfax(ntest)435 INTEGER :: ilfax(ntest) 438 436 439 437 ! lfax contains the set of allowed factors. 440 data ( lfax(i),i=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, &441 & 128, 64, 32, 16, 8, 4, 2 /438 data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, & 439 & 128, 64, 32, 16, 8, 4, 2 / 442 440 !!---------------------------------------------------------------------- 443 441 444 442 ! Clear the error flag and initialise output vars 445 ierr = 0446 ifax = 1447 nfax = 0443 kerr = 0 444 kfax = 1 445 knfax = 0 448 446 449 447 ! Find the factors of n. 450 IF( n == 1 )GOTO 20448 IF( kn == 1 ) GOTO 20 451 449 452 450 ! nu holds the unfactorised part of the number. 453 ! nfax holds the number of factors found.451 ! knfax holds the number of factors found. 454 452 ! l points to the allowed factor list. 455 453 ! ifac holds the current factor. 456 454 457 nu =n458 nfax = 0459 460 DO l = ntest, 1, -1461 ! 462 ifac = lfax(l)463 IF( ifac > nu)CYCLE455 inu = kn 456 knfax = 0 457 458 DO jl = ntest, 1, -1 459 ! 460 ifac = ilfax(jl) 461 IF( ifac > inu ) CYCLE 464 462 465 463 ! Test whether the factor will divide. 466 464 467 IF( MOD( nu,ifac) == 0 ) THEN465 IF( MOD(inu,ifac) == 0 ) THEN 468 466 ! 469 nfax = nfax+1 ! Add the factor to the list470 IF( nfax >maxfax ) THEN471 ierr = 6472 write (*,*) 'FACTOR: insufficient space in factor array ', nfax467 knfax = knfax + 1 ! Add the factor to the list 468 IF( knfax > kmaxfax ) THEN 469 kerr = 6 470 write (*,*) 'FACTOR: insufficient space in factor array ', knfax 473 471 return 474 472 ENDIF 475 ifax(nfax) = ifac473 kfax(knfax) = ifac 476 474 ! Store the other factor that goes with this one 477 nfax = nfax + 1 478 ifax(nfax) = nu / ifac 479 !WRITE (*,*) 'ARPDBG, factors ',nfax-1,' & ',nfax,' are ', & 480 ! ifax(nfax-1),' and ',ifax(nfax) 475 knfax = knfax + 1 476 kfax(knfax) = inu / ifac 477 !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax) 481 478 ENDIF 482 479 ! … … 485 482 20 CONTINUE ! Label 20 is the exit point from the factor search loop. 486 483 ! 487 RETURN488 !489 484 END SUBROUTINE factorise 485 490 486 !!====================================================================== 491 487 END MODULE nemogcm
Note: See TracChangeset
for help on using the changeset viewer.