Changeset 8528


Ignore:
Timestamp:
2017-09-15T16:43:25+02:00 (3 years ago)
Author:
timgraham
Message:

First set of fixes for #1860 (getting rid of GOTO statements)

Location:
trunk/NEMOGCM/NEMO
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    r7761 r8528  
    548548 
    549549      ! 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 
    568561            ! 
    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) 
    574580            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 
    585585      ! 
    586586   END SUBROUTINE factorise 
  • trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r8524 r8528  
    752752      ! 
    753753      ! 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. 
    765760         ! 
    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 
    772765            ! 
    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) 
    778784            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 
    785787         ! 
    786       END DO 
    787       ! 
    788    20 CONTINUE      ! Label 20 is the exit point from the factor search loop. 
     788      ENDIF 
    789789      ! 
    790790   END SUBROUTINE factorise 
  • trunk/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90

    r7646 r8528  
    499499      ! 
    500500      ! 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 
    519512            ! 
    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) 
    525531            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 
    536536      ! 
    537537   END SUBROUTINE factorise 
  • trunk/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    r7761 r8528  
    596596      ! 
    597597      ! 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 
    616609            ! 
    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) 
    622628            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 
    633633      ! 
    634634   END SUBROUTINE factorise 
Note: See TracChangeset for help on using the changeset viewer.