Changeset 8528
- Timestamp:
- 2017-09-15T16:43:25+02:00 (7 years ago)
- Location:
- trunk/NEMOGCM/NEMO
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
r7761 r8528 548 548 549 549 ! Find the factors of n. 550 IF( kn == 1 ) GOTO 20 551 552 ! nu holds the unfactorised part of the number. 553 ! knfax holds the number of factors found. 554 ! l points to the allowed factor list. 555 ! ifac holds the current factor. 556 557 inu = kn 558 knfax = 0 559 560 DO jl = ntest, 1, -1 561 ! 562 ifac = ilfax(jl) 563 IF( ifac > inu ) CYCLE 564 565 ! Test whether the factor will divide. 566 567 IF( MOD(inu,ifac) == 0 ) THEN 550 IF( kn .NE. 1 ) THEN 551 552 ! nu holds the unfactorised part of the number. 553 ! knfax holds the number of factors found. 554 ! l points to the allowed factor list. 555 ! ifac holds the current factor. 556 557 inu = kn 558 knfax = 0 559 560 DO jl = ntest, 1, -1 568 561 ! 569 knfax = knfax + 1 ! Add the factor to the list 570 IF( knfax > kmaxfax ) THEN 571 kerr = 6 572 write (*,*) 'FACTOR: insufficient space in factor array ', knfax 573 return 562 ifac = ilfax(jl) 563 IF( ifac > inu ) CYCLE 564 565 ! Test whether the factor will divide. 566 567 IF( MOD(inu,ifac) == 0 ) THEN 568 ! 569 knfax = knfax + 1 ! Add the factor to the list 570 IF( knfax > kmaxfax ) THEN 571 kerr = 6 572 write (*,*) 'FACTOR: insufficient space in factor array ', knfax 573 return 574 ENDIF 575 kfax(knfax) = ifac 576 ! Store the other factor that goes with this one 577 knfax = knfax + 1 578 kfax(knfax) = inu / ifac 579 !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax) 574 580 ENDIF 575 kfax(knfax) = ifac 576 ! Store the other factor that goes with this one 577 knfax = knfax + 1 578 kfax(knfax) = inu / ifac 579 !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax) 580 ENDIF 581 ! 582 END DO 583 584 20 CONTINUE ! Label 20 is the exit point from the factor search loop. 581 ! 582 END DO 583 584 ENDIF 585 585 ! 586 586 END SUBROUTINE factorise -
trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r8524 r8528 752 752 ! 753 753 ! Find the factors of n. 754 IF( kn == 1 ) GOTO 20 755 756 ! nu holds the unfactorised part of the number. 757 ! knfax holds the number of factors found. 758 ! l points to the allowed factor list. 759 ! ifac holds the current factor. 760 ! 761 inu = kn 762 knfax = 0 763 ! 764 DO jl = ntest, 1, -1 754 IF( kn .NE. 1 ) THEN 755 756 ! nu holds the unfactorised part of the number. 757 ! knfax holds the number of factors found. 758 ! l points to the allowed factor list. 759 ! ifac holds the current factor. 765 760 ! 766 ifac = ilfax(jl) 767 IF( ifac > inu ) CYCLE 768 769 ! Test whether the factor will divide. 770 771 IF( MOD(inu,ifac) == 0 ) THEN 761 inu = kn 762 knfax = 0 763 ! 764 DO jl = ntest, 1, -1 772 765 ! 773 knfax = knfax + 1 ! Add the factor to the list 774 IF( knfax > kmaxfax ) THEN 775 kerr = 6 776 write (*,*) 'FACTOR: insufficient space in factor array ', knfax 777 return 766 ifac = ilfax(jl) 767 IF( ifac > inu ) CYCLE 768 769 ! Test whether the factor will divide. 770 771 IF( MOD(inu,ifac) == 0 ) THEN 772 ! 773 knfax = knfax + 1 ! Add the factor to the list 774 IF( knfax > kmaxfax ) THEN 775 kerr = 6 776 write (*,*) 'FACTOR: insufficient space in factor array ', knfax 777 return 778 ENDIF 779 kfax(knfax) = ifac 780 ! Store the other factor that goes with this one 781 knfax = knfax + 1 782 kfax(knfax) = inu / ifac 783 !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax) 778 784 ENDIF 779 kfax(knfax) = ifac 780 ! Store the other factor that goes with this one 781 knfax = knfax + 1 782 kfax(knfax) = inu / ifac 783 !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax) 784 ENDIF 785 ! 786 END DO 785 787 ! 786 END DO 787 ! 788 20 CONTINUE ! Label 20 is the exit point from the factor search loop. 788 ENDIF 789 789 ! 790 790 END SUBROUTINE factorise -
trunk/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90
r7646 r8528 499 499 ! 500 500 ! Find the factors of n. 501 IF( kn == 1 ) GOTO 20 502 503 ! nu holds the unfactorised part of the number. 504 ! knfax holds the number of factors found. 505 ! l points to the allowed factor list. 506 ! ifac holds the current factor. 507 ! 508 inu = kn 509 knfax = 0 510 ! 511 DO jl = ntest, 1, -1 512 ! 513 ifac = ilfax(jl) 514 IF( ifac > inu ) CYCLE 515 516 ! Test whether the factor will divide. 517 518 IF( MOD(inu,ifac) == 0 ) THEN 501 IF( kn .NE. 1 ) THEN 502 503 ! nu holds the unfactorised part of the number. 504 ! knfax holds the number of factors found. 505 ! l points to the allowed factor list. 506 ! ifac holds the current factor. 507 ! 508 inu = kn 509 knfax = 0 510 ! 511 DO jl = ntest, 1, -1 519 512 ! 520 knfax = knfax + 1 ! Add the factor to the list 521 IF( knfax > kmaxfax ) THEN 522 kerr = 6 523 write (*,*) 'FACTOR: insufficient space in factor array ', knfax 524 return 513 ifac = ilfax(jl) 514 IF( ifac > inu ) CYCLE 515 516 ! Test whether the factor will divide. 517 518 IF( MOD(inu,ifac) == 0 ) THEN 519 ! 520 knfax = knfax + 1 ! Add the factor to the list 521 IF( knfax > kmaxfax ) THEN 522 kerr = 6 523 write (*,*) 'FACTOR: insufficient space in factor array ', knfax 524 return 525 ENDIF 526 kfax(knfax) = ifac 527 ! Store the other factor that goes with this one 528 knfax = knfax + 1 529 kfax(knfax) = inu / ifac 530 !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax) 525 531 ENDIF 526 kfax(knfax) = ifac 527 ! Store the other factor that goes with this one 528 knfax = knfax + 1 529 kfax(knfax) = inu / ifac 530 !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax) 531 ENDIF 532 ! 533 END DO 534 ! 535 20 CONTINUE ! Label 20 is the exit point from the factor search loop. 532 ! 533 END DO 534 ! 535 ENDIF 536 536 ! 537 537 END SUBROUTINE factorise -
trunk/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r7761 r8528 596 596 ! 597 597 ! Find the factors of n. 598 IF( kn == 1 ) GOTO 20 599 600 ! nu holds the unfactorised part of the number. 601 ! knfax holds the number of factors found. 602 ! l points to the allowed factor list. 603 ! ifac holds the current factor. 604 ! 605 inu = kn 606 knfax = 0 607 ! 608 DO jl = ntest, 1, -1 609 ! 610 ifac = ilfax(jl) 611 IF( ifac > inu ) CYCLE 612 613 ! Test whether the factor will divide. 614 615 IF( MOD(inu,ifac) == 0 ) THEN 598 IF( kn .NE. 1 ) THEN 599 600 ! nu holds the unfactorised part of the number. 601 ! knfax holds the number of factors found. 602 ! l points to the allowed factor list. 603 ! ifac holds the current factor. 604 ! 605 inu = kn 606 knfax = 0 607 ! 608 DO jl = ntest, 1, -1 616 609 ! 617 knfax = knfax + 1 ! Add the factor to the list 618 IF( knfax > kmaxfax ) THEN 619 kerr = 6 620 write (*,*) 'FACTOR: insufficient space in factor array ', knfax 621 return 610 ifac = ilfax(jl) 611 IF( ifac > inu ) CYCLE 612 613 ! Test whether the factor will divide. 614 615 IF( MOD(inu,ifac) == 0 ) THEN 616 ! 617 knfax = knfax + 1 ! Add the factor to the list 618 IF( knfax > kmaxfax ) THEN 619 kerr = 6 620 write (*,*) 'FACTOR: insufficient space in factor array ', knfax 621 return 622 ENDIF 623 kfax(knfax) = ifac 624 ! Store the other factor that goes with this one 625 knfax = knfax + 1 626 kfax(knfax) = inu / ifac 627 !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax) 622 628 ENDIF 623 kfax(knfax) = ifac 624 ! Store the other factor that goes with this one 625 knfax = knfax + 1 626 kfax(knfax) = inu / ifac 627 !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax) 628 ENDIF 629 ! 630 END DO 631 ! 632 20 CONTINUE ! Label 20 is the exit point from the factor search loop. 629 ! 630 END DO 631 ! 632 ENDIF 633 633 ! 634 634 END SUBROUTINE factorise
Note: See TracChangeset
for help on using the changeset viewer.