Ignore:
Timestamp:
Jul 19, 2024, 7:54:50 PM (12 months ago)
Author:
abarral
Message:

convert labeled do (f77) to do .. end do

Location:
LMDZ6/branches/Amaury_dev/libf/misc
Files:
15 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/misc/arth_m.F90

    r2232 r5086  
    3434       do k=2,n
    3535          arth_r(k)=arth_r(k-1)+increment
    36        end do
     36       END DO
    3737    else
    3838       do k=2,NPAR2_ARTH
    3939          arth_r(k)=arth_r(k-1)+increment
    40        end do
     40       END DO
    4141       temp=increment*NPAR2_ARTH
    4242       k=NPAR2_ARTH
    … …  
    4747          temp=temp+temp
    4848          k=k2
    49        end do
     49       END DO
    5050    end if
    5151
    … …  
    6868       do k=2,n
    6969          arth_i(k)=arth_i(k-1)+increment
    70        end do
     70       END DO
    7171    else
    7272       do k=2,NPAR2_ARTH
    7373          arth_i(k)=arth_i(k-1)+increment
    74        end do
     74       END DO
    7575       temp=increment*NPAR2_ARTH
    7676       k=NPAR2_ARTH
    … …  
    8181          temp=temp+temp
    8282          k=k2
    83        end do
     83       END DO
    8484    end if
    8585

  • LMDZ6/branches/Amaury_dev/libf/misc/chfev.F

    r5082 r5086  
    124124C  EVALUATION LOOP.
    125125C
    126       DO 500  I = 1, NE
     126      DO I = 1, NE
    127127         X = XE(I) - X1
    128128         FE(I) = F1 + X*(D1 + X*(C2 + X*C3))
    … …  
    131131         IF ( X>XMA )  NEXT(2) = NEXT(2) + 1
    132132C        (NOTE REDUNDANCY--IF EITHER CONDITION IS TRUE, OTHER IS FALSE.)
    133   500 CONTINUE
     133      END DO
    134134C
    135135C  NORMAL RETURN.

  • LMDZ6/branches/Amaury_dev/libf/misc/cray.F

    r5081 r5086  
    3636         ssum=ssum+sx(ix)
    3737         ix=ix+incx
    38       end do
     38      END DO
    3939c
    4040      return

  • LMDZ6/branches/Amaury_dev/libf/misc/interpolation.F90

    r1907 r5086  
    4040          ju=jm ! or the upper limit, as appropriate.
    4141       end if
    42     end do
     42    END DO
    4343    ! {ju == jl + 1}
    4444
    … …  
    102102                inc=inc+inc ! so double the increment
    103103             end if
    104           end do ! and try again.
     104          END DO ! and try again.
    105105       else ! Hunt down:
    106106          jhi=jlo
    … …  
    115115                inc=inc+inc ! so double the increment
    116116             end if
    117           end do ! and try again.
     117          END DO ! and try again.
    118118       end if
    119119    end if ! Done hunting, value bracketed.
    … …  
    132132          end if
    133133       end if
    134     end do
     134    END DO
    135135
    136136  END SUBROUTINE hunt

  • LMDZ6/branches/Amaury_dev/libf/misc/ismax.F

    r5082 r5086  
    1212      ismax=1
    1313      sxmax=sx(1)
    14       do 10 i=1,n-1
     14      do i=1,n-1
    1515       ix=ix+incx
    1616       if(sx(ix)>sxmax) then
    … …  
    1818         ismax=i+1
    1919       endif
    20 10    continue
     20      END DO
    2121c
    2222      return

  • LMDZ6/branches/Amaury_dev/libf/misc/new_unit_m.F90

    r1907 r5086  
    1919       if (exist .and. .not. opened) exit
    2020       unit = unit + 1
    21     end do
     21    END DO
    2222
    2323  end subroutine new_unit

  • LMDZ6/branches/Amaury_dev/libf/misc/pchdf.F

    r5082 r5086  
    7676C  COMPUTE COEFFICIENTS OF INTERPOLATING POLYNOMIAL.
    7777C
    78       DO 10  J = 2, K-1
    79          DO 9  I = 1, K-J
     78      DO J = 2, K-1
     79         DO I = 1, K-J
    8080            S(I) = (S(I+1)-S(I))/(X(I+J)-X(I))
    81     9    CONTINUE
    82    10 CONTINUE
     81      END DO
     82      END DO
    8383C
    8484C  EVALUATE DERIVATIVE AT X(K).
    8585C
    8686      VALUE = S(1)
    87       DO 20  I = 2, K-1
     87      DO I = 2, K-1
    8888         VALUE = S(I) + VALUE*(X(K)-X(I))
    89    20 CONTINUE
     89      END DO
    9090C
    9191C  NORMAL RETURN.

  • LMDZ6/branches/Amaury_dev/libf/misc/pchfe.F

    r5082 r5086  
    145145      IF ( N<2 )  GO TO 5001
    146146      IF ( INCFD<1 )  GO TO 5002
    147       DO 1  I = 2, N
     147      DO I = 2, N
    148148         IF ( X(I)<=X(I-1) )  GO TO 5003
    149     1 CONTINUE
     149      END DO
    150150C
    151151C  FUNCTION DEFINITION IS OK, GO ON.
    … …  
    168168C     LOCATE ALL POINTS IN INTERVAL.
    169169C
    170          DO 20  J = JFIRST, NE
     170         DO J = JFIRST, NE
    171171            IF (XE(J) >= X(IR))  GO TO 30
    172    20    CONTINUE
     172      END DO
    173173         J = NE + 1
    174174         GO TO 40
    … …  
    228228C
    229229C              FIRST, LOCATE FIRST POINT TO LEFT OF X(IR-1).
    230                DO 44  I = JFIRST, J-1
     230               DO I = JFIRST, J-1
    231231                  IF (XE(I) < X(IR-1))  GO TO 45
    232    44          CONTINUE
     232      END DO
    233233C              NOTE-- CANNOT DROP THROUGH HERE UNLESS THERE IS AN ERROR
    234234C                     IN CHFEV.
    … …  
    240240C
    241241C              NOW FIND OUT HOW FAR TO BACK UP IN THE X-ARRAY.
    242                DO 46  I = 1, IR-1
     242               DO I = 1, IR-1
    243243                  IF (XE(J) < X(I)) GO TO 47
    244    46          CONTINUE
     244      END DO
    245245C              NB-- CAN NEVER DROP THROUGH HERE, SINCE XE(J).LT.X(IR-1).
    246246C

  • LMDZ6/branches/Amaury_dev/libf/misc/pchsp.F

    r5082 r5086  
    164164      IF ( N<2 )  GO TO 5001
    165165      IF ( INCFD<1 )  GO TO 5002
    166       DO 1  J = 2, N
     166      DO J = 2, N
    167167         IF ( X(J)<=X(J-1) )  GO TO 5003
    168     1 CONTINUE
     168      END DO
    169169C
    170170      IBEG = IC(1)
    … …  
    181181C  COMPUTE FIRST DIFFERENCES OF X SEQUENCE AND STORE IN WK(1,.). ALSO,
    182182C  COMPUTE FIRST DIVIDED DIFFERENCE OF DATA AND STORE IN WK(2,.).
    183       DO 5  J=2,N
     183      DO J=2,N
    184184         WK(1,J) = X(J) - X(J-1)
    185185         WK(2,J) = (F(1,J) - F(1,J-1))/WK(1,J)
    186     5 CONTINUE
     186      END DO
    187187C
    188188C  SET TO DEFAULT BOUNDARY CONDITIONS IF N IS TOO SMALL.
    … …  
    197197      ELSE IF (IBEG > 2)  THEN
    198198C        PICK UP FIRST IBEG POINTS, IN REVERSE ORDER.
    199          DO 10  J = 1, IBEG
     199         DO J = 1, IBEG
    200200            INDEX = IBEG-J+1
    201201C           INDEX RUNS FROM IBEG DOWN TO 1.
    202202            XTEMP(J) = X(INDEX)
    203203            IF (J < IBEG)  STEMP(J) = WK(2,INDEX)
    204    10    CONTINUE
     204      END DO
    205205C                 --------------------------------
    206206         D(1,1) = PCHDF (IBEG, XTEMP, STEMP, IERR)
    … …  
    214214      ELSE IF (IEND > 2)  THEN
    215215C        PICK UP LAST IEND POINTS.
    216          DO 15  J = 1, IEND
     216         DO J = 1, IEND
    217217            INDEX = N-IEND+J
    218218C           INDEX RUNS FROM N+1-IEND UP TO N.
    219219            XTEMP(J) = X(INDEX)
    220220            IF (J < IEND)  STEMP(J) = WK(2,INDEX+1)
    221    15    CONTINUE
     221      END DO
    222222C                 --------------------------------
    223223         D(1,N) = PCHDF (IEND, XTEMP, STEMP, IERR)
    … …  
    267267      NM1 = N-1
    268268      IF (NM1 > 1)  THEN
    269          DO 20 J=2,NM1
     269         DO J=2,NM1
    270270            IF (WK(2,J-1) == ZERO)  GO TO 5008
    271271            G = -WK(1,J+1)/WK(2,J-1)
    … …  
    273273     *                  + THREE*(WK(1,J)*WK(2,J+1) + WK(1,J+1)*WK(2,J))
    274274            WK(2,J) = G*WK(1,J-1) + TWO*(WK(1,J) + WK(1,J+1))
    275    20    CONTINUE
     275      END DO
    276276      ENDIF
    277277C
    … …  
    324324C
    325325   30 CONTINUE
    326       DO 40 J=NM1,1,-1
     326      DO J=NM1,1,-1
    327327         IF (WK(2,J) == ZERO)  GO TO 5008
    328328         D(1,J) = (D(1,J) - WK(1,J)*D(1,J+1))/WK(2,J)
    329    40 CONTINUE
     329      END DO
    330330C --------------------(  END  CODING FROM CUBSPL )--------------------
    331331C

  • LMDZ6/branches/Amaury_dev/libf/misc/ran1.F

    r5082 r5086  
    2121        IX1=MOD(IA1*IX1+IC1,M1)
    2222        IX3=MOD(IX1,M3)
    23         DO 11 J=1,97
     23        DO J=1,97
    2424          IX1=MOD(IA1*IX1+IC1,M1)
    2525          IX2=MOD(IA2*IX2+IC2,M2)
    2626          R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1
    27 11      CONTINUE
     27      END DO
    2828        IDUM=1
    2929      ENDIF

  • LMDZ6/branches/Amaury_dev/libf/misc/regr1_step_av_m.F90

    r3435 r5086  
    7373          is = is + 1
    7474          left_edge = xs(is)
    75        end do
     75       END DO
    7676       ! 1 <= is <= ns
    7777       vt(it) = (vt(it) + (xt(it + 1) - left_edge) * vs(is)) &
    … …  
    7979       if (xs(is + 1) == xt(it + 1)) is = is + 1
    8080       ! 1 <= is <= ns .or. it == nt
    81     end do
     81    END DO
    8282
    8383  end function regr11_step_av
    … …  
    133133          is = is + 1
    134134          left_edge = xs(is)
    135        end do
     135       END DO
    136136       ! 1 <= is <= ns
    137137       vt(it, :) = (vt(it, :) + (xt(it + 1) - left_edge) * vs(is, :)) &
    … …  
    139139       if (xs(is + 1) == xt(it + 1)) is = is + 1
    140140       ! 1 <= is <= ns .or. it == nt
    141     end do
     141    END DO
    142142
    143143  end function regr12_step_av
    … …  
    194194          is = is + 1
    195195          left_edge = xs(is)
    196        end do
     196       END DO
    197197       ! 1 <= is <= ns
    198198       vt(it, :, :) = (vt(it, :, :) &
    … …  
    200200       if (xs(is + 1) == xt(it + 1)) is = is + 1
    201201       ! 1 <= is <= ns .or. it == nt
    202     end do
     202    END DO
    203203
    204204  end function regr13_step_av
    … …  
    256256          is = is + 1
    257257          left_edge = xs(is)
    258        end do
     258       END DO
    259259       ! 1 <= is <= ns
    260260       vt(it, :, :, :) = (vt(it, :, :, :) + (xt(it + 1) - left_edge) &
    … …  
    262262       if (xs(is + 1) == xt(it + 1)) is = is + 1
    263263       ! 1 <= is <= ns .or. it == nt
    264     end do
     264    END DO
    265265
    266266  end function regr14_step_av

  • LMDZ6/branches/Amaury_dev/libf/misc/xermsg.F

    r5082 r5086  
    328328      IF (LKNTRL > 0) THEN
    329329         WRITE (TEMP, '(''ERROR NUMBER = '', I8)') NERR
    330          DO 10 I=16,22
     330         DO I=16,22
    331331            IF (TEMP(I:I) /= ' ') GO TO 20
    332    10    CONTINUE
     332      END DO
    333333C
    334334   20    CALL XERPRN (' *  ', -1, TEMP(1:15) // TEMP(I:23), 72)

  • LMDZ6/branches/Amaury_dev/libf/misc/xerprn.F

    r5082 r5086  
    9292C
    9393      N = I1MACH(4)
    94       DO 10 I=1,NUNIT
     94      DO I=1,NUNIT
    9595         IF (IU(I) == 0) IU(I) = N
    96    10 CONTINUE
     96      END DO
    9797C
    9898C       LPREF IS THE LENGTH OF THE PREFIX.  THE PREFIX IS PLACED AT THE
    … …  
    117117      LENMSG = LEN(MESSG)
    118118      N = LENMSG
    119       DO 20 I=1,N
     119      DO I=1,N
    120120         IF (MESSG(LENMSG:LENMSG) /= ' ') GO TO 30
    121121         LENMSG = LENMSG - 1
    122    20 CONTINUE
     122      END DO
    123123   30 CONTINUE
    124124C
    … …  
    127127      IF (LENMSG == 0) THEN
    128128         CBUFF(LPREF+1:LPREF+1) = ' '
    129          DO 40 I=1,NUNIT
     129         DO I=1,NUNIT
    130130            WRITE(IU(I), '(A)') CBUFF(1:LPREF+1)
    131    40    CONTINUE
     131      END DO
    132132         RETURN
    133133      ENDIF
    … …  
    179179         LPIECE = MIN(LWRAP, LENMSG+1-NEXTC)
    180180         IF (LPIECE < LENMSG+1-NEXTC) THEN
    181             DO 52 I=LPIECE+1,2,-1
     181            DO I=LPIECE+1,2,-1
    182182               IF (MESSG(NEXTC+I-1:NEXTC+I-1) == ' ') THEN
    183183                  LPIECE = I-1
    … …  
    185185                  GOTO 54
    186186               ENDIF
    187    52       CONTINUE
     187      END DO
    188188         ENDIF
    189189   54    CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1)
    … …  
    202202         IDELTA = 0
    203203         LPIECE = LWRAP
    204          DO 56 I=LPIECE+1,2,-1
     204         DO I=LPIECE+1,2,-1
    205205            IF (MESSG(NEXTC+I-1:NEXTC+I-1) == ' ') THEN
    206206               LPIECE = I-1
    … …  
    208208               GOTO 58
    209209            ENDIF
    210    56    CONTINUE
     210      END DO
    211211   58    CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1)
    212212         NEXTC = NEXTC + LPIECE + IDELTA
    … …  
    223223C       PRINT
    224224C
    225       DO 60 I=1,NUNIT
     225      DO I=1,NUNIT
    226226         WRITE(IU(I), '(A)') CBUFF(1:LPREF+LPIECE)
    227    60 CONTINUE
     227      END DO
    228228C
    229229      IF (NEXTC <= LENMSG) GO TO 50

  • LMDZ6/branches/Amaury_dev/libf/misc/xersve.F

    r5082 r5086  
    8181C
    8282         CALL XGETUA (LUN, NUNIT)
    83          DO 20 KUNIT = 1,NUNIT
     83         DO KUNIT = 1,NUNIT
    8484            IUNIT = LUN(KUNIT)
    8585            IF (IUNIT==0) IUNIT = I1MACH(4)
    … …  
    9191C           Print body of table.
    9292C
    93             DO 10 I = 1,NMSG
     93            DO I = 1,NMSG
    9494               WRITE (IUNIT,9010) LIBTAB(I), SUBTAB(I), MESTAB(I),
    9595     *            NERTAB(I),LEVTAB(I),KOUNT(I)
    96    10       CONTINUE
     96      END DO
    9797C
    9898C           Print number of other errors.
    … …  
    100100            IF (KOUNTX/=0) WRITE (IUNIT,9020) KOUNTX
    101101            WRITE (IUNIT,9030)
    102    20    CONTINUE
     102      END DO
    103103C
    104104C        Clear the error tables.
    … …  
    117117         SUB = SUBROU
    118118         MES = MESSG
    119          DO 30 I = 1,NMSG
     119         DO I = 1,NMSG
    120120            IF (LIB==LIBTAB(I) .AND. SUB==SUBTAB(I) .AND.
    121121     *         MES==MESTAB(I) .AND. NERR==NERTAB(I) .AND.
    … …  
    125125                  RETURN
    126126            ENDIF
    127    30    CONTINUE
     127      END DO
    128128C
    129129         IF (NMSG<LENTAB) THEN

  • LMDZ6/branches/Amaury_dev/libf/misc/xgetua.F

    r5082 r5086  
    4545C***FIRST EXECUTABLE STATEMENT  XGETUA
    4646      N = J4SAVE(5,0,.FALSE.)
    47       DO 30 I=1,N
     47      DO I=1,N
    4848         INDEX = I+4
    4949         IF (I==1) INDEX = 3
    5050         IUNITA(I) = J4SAVE(INDEX,0,.FALSE.)
    51    30 CONTINUE
     51      END DO
    5252      RETURN
    5353      END
Note: See TracChangeset for help on using the changeset viewer.