Changeset 5086 for LMDZ6/branches


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

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

Location:
LMDZ6/branches/Amaury_dev
Files:
130 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/advect.F

    r2622 r5086  
    5757         deuxjour = 2. * daysec
    5858
    59          DO   1  ij   = 1, ip1jmp1
     59         DO   ij   = 1, ip1jmp1
    6060         unsaire2(ij) = unsaire(ij) * unsaire(ij)
    61    1     CONTINUE
     61      END DO
    6262      END IF
    6363
    … …  
    100100
    101101c
    102       DO 20 l = 1, llmm1
     102      DO l = 1, llmm1
    103103
    104104
    105105c       ......   calcul de  - w/2.    au niveau  l+1   .......
    106106
    107       DO 5   ij   = 1, ip1jmp1
     107      DO ij   = 1, ip1jmp1
    108108      wsur2( ij ) = - 0.5 * w( ij,l+1 )
    109    5  CONTINUE
     109      END DO
    110110
    111111
    112112c     .....................     calcul pour  du     ..................
    113113
    114       DO 6 ij = iip2 ,ip1jm-1
     114      DO ij = iip2 ,ip1jm-1
    115115      ww        = wsur2 (  ij  )     + wsur2( ij+1 )
    116116      uu        = 0.5 * ( ucov(ij,l) + ucov(ij,l+1) )
    117117      du(ij,l)  = du(ij,l)   - ww * ( uu - uav(ij, l ) )/massebx(ij, l )
    118118      du(ij,l+1)= du(ij,l+1) + ww * ( uu - uav(ij,l+1) )/massebx(ij,l+1)
    119    6  CONTINUE
     119      END DO
    120120
    121121c     .....  correction pour  du(iip1,j,l)  ........
    … …  
    123123
    124124CDIR$ IVDEP
    125       DO   7  ij   = iip1 +iip1, ip1jm, iip1
     125      DO   ij   = iip1 +iip1, ip1jm, iip1
    126126      du( ij, l  ) = du( ij -iim, l  )
    127127      du( ij,l+1 ) = du( ij -iim,l+1 )
    128    7  CONTINUE
     128      END DO
    129129
    130130c     .................    calcul pour   dv      .....................
    131131
    132       DO 8 ij = 1, ip1jm
     132      DO ij = 1, ip1jm
    133133      ww        = wsur2( ij+iip1 )   + wsur2( ij )
    134134      vv        = 0.5 * ( vcov(ij,l) + vcov(ij,l+1) )
    135135      dv(ij,l)  = dv(ij, l ) - ww * (vv - vav(ij, l ) )/masseby(ij, l )
    136136      dv(ij,l+1)= dv(ij,l+1) + ww * (vv - vav(ij,l+1) )/masseby(ij,l+1)
    137    8  CONTINUE
     137      END DO
    138138
    139139c
    … …  
    147147c                   ...............
    148148
    149         DO 15 ij = 1, ip1jmp1
     149        DO ij = 1, ip1jmp1
    150150         ww            = wsur2(ij) * (teta(ij,l) + teta(ij,l+1) )
    151151         dteta(ij, l ) = dteta(ij, l )  -  ww
    152152         dteta(ij,l+1) = dteta(ij,l+1)  +  ww
    153   15    CONTINUE
     153      END DO
    154154
    155155      IF( conser)  THEN
    156         DO 17 ij = 1,ip1jmp1
     156        DO ij = 1,ip1jmp1
    157157        ge(ij)   = wsur2(ij) * wsur2(ij) * unsaire2(ij)
    158   17    CONTINUE
     158      END DO
    159159        gt       = SSUM( ip1jmp1,ge,1 )
    160160        gtot(l)  = deuxjour * SQRT( gt/ip1jmp1 )
    161161      END IF
    162162
    163   20  CONTINUE
     163      END DO
    164164 
    165165      RETURN

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/dteta1.F

    r2603 r5086  
    3232c
    3333
    34       DO 5 l = 1,llm
     34      DO l = 1,llm
    3535
    36       DO 1  ij = iip2, ip1jm - 1
     36      DO ij = iip2, ip1jm - 1
    3737      hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l) + teta(ij+1,l) )
    38    1  CONTINUE
     38      END DO
    3939
    4040c    .... correction pour  hbxu(iip1,j,l)  .....
    … …  
    4242
    4343CDIR$ IVDEP
    44       DO 2 ij = iip1+ iip1, ip1jm, iip1
     44      DO ij = iip1+ iip1, ip1jm, iip1
    4545      hbxu( ij, l ) = hbxu( ij - iim, l )
    46    2  CONTINUE
     46      END DO
    4747
    4848
    49       DO 3 ij = 1,ip1jm
     49      DO ij = 1,ip1jm
    5050      hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+ teta(ij +iip1,l) )
    51    3  CONTINUE
     51      END DO
    5252
    53    5  CONTINUE
     53      END DO
    5454
    5555

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/dudv1.F

    r1907 r5086  
    2727c
    2828c
    29       DO 10 l = 1,llm
     29      DO l = 1,llm
    3030c
    31       DO 2  ij = iip2, ip1jm - 1
     31      DO ij = iip2, ip1jm - 1
    3232      du( ij,l ) = 0.125 *(  vorpot(ij-iip1, l) + vorpot( ij, l)  ) *
    3333     *                    (   pbarv(ij-iip1, l) + pbarv(ij-iim,  l) +
    3434     *                        pbarv(   ij  , l) + pbarv(ij+ 1 ,  l)   )
    35    2  CONTINUE
     35      END DO
    3636c
    37       DO 3 ij = 1, ip1jm - 1
     37      DO ij = 1, ip1jm - 1
    3838      dv( ij+1,l ) = - 0.125 *(  vorpot(ij, l)  + vorpot(ij+1, l)  ) *
    3939     *                        (   pbaru(ij, l)  +  pbaru(ij+1   , l) +
    4040     *                       pbaru(ij+iip1, l)  +  pbaru(ij+iip2, l)  )
    41    3  CONTINUE
     41      END DO
    4242c
    4343c    .... correction  pour  dv( 1,j,l )  .....
    … …  
    4545c
    4646CDIR$ IVDEP
    47       DO 4 ij = 1, ip1jm, iip1
     47      DO ij = 1, ip1jm, iip1
    4848      dv( ij,l ) = dv( ij + iim, l )
    49    4  CONTINUE
     49      END DO
    5050c
    51   10  CONTINUE
     51      END DO
    5252      RETURN
    5353      END

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/dudv2.F

    r2600 r5086  
    3434c
    3535c
    36       DO 5 l = 1,llm
     36      DO l = 1,llm
    3737c
    38       DO 2  ij  = iip2, ip1jm - 1
     38      DO ij  = iip2, ip1jm - 1
    3939       du(ij,l) = du(ij,l) + 0.5* ( teta( ij,l ) + teta( ij+1,l ) ) *
    4040     * ( pkf( ij,l ) - pkf(ij+1,l) )  + bern(ij,l) - bern(ij+1,l)
    41    2  CONTINUE
     41      END DO
    4242c
    4343c
    … …  
    4646c
    4747CDIR$ IVDEP
    48       DO 3 ij = iip1+ iip1, ip1jm, iip1
     48      DO ij = iip1+ iip1, ip1jm, iip1
    4949      du( ij,l ) = du( ij - iim,l )
    50    3  CONTINUE
     50      END DO
    5151c
    5252c
    53       DO 4 ij  = 1,ip1jm
     53      DO ij  = 1,ip1jm
    5454      dv( ij,l) = dv(ij,l) + 0.5 * ( teta(ij,l) + teta( ij+iip1,l ) ) *
    5555     *                             ( pkf(ij+iip1,l) - pkf(  ij,l  ) )
    5656     *                           +   bern( ij+iip1,l ) - bern( ij  ,l )
    57    4  CONTINUE
     57      END DO
    5858c
    59    5  CONTINUE
     59      END DO
    6060c
    6161      RETURN

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/iniinterp_horiz.F

    r5082 r5086  
    7474         a(i) = rlonuo(i-1)
    7575         b(i) =  rlonuo(i)
    76       end do
     76      END DO
    7777
    7878      d(1) = pi/2
    … …  
    8080         c(j) = rlatvo(j)
    8181         d(j+1) = rlatvo(j)
    82       end do
     82      END DO
    8383      c(jmo+1) = -pi/2
    8484     
    … …  
    9191         an(i) = rlonun(i-1)
    9292         bn(i) =  rlonun(i)
    93       end do
     93      END DO
    9494
    9595      dn(1) = pi/2
    … …  
    9797         cn(j) = rlatvn(j)
    9898         dn(j+1) = rlatvn(j)
    99       end do
     99      END DO
    100100      cn(jmn+1) = -pi/2
    101101
    … …  
    105105        do jj = 1,jmn+1
    106106               airen(ii,jj) = (bn(ii)-an(ii))*(sin(dn(jj))-sin(cn(jj)))
    107         end do
    108       end do
     107        END DO
     108      END DO
    109109
    110110c Calcul de la surface des intersections
    … …  
    151151                      intersec(ktotal)=(bb-aa)*(sin(dd)-sin(cc))
    152152                     end if
    153                 end do
    154                end do
     153                END DO
     154               END DO
    155155             end if
    156          end do
    157        end do       
     156         END DO
     157       END DO
    158158
    159159

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/interp_horiz.F

    r1907 r5086  
    7373        do ii=1, imn+1
    7474          varn(ii,jj,l) =0.
    75         end do
    76        end do
    77       end do
     75        END DO
     76       END DO
     77      END DO
    7878       
    7979c Interpolation horizontale
    … …  
    8888         varn(iik(k),jjk(k),l) = varn(iik(k),jjk(k),l)
    8989     &        + varo(ik(k), jk(k),l)*intersec(k)/airen(iik(k),jjk(k))
    90         end do
    91       end do
     90        END DO
     91      END DO
    9292
    9393c Une seule valeur au pole pour les variables ! :
    … …  
    9999             totn = totn + varn(ii,1,l)
    100100             tots = tots + varn (ii,jmn+1,l)
    101            end do
     101           END DO
    102102           do ii =1, imn+1
    103103             varn(ii,1,l) = totn/REAL(imn+1)
    104104             varn(ii,jmn+1,l) = tots/REAL(imn+1)
    105            end do
    106        end do
     105           END DO
     106       END DO
    107107           
    108108
    … …  
    115115!!         do ii=1, imn+1
    116116!!           airetest(ii,jj) =0.
    117 !!         end do
    118 !!       end do
     117!!         END DO
     118!!       END DO
    119119!!       PRINT *, 'ktotal = ', ktotal
    120120!!       PRINT *, 'jmn+1 =', jmn+1, 'imn+1', imn+1
    … …  
    136136!!              aire_ok = .false.
    137137!!          end if
    138 !!        end do
    139 !!       end do
     138!!        END DO
     139!!       END DO
    140140!! !      if (aire_ok) write(*,*) 'INTERP. HORIZ. : AIRES OK'
    141141!!  99   continue

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j.F

    r5082 r5086  
    6565c Eventuellement, faire l'extrapolation a partir des deux couches
    6666c les plus basses ou les deux couches les plus hautes:
    67       DO 130 i = 1, ilon
     67      DO i = 1, ilon
    6868cIM      IF ( ABS(pres-pgcm(i,ilev) ) .LT.
    6969         IF ( ABS(pres-pgcm(i,ilev) ) >
    … …  
    7777cIM   PRINT*,'i, ABS(pres-pgcm),ABS(pres-pgcm)',
    7878cIM  .i, ABS(pres-pgcm(i,ilev)),ABS(pres-pgcm(i,1))
    79   130 CONTINUE
    80       DO 150 k = 1, ilev-1
    81          DO 140 i = 1, ilon
     79      END DO
     80      DO k = 1, ilev-1
     81         DO i = 1, ilon
    8282            pbot = pgcm(i,k)
    8383            ptop = pgcm(i,k+1)
    … …  
    8787               lb(i) = k
    8888            ENDIF
    89   140    CONTINUE
    90   150 CONTINUE
     89      END DO
     90      END DO
    9191c
    9292c Interpolation lineaire:

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j1.F

    r5082 r5086  
    6565c Eventuellement, faire l'extrapolation a partir des deux couches
    6666c les plus basses ou les deux couches les plus hautes:
    67       DO 130 i = 1, ilon
     67      DO i = 1, ilon
    6868cIM      IF ( ABS(pres-pgcm(i,ilev) ) .LT.
    6969         IF ( ABS(pres-pgcm(i,ilev) ) >
    … …  
    7777cIM   PRINT*,'i, ABS(pres-pgcm),ABS(pres-pgcm)',
    7878cIM  .i, ABS(pres-pgcm(i,ilev)),ABS(pres-pgcm(i,1))
    79   130 CONTINUE
    80       DO 150 k = 1, ilev-1
    81          DO 140 i = 1, ilon
     79      END DO
     80      DO k = 1, ilev-1
     81         DO i = 1, ilon
    8282            pbot = pgcm(i,k)
    8383            ptop = pgcm(i,k+1)
    … …  
    8787               lb(i) = k
    8888            ENDIF
    89   140    CONTINUE
    90   150 CONTINUE
     89      END DO
     90      END DO
    9191c
    9292c Interpolation lineaire:

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/bernoui.F

    r2603 r5086  
    4343c   ---------------------
    4444c
    45       DO 4 ijl = 1,ngrid*nlay
     45      DO ijl = 1,ngrid*nlay
    4646         pbern( ijl ) =  pphi( ijl ) + pecin( ijl )
    47    4  CONTINUE
     47      END DO
    4848c
    4949c-----------------------------------------------------------------------

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/convflu.F

    r4593 r5086  
    3232      INCLUDE "comgeom.h"
    3333c
    34       DO 5 l = 1,nbniv
     34      DO l = 1,nbniv
    3535c
    36       DO 2  ij = iip2, ip1jm - 1
     36      DO ij = iip2, ip1jm - 1
    3737      convfl( ij + 1,l ) =  xflu(   ij,l ) - xflu( ij +  1,l )   +
    3838     *                      yflu(ij +1,l ) - yflu( ij -iim,l )
    39    2  CONTINUE
     39      END DO
    4040c
    4141c
    … …  
    4545c
    4646CDIR$ IVDEP
    47       DO 3 ij = iip2,ip1jm,iip1
     47      DO ij = iip2,ip1jm,iip1
    4848      convfl( ij,l ) = convfl( ij + iim,l )
    49    3  CONTINUE
     49      END DO
    5050c
    5151c     ......  calcul aux poles  .......
    … …  
    5353      convpn =   SSUM( iim, yflu(     1    ,l ),  1 )
    5454      convps = - SSUM( iim, yflu( ip1jm-iim,l ),  1 )
    55       DO 4 ij = 1,iip1
     55      DO ij = 1,iip1
    5656      convfl(     ij   ,l ) = convpn * aire(   ij     ) / apoln
    5757      convfl( ij+ ip1jm,l ) = convps * aire( ij+ ip1jm) / apols
    58    4  CONTINUE
     58      END DO
    5959c
    60    5  CONTINUE
     60      END DO
    6161      RETURN
    6262      END

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/disvert.F90

    r4257 r5086  
    320320     do l = 1, llm + 1
    321321        read(unit, fmt=*) ap(l), bp(l)
    322      end do
     322     END DO
    323323     close(unit)
    324324     call assert(ap(1) == 0., ap(llm + 1) == 0., bp(1) == 1., &

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/disvert_noterre.F

    r5082 r5086  
    139139         do l=1,llm
    140140            read(99,*) zsig(l)
    141          end do
     141         END DO
    142142         CLOSE(99)
    143143
    … …  
    146146           sig(l) = 0.5 * ( exp(-zsig(l)/scaleheight) +
    147147     &                      exp(-zsig(l-1)/scaleheight) )
    148          end do
     148         END DO
    149149         sig(llm+1) =0
    150150
    … …  
    264264c          zsig(l)= zsig(l-1)-scaleheight*
    265265c    .    log((aps(l) + bps(l)*ps)/(aps(l-1) + bps(l-1)*ps))
    266 c       end do
     266c       END DO
    267267c       write(53,'(I3,50F10.5)') iz, zsig
    268 c      end do
     268c      END DO
    269269c      close(53)
    270270c     --------------------------------------------------

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/diverg.F

    r4593 r5086  
    4141c
    4242c
    43       DO 10 l = 1,klevel
     43      DO l = 1,klevel
    4444c
    4545        DO  ij = iip2, ip1jm - 1
    … …  
    7070         div( ij + ip1jm, l ) =   sumyps
    7171        ENDDO
    72   10  CONTINUE
     72      END DO
    7373c
    7474

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/diverg_gam.F

    r4593 r5086  
    4444c
    4545c
    46       DO 10 l = 1,klevel
     46      DO l = 1,klevel
    4747c
    4848        DO  ij = iip2, ip1jm - 1
    … …  
    7474         div( ij + ip1jm, l ) =   sumyps
    7575        ENDDO
    76   10  CONTINUE
     76      END DO
    7777c
    7878

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/divergf.F

    r4593 r5086  
    4141c
    4242c
    43       DO 10 l = 1,klevel
     43      DO l = 1,klevel
    4444c
    4545        DO  ij = iip2, ip1jm - 1
    … …  
    7070         div( ij + ip1jm, l ) =   sumyps
    7171        ENDDO
    72   10  CONTINUE
     72      END DO
    7373c
    7474

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/divergst.F

    r4593 r5086  
    3030c
    3131c
    32       DO 10 l = 1,klevel
     32      DO l = 1,klevel
    3333c
    34       DO 1 ij = iip2, ip1jm - 1
     34      DO ij = iip2, ip1jm - 1
    3535      div( ij + 1, l ) = x(ij+1,l) - x(ij,l)+ y(ij-iim,l)-y(ij+1,l)
    36    1  CONTINUE
     36      END DO
    3737c
    3838c     ....  correction pour  div( 1,j,l)  ......
    … …  
    4040c
    4141CDIR$ IVDEP
    42       DO 3 ij = iip2,ip1jm,iip1
     42      DO ij = iip2,ip1jm,iip1
    4343      div( ij,l ) = div( ij + iim,l )
    44    3  CONTINUE
     44      END DO
    4545c
    4646c     ....  calcul  aux poles  .....
    4747c
    4848c
    49       DO 5 i  = 1,iim
     49      DO i  = 1,iim
    5050      aiy1(i)= y(i,l)
    5151      aiy2(i)= y(i+ip1jmi1,l)
    52    5  CONTINUE
     52      END DO
    5353      sumypn = SSUM ( iim,aiy1,1 )
    5454      sumyps = SSUM ( iim,aiy2,1 )
    55       DO 7 i = 1,iip1
     55      DO i = 1,iip1
    5656      div(     i    , l ) = - sumypn/iim
    5757      div( i + ip1jm, l ) =   sumyps/iim
    58    7  CONTINUE
     58      END DO
    5959c
    60   10  CONTINUE
     60      END DO
    6161      RETURN
    6262      END

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/divgrad.F

    r2603 r5086  
    3636      CALL SCOPY ( ip1jmp1*klevel,h,1,divgra,1 )
    3737c
    38       DO 10 iter = 1,lh
     38      DO iter = 1,lh
    3939
    4040      CALL filtreg ( divgra,jjp1,klevel,2,1,.true.,1  )
    … …  
    4545      CALL filtreg ( divgra,jjp1,klevel,2,1,.true.,1)
    4646
    47       DO 5 l = 1,klevel
    48       DO 4  ij = 1, ip1jmp1
     47      DO l = 1,klevel
     48      DO ij = 1, ip1jmp1
    4949      divgra( ij,l ) = - cdivh * divgra( ij,l )
    50    4  CONTINUE
    51    5  CONTINUE
     50      END DO
     51      END DO
    5252c
    53   10  CONTINUE
     53      END DO
    5454      RETURN
    5555      END

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/fxhyp_m.F90

    r2598 r5086  
    191191             do while (rlonm025(is2) < - pi .and. is2 < iim)
    192192                is2 = is2 + 1
    193              end do
     193             END DO
    194194
    195195             if (rlonm025(is2) < - pi) then
    … …  
    202202             do while (rlonm025(is2) > pi .and. is2 > 1)
    203203                is2 = is2 - 1
    204              end do
     204             END DO
    205205
    206206             if (rlonm025(is2) > pi) then

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/geopot.F

    r2600 r5086  
    4747c     calcul de phi au niveau 1 pres du sol  .....
    4848
    49       DO   1  ij  = 1, ngrid
     49      DO   ij  = 1, ngrid
    5050      phi( ij,1 ) = phis( ij ) + teta(ij,1) * ( pks(ij) - pk(ij,1) )
    51    1  CONTINUE
     51      END DO
    5252
    5353c     calcul de phi aux niveaux superieurs  .......

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/grad.F

    r4593 r5086  
    2323c
    2424c
    25       DO 6 l = 1,klevel
     25      DO l = 1,klevel
    2626c
    27       DO 2  ij = 1, ip1jmp1 - 1
     27      DO ij = 1, ip1jmp1 - 1
    2828      pgx( ij,l ) = pg( ij +1,l ) - pg( ij,l )
    29    2  CONTINUE
     29      END DO
    3030c
    3131c    .... correction pour  pgx(ip1,j,l)  ....
    3232c    ...    pgx(iip1,j,l)= pgx(1,j,l)  ....
    3333CDIR$ IVDEP
    34       DO 3  ij = iip1, ip1jmp1, iip1
     34      DO ij = iip1, ip1jmp1, iip1
    3535      pgx( ij,l ) = pgx( ij -iim,l )
    36    3  CONTINUE
     36      END DO
    3737c
    38       DO 4 ij = 1,ip1jm
     38      DO ij = 1,ip1jm
    3939      pgy( ij,l ) = pg( ij,l ) - pg( ij +iip1,l )
    40    4  CONTINUE
     40      END DO
    4141c
    42    6  CONTINUE
     42      END DO
    4343      RETURN
    4444      END

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/gradiv.F

    r2603 r5086  
    3737      CALL SCOPY( ip1jm*klevel,  ycov,1,gdy,1 )
    3838c
    39       DO 10 iter = 1,ld
     39      DO iter = 1,ld
    4040c
    4141      CALL  diverg( klevel,  gdx , gdy, div          )
    … …  
    4343      CALL    grad( klevel,  div, gdx, gdy           )
    4444c
    45       DO 5  l = 1, klevel
    46       DO 3 ij = 1, ip1jmp1
     45      DO l = 1, klevel
     46      DO ij = 1, ip1jmp1
    4747      gdx( ij,l ) = - gdx( ij,l ) * cdivu
    48    3  CONTINUE
    49       DO 4 ij = 1, ip1jm
     48      END DO
     49      DO ij = 1, ip1jm
    5050      gdy( ij,l ) = - gdy( ij,l ) * cdivu
    51    4  CONTINUE
    52    5  CONTINUE
     51      END DO
     52      END DO
    5353c
    54   10  CONTINUE
     54      END DO
    5555      RETURN
    5656      END

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inigeom.F

    r5082 r5086  
    224224c
    225225        xo1 = 0.
    226         DO 10 iter = 1, itmax
     226        DO iter = 1, itmax
    227227        x1  = xo1
    228228        f   = x1+ alphax *SIN(x1-pxo)
    … …  
    232232        IF( xdm<=eps )GO TO 11
    233233        xo1 = x1
    234  10     CONTINUE
     234      END DO
    235235 11     CONTINUE
    236236c
    … …  
    241241C
    242242        yo1  = 0.
    243         DO 15 iter = 1,itmay
     243        DO iter = 1,itmay
    244244        y1   = yo1
    245245        f    = y1 + alphay* SIN(y1-pyo)
    … …  
    249249        IF(ydm<=eps) GO TO 17
    250250        yo1  = y1
    251  15     CONTINUE
     251      END DO
    252252c
    253253 17     CONTINUE
    … …  
    346346c
    347347c
    348       DO 35 j = 1, jjp1
     348      DO j = 1, jjp1
    349349c
    350350      IF ( j. eq. 1 )  THEN
    … …  
    356356      radclatm       = 0.5* rad * coslatm
    357357c
    358       DO 30 i = 1, iim
     358      DO i = 1, iim
    359359      xprp           = xprimp025( i )
    360360      xprm           = xprimm025( i )
    … …  
    365365      cvij2  ( i,1 ) = 0.5* rad * yprm
    366366      cvij3  ( i,1 ) = cvij2(i,1)
    367   30  CONTINUE
     367      END DO
    368368c
    369369      DO  i = 1, iim
    … …  
    387387      radclatp            = 0.5* rad * coslatp
    388388c
    389       DO 31 i = 1,iim
     389      DO i = 1,iim
    390390        xprp              = xprimp025( i )
    391391        xprm              = xprimm025( i )
    … …  
    396396        cvij1(i,jjp1)     = 0.5 * rad* yprp
    397397        cvij4(i,jjp1)     = cvij1(i,jjp1)
    398  31   CONTINUE
     398      END DO
    399399c
    400400       DO   i    = 1, iim
    … …  
    428428         ai14            = un4rad2 * coslatp * yprp
    429429         ai23            = un4rad2 * coslatm * yprm
    430          DO 32 i = 1,iim
     430         DO i = 1,iim
    431431         xprp            = xprimp025( i )
    432432         xprm            = xprimm025( i )
    … …  
    444444         cvij3   ( i,j ) = cvij2(i,j)
    445445         cvij4   ( i,j ) = cvij1(i,j)
    446   32     CONTINUE
     446      END DO
    447447c
    448448      END IF
    … …  
    463463         aireij4 (iip1,j) = aireij4 (1,j )
    464464       
    465   35  CONTINUE
     465      END DO
    466466c
    467467c    ..............................................................
    468468c
    469       DO 37 j = 1, jjp1
    470       DO 36 i = 1, iim
     469      DO j = 1, jjp1
     470      DO i = 1, iim
    471471      aire    ( i,j )  = aireij1(i,j) + aireij2(i,j) + aireij3(i,j) +
    472472     *                          aireij4(i,j)
    … …  
    479479      alpha2p3( i,j )  = alpha2 (i,j) + alpha3 (i,j)
    480480      alpha3p4( i,j )  = alpha3 (i,j) + alpha4 (i,j)
    481   36  CONTINUE
     481      END DO
    482482c
    483483c
    … …  
    491491      alpha2p3(iip1,j) = alpha2p3(1,j)
    492492      alpha3p4(iip1,j) = alpha3p4(1,j)
    493   37  CONTINUE
    494 c
    495 
    496       DO 42 j = 1,jjp1
    497       DO 41 i = 1,iim
     493      END DO
     494c
     495
     496      DO j = 1,jjp1
     497      DO i = 1,iim
    498498      aireu       (i,j)= aireij1(i,j) + aireij2(i,j) + aireij4(i+1,j) +
    499499     *                                aireij3(i+1,j)
    … …  
    502502      unsair_gam2( i,j)= unsaire(i,j)** ( - gamdi_h    )
    503503      airesurg   ( i,j)= aire(i,j)/ g
    504   41  CONTINUE
     504      END DO
    505505      aireu     (iip1,j)  = aireu  (1,j)
    506506      unsaire   (iip1,j)  = unsaire(1,j)
    … …  
    508508      unsair_gam2(iip1,j) = unsair_gam2(1,j)
    509509      airesurg   (iip1,j) = airesurg(1,j)
    510   42  CONTINUE
    511 c
    512 c
    513       DO 48 j = 1,jjm
     510      END DO
     511c
     512c
     513      DO j = 1,jjm
    514514c
    515515        DO i=1,iim
    … …  
    529529        unsairz_gam(iip1,j) = unsairz_gam(1,j)
    530530c
    531   48  CONTINUE
     531      END DO
    532532c
    533533c

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inter_barxy_m.F90

    r5082 r5086  
    270270          x0   = xxid(idat)
    271271          idat = idat + 1
    272        end do
     272       END DO
    273273       IF (xxim(imod)<xxid(idat)) THEN
    274274          dx   = xxim(imod) - x0
    … …  
    287287          idat = idat + 1
    288288       END IF
    289     end do
     289    END DO
    290290
    291291  END function inter_barx
    … …  
    339339          y0         = yjdat(jdat)
    340340          jdat       = jdat + 1
    341        end do
     341       END DO
    342342       IF (yjmod(jmod) < yjdat(jdat)) THEN
    343343          dy         = yjmod(jmod) - y0
    … …  
    357357          jdat       = jdat + 1
    358358       END IF
    359     end do
     359    END DO
    360360    ! Le test de fin suppose que l'interface 0 est commune aux deux
    361361    ! grilles "yjdat" et "yjmod".

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/interpre.F

    r2622 r5086  
    4141
    4242c       CALCUL DE LA PRESSION DE SURFACE
    43 c       Les coefficients ap et bp sont passés en common
    44 c       Calcul de la pression au sol en mb optimisée pour
     43c       Les coefficients ap et bp sont pass�s en common
     44c       Calcul de la pression au sol en mb optimis�e pour
    4545c       la vectorialisation
    4646                   
    … …  
    6262             do i=1,iim
    6363                 psppm(i,j)=smass(i,j)/aire(i,j)*g*0.01
    64              end do
    65          end do                       
     64             END DO
     65         END DO
    6666       
    6767c RECONSTRUCTION DES CHAMPS CONTRAVARIANTS
    6868c Le programme ppm3d travaille avec les composantes
    69 c de vitesse et pas les flux, on doit donc passer de l'un à l'autre
    70 c Dans le même temps, on fait le changement d'orientation du vent en v
     69c de vitesse et pas les flux, on doit donc passer de l'un � l'autre
     70c Dans le m�me temps, on fait le changement d'orientation du vent en v
    7171      do l=1,llm
    7272          do j=1,jjm
    … …  
    9999     
    100100c INVERSION DES NIVEAUX
    101 c le programme ppm3d travaille avec une 3ème coordonnée inversée par rapport
     101c le programme ppm3d travaille avec une 3�me coordonn�e invers�e par rapport
    102102c de celle du LMDZ: z=1<=>niveau max, z=llm+1<=>surface
    103 c On passe donc des niveaux du LMDZ à ceux de Lin
     103c On passe donc des niveaux du LMDZ � ceux de Lin
    104104     
    105105      do l=1,llm+1

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/invert_zoom_x_m.F90

    r2598 r5086  
    3939       do while (xfi < xf(it) .and. it >= 1)
    4040          it = it - 1
    41        end do
     41       END DO
    4242
    4343       ! Calcul de Xf(xvrai(i))

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/massdair.F

    r2597 r5086  
    8282c=======================================================================
    8383
    84       DO   100    l = 1 , llm
     84      DO   l = 1 , llm
    8585c
    8686        DO    ij     = 1, ip1jmp1
    … …  
    103103c       ENDDO
    104104       
    105 100   CONTINUE
     105      END DO
    106106c
    107107      RETURN

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/nxgrad.F

    r4593 r5086  
    2222c
    2323c
    24       DO 10 l = 1,klevel
     24      DO l = 1,klevel
    2525c
    26       DO 1  ij = 2, ip1jm
     26      DO ij = 2, ip1jm
    2727      y( ij,l ) = (  rot( ij,l ) - rot( ij-1,l )  ) * cvsurcuv( ij )
    28    1  CONTINUE
     28      END DO
    2929c
    3030c    ..... correction pour  y ( 1,j,l )  ......
    … …  
    3232c    ....    y(1,j,l)= y(iip1,j,l) ....
    3333CDIR$ IVDEP
    34       DO 2  ij = 1, ip1jm, iip1
     34      DO ij = 1, ip1jm, iip1
    3535      y( ij,l ) = y( ij +iim,l )
    36    2  CONTINUE
     36      END DO
    3737c
    38       DO 4  ij = iip2,ip1jm
     38      DO ij = iip2,ip1jm
    3939      x( ij,l ) = (  rot( ij,l ) - rot( ij -iip1,l )  ) * cusurcvu( ij )
    40    4  CONTINUE
    41       DO 6 ij = 1,iip1
     40      END DO
     41      DO ij = 1,iip1
    4242      x(    ij    ,l ) = 0.
    4343      x( ij +ip1jm,l ) = 0.
    44    6  CONTINUE
     44      END DO
    4545c
    46   10  CONTINUE
     46      END DO
    4747      RETURN
    4848      END

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/nxgrad_gam.F

    r4593 r5086  
    2121      INTEGER   l,ij
    2222c
    23       DO 10 l = 1,klevel
     23      DO l = 1,klevel
    2424c
    25       DO 1  ij = 2, ip1jm
     25      DO ij = 2, ip1jm
    2626      y( ij,l ) = (rot( ij,l ) - rot( ij-1,l )) * cvscuvgam( ij )
    27    1  CONTINUE
     27      END DO
    2828c
    2929c    ..... correction pour  y ( 1,j,l )  ......
    … …  
    3131c    ....    y(1,j,l)= y(iip1,j,l) ....
    3232CDIR$ IVDEP
    33       DO 2  ij = 1, ip1jm, iip1
     33      DO ij = 1, ip1jm, iip1
    3434      y( ij,l ) = y( ij +iim,l )
    35    2  CONTINUE
     35      END DO
    3636c
    37       DO 4  ij = iip2,ip1jm
     37      DO ij = iip2,ip1jm
    3838      x( ij,l ) = (rot( ij,l ) - rot( ij -iip1,l )) * cuscvugam( ij )
    39    4  CONTINUE
    40       DO 6 ij = 1,iip1
     39      END DO
     40      DO ij = 1,iip1
    4141      x(    ij    ,l ) = 0.
    4242      x( ij +ip1jm,l ) = 0.
    43    6  CONTINUE
     43      END DO
    4444c
    45   10  CONTINUE
     45      END DO
    4646      RETURN
    4747      END

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/nxgradst.F

    r4593 r5086  
    2121      INTEGER l,ij
    2222c
    23       DO 10 l = 1,klevel
     23      DO l = 1,klevel
    2424c
    25       DO 1  ij = 2, ip1jm
     25      DO ij = 2, ip1jm
    2626      y(ij,l)=( rot(ij,l) - rot(ij-1,l))
    27    1  CONTINUE
     27      END DO
    2828c
    2929c    ..... correction pour  y ( 1,j,l )  ......
    … …  
    3131c    ....    y(1,j,l)= y(iip1,j,l) ....
    3232
    33       DO 2  ij = 1, ip1jm, iip1
     33      DO ij = 1, ip1jm, iip1
    3434      y( ij,l ) = y( ij +iim,l )
    35    2  CONTINUE
     35      END DO
    3636c
    37       DO 4  ij = iip2,ip1jm
     37      DO ij = iip2,ip1jm
    3838      x(ij,l)= rot(ij,l)-rot(ij-iip1,l)
    39    4  CONTINUE
    40       DO 6 ij = 1,iip1
     39      END DO
     40      DO ij = 1,iip1
    4141      x(    ij    ,l ) = 0.
    4242      x( ij +ip1jm,l ) = 0.
    43    6  CONTINUE
     43      END DO
    4444c
    45   10  CONTINUE
     45      END DO
    4646      RETURN
    4747      END

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/nxgrarot.F

    r2603 r5086  
    3636      CALL SCOPY (  ip1jm*klevel, ycov, 1, gry, 1 )
    3737c
    38       DO 10 iter = 1,lr
     38      DO iter = 1,lr
    3939      CALL  rotat (klevel,grx, gry, rot )
    4040      CALL filtreg( rot, jjm, klevel, 2,1, .false.,2)
    4141      CALL nxgrad (klevel,rot, grx, gry )
    4242c
    43       DO 5  l = 1, klevel
    44       DO 2 ij = 1, ip1jm
     43      DO l = 1, klevel
     44      DO ij = 1, ip1jm
    4545      gry( ij,l ) = - gry( ij,l ) * crot
    46    2  CONTINUE
    47       DO 3 ij = 1, ip1jmp1
     46      END DO
     47      DO ij = 1, ip1jmp1
    4848      grx( ij,l ) = - grx( ij,l ) * crot
    49    3  CONTINUE
    50    5  CONTINUE
     49      END DO
     50      END DO
    5151c
    52   10  CONTINUE
     52      END DO
    5353      RETURN
    5454      END

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/pbar.F

    r4593 r5086  
    8787
    8888
    89       DO 1 ij = 1, ip1jmp1 - 1
     89      DO ij = 1, ip1jmp1 - 1
    9090      pbarx( ij ) = pext(ij) * alpha1p2(ij) + pext(ij+1)*alpha3p4(ij+1)
    91    1  CONTINUE
     91      END DO
    9292
    9393c    .... correction pour pbarx( iip1,j) .....
    … …  
    9595c    ...    pbarx(iip1,j)= pbarx(1,j) ...
    9696CDIR$ IVDEP
    97       DO 2 ij = iip1, ip1jmp1, iip1
     97      DO ij = iip1, ip1jmp1, iip1
    9898      pbarx( ij ) = pbarx( ij - iim )
    99    2  CONTINUE
     99      END DO
    100100
    101101
    102       DO 3 ij = 1,ip1jm
     102      DO ij = 1,ip1jm
    103103      pbary( ij ) = pext(   ij  )   * alpha2p3(   ij   )     +
    104104     *              pext( ij+iip1 ) * alpha1p4( ij+iip1 )
    105    3  CONTINUE
     105      END DO
    106106
    107107
    108       DO 5 ij = 1, ip1jm - 1
     108      DO ij = 1, ip1jm - 1
    109109      pbarxy( ij ) = pext(ij)*alpha2(ij) + pext(ij+1)*alpha3(ij+1) +
    110110     *   pext(ij+iip1)*alpha1(ij+iip1) + pext(ij+iip2)*alpha4(ij+iip2)
    111    5  CONTINUE
     111      END DO
    112112
    113113
    … …  
    116116CDIR$ IVDEP
    117117
    118       DO 7 ij = iip1, ip1jm, iip1
     118      DO ij = iip1, ip1jm, iip1
    119119      pbarxy( ij ) = pbarxy( ij - iim )
    120    7  CONTINUE
     120      END DO
    121121
    122122

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/prather.F

    r5082 r5086  
    149149       call advxp( limit,0.5*dt,pbaru,sm,s0,sx,sy,sz
    150150     .             ,sxx,sxy,sxz,syy,syz,szz,1 )
    151         end do
     151        END DO
    152152        do l=1,llm
    153153        do i=1,iip1
    … …  
    206206       call advxp( limit,0.5*dt,pbaru,sm,s0,sx,sy,sz
    207207     .             ,sxx,sxy,sxz,syy,syz,szz,1 )
    208         end do
     208        END DO
    209209c---------------------------------------------------------
    210210c---------------------------------------------------------

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/psextbar.F

    r4593 r5086  
    8989
    9090
    91       DO     5     ij = 1, ip1jm - 1
     91      DO     ij = 1, ip1jm - 1
    9292      psexbarxy( ij ) = pext(ij)*alpha2(ij) + pext(ij+1)*alpha3(ij+1) +
    9393     *   pext(ij+iip1)*alpha1(ij+iip1) + pext(ij+iip2)*alpha4(ij+iip2)
    94    5  CONTINUE
     94      END DO
    9595
    9696
    … …  
    9999CDIR$ IVDEP
    100100
    101       DO 7 ij = iip1, ip1jm, iip1
     101      DO ij = iip1, ip1jm, iip1
    102102      psexbarxy( ij ) = psexbarxy( ij - iim )
    103    7  CONTINUE
     103      END DO
    104104
    105105

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/rotat.F

    r4593 r5086  
    3030c
    3131c
    32       DO  10 l = 1,klevel
     32      DO  l = 1,klevel
    3333c
    3434        DO   ij = 1, ip1jm - 1
    … …  
    4444        ENDDO
    4545c
    46   10  CONTINUE
     46      END DO
    4747
    4848ccc        CALL filtreg( rot, jjm, klevel, 2, 2, .FALSE., 1 )

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/rotat_nfil.F

    r4593 r5086  
    3030c
    3131c
    32       DO  10 l = 1,klevel
     32      DO  l = 1,klevel
    3333c
    3434        DO   ij = 1, ip1jm - 1
    … …  
    4444        ENDDO
    4545c
    46   10  CONTINUE
     46      END DO
    4747
    4848      RETURN

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/rotatf.F

    r4593 r5086  
    3131c
    3232c
    33       DO  10 l = 1,klevel
     33      DO  l = 1,klevel
    3434c
    3535        DO   ij = 1, ip1jm - 1
    … …  
    4545        ENDDO
    4646c
    47   10  CONTINUE
     47      END DO
    4848
    4949        CALL filtreg( rot, jjm, klevel, 2, 2, .FALSE., 1 )

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/rotatst.F

    r4593 r5086  
    2424c
    2525c
    26       DO 5 l = 1,klevel
     26      DO l = 1,klevel
    2727c
    28       DO 1 ij = 1, ip1jm - 1
     28      DO ij = 1, ip1jm - 1
    2929      rot( ij,l )  =  (  y( ij+1 , l )  -  y( ij,l )   +
    3030     *                 x(ij +iip1, l )  -  x( ij,l )  )
    31    1  CONTINUE
     31      END DO
    3232c
    3333c    .... correction pour rot( iip1,j,l)  ....
    … …  
    3535c    ....   rot(iip1,j,l)= rot(1,j,l) ...
    3636CDIR$ IVDEP
    37       DO 2 ij = iip1, ip1jm, iip1
     37      DO ij = iip1, ip1jm, iip1
    3838      rot( ij,l ) = rot( ij -iim,l )
    39    2  CONTINUE
     39      END DO
    4040c
    41    5  CONTINUE
     41      END DO
    4242      RETURN
    4343      END

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advect_new_loc.F

    r2622 r5086  
    6363         deuxjour = 2. * daysec
    6464
    65          DO   1  ij   = 1, ip1jmp1
     65         DO   ij   = 1, ip1jmp1
    6666         unsaire2(ij) = unsaire(ij) * unsaire(ij)
    67    1     CONTINUE
     67      END DO
    6868      END IF
    6969
    … …  
    175175
    176176c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    177       DO 20 l = 1, llmm1
     177      DO l = 1, llmm1
    178178
    179179
    … …  
    183183      if (pole_sud)  ije=ij_end
    184184     
    185       DO 5   ij   = ijb, ije
     185      DO ij   = ijb, ije
    186186      wsur2( ij ) = - 0.5 * w( ij,l+1 )
    187    5  CONTINUE
     187      END DO
    188188
    189189
    … …  
    195195      if (pole_sud)  ije=ije-iip1
    196196         
    197       DO 6 ij = ijb ,ije-1
     197      DO ij = ijb ,ije-1
    198198      ww        = wsur2 (  ij  )     + wsur2( ij+1 )
    199199      uu        = 0.5 * ( ucov(ij,l) + ucov(ij,l+1) )
    200200      du1(ij,l)  =  ww * ( uu - uav(ij, l ) )/massebx(ij, l )
    201201      du2(ij,l+1)=  ww * ( uu - uav(ij,l+1) )/massebx(ij,l+1)
    202    6  CONTINUE
     202      END DO
    203203
    204204c     .................    calcul pour   dv      .....................
    … …  
    207207      if (pole_sud)  ije=ij_end-iip1
    208208     
    209       DO 8 ij = ijb, ije
     209      DO ij = ijb, ije
    210210      ww        = wsur2( ij+iip1 )   + wsur2( ij )
    211211      vv        = 0.5 * ( vcov(ij,l) + vcov(ij,l+1) )
    212212      dv1(ij,l)  =  ww * (vv - vav(ij, l ) )/masseby(ij, l )
    213213      dv2(ij,l+1)=  ww * (vv - vav(ij,l+1) )/masseby(ij,l+1)
    214    8  CONTINUE
     214      END DO
    215215
    216216c
    … …  
    226226        ije=ij_end
    227227       
    228         DO 15 ij = ijb, ije
     228        DO ij = ijb, ije
    229229         ww            = wsur2(ij) * (teta(ij,l) + teta(ij,l+1) )
    230230         dteta1(ij, l ) =   ww
    231231         dteta2(ij,l+1) =   ww
    232   15    CONTINUE
     232      END DO
    233233
    234234c ym ---> conser a voir plus tard
    … …  
    243243c      END IF
    244244
    245   20  CONTINUE
     245      END DO
    246246c$OMP END DO
    247247

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bernoui_loc.F

    r2603 r5086  
    5454      DO l=1,llm
    5555   
    56         DO 4 ij = ijb,ije
     56        DO ij = ijb,ije
    5757          pbern( ij,l ) =  pphi( ij,l ) + pecin( ij,l )
    58    4    CONTINUE
     58      END DO
    5959       
    6060       ENDDO

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/convflu_loc.F

    r4593 r5086  
    3434     
    3535c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)         
    36       DO 5 l = 1,nbniv
     36      DO l = 1,nbniv
    3737c
    3838        ijb=ij_begin
    … …  
    4242        IF (pole_sud)  ije=ij_end-iip1
    4343       
    44         DO 2  ij = ijb , ije - 1
     44        DO ij = ijb , ije - 1
    4545          convfl(ij+1,l) = xflu(ij,l) - xflu(ij+ 1,l)   +
    4646     *                     yflu(ij +1,l ) - yflu( ij -iim,l )
    47    2    CONTINUE
     47      END DO
    4848c
    4949c
    … …  
    5353c
    5454CDIR$ IVDEP
    55         DO 3 ij = ijb,ije,iip1
     55        DO ij = ijb,ije,iip1
    5656          convfl( ij,l ) = convfl( ij + iim,l )
    57    3    CONTINUE
     57      END DO
    5858c
    5959c     ......  calcul aux poles  .......
    … …  
    7979        ENDIF
    8080     
    81    5  CONTINUE
     81      END DO
    8282c$OMP END DO NOWAIT   
    8383      RETURN

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covcont_loc.F

    r4593 r5086  
    4444
    4545c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    46       DO 10 l = 1,klevel
     46      DO l = 1,klevel
    4747
    48       DO 2  ij = ijb_u,ije_u
     48      DO ij = ijb_u,ije_u
    4949      ucont( ij,l ) = ucov( ij,l ) * unscu2( ij )
    50    2  CONTINUE
     50      END DO
    5151
    52       DO 4 ij = ijb_v,ije_v
     52      DO ij = ijb_v,ije_v
    5353      vcont( ij,l ) = vcov( ij,l ) * unscv2( ij )
    54    4  CONTINUE
     54      END DO
    5555
    56   10  CONTINUE
     56      END DO
    5757c$OMP END DO NOWAIT
    5858      RETURN

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_gam_loc.F

    r4593 r5086  
    5151
    5252c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    53       DO 10 l = 1,klevel
     53      DO l = 1,klevel
    5454c
    5555        DO  ij = ijb, ije - 1
    … …  
    9191          ENDDO
    9292       endif
    93   10  CONTINUE
     93      END DO
    9494c$OMP END DO NOWAIT
    9595c

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_p.F

    r4593 r5086  
    4747     
    4848c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    49       DO 10 l = 1,klevel
     49      DO l = 1,klevel
    5050c
    5151        DO  ij = ijb, ije - 1
    … …  
    8888
    8989
    90   10  CONTINUE
     90      END DO
    9191c$OMP END DO NOWAIT
    9292c

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/divergf_loc.F

    r4593 r5086  
    4949
    5050c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    51       DO 10 l = 1,klevel
     51      DO l = 1,klevel
    5252c
    5353        DO  ij = ijb, ije - 1
    … …  
    9595        endif
    9696       
    97   10    CONTINUE
     97      END DO
    9898c$OMP END DO NOWAIT
    9999

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dteta1_loc.F

    r2603 r5086  
    3939
    4040c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    41       DO 5 l = 1,llm
     41      DO l = 1,llm
    4242     
    4343      ijb=ij_begin
    … …  
    4747      if (pole_sud)  ije=ij_end-iip1
    4848     
    49       DO 1  ij = ijb, ije - 1
     49      DO ij = ijb, ije - 1
    5050        hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l)+teta(ij+1,l) )
    51    1  CONTINUE
     51      END DO
    5252
    5353c    .... correction pour  hbxu(iip1,j,l)  .....
    … …  
    5555
    5656CDIR$ IVDEP
    57       DO 2 ij = ijb+iip1-1, ije, iip1
     57      DO ij = ijb+iip1-1, ije, iip1
    5858        hbxu( ij, l ) = hbxu( ij - iim, l )
    59    2  CONTINUE
     59      END DO
    6060
    6161      ijb=ij_begin-iip1
    6262      if (pole_nord) ijb=ij_begin
    6363     
    64       DO 3 ij = ijb,ije
     64      DO ij = ijb,ije
    6565        hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+teta(ij+iip1,l) )
    66    3  CONTINUE
     66      END DO
    6767
    6868       if (.not. pole_sud) then
    … …  
    7171        endif
    7272       
    73    5  CONTINUE
     73      END DO
    7474c$OMP END DO NOWAIT
    7575       

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dudv1_loc.F

    r4593 r5086  
    2828     
    2929c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    30       DO 10 l = 1,llm
     30      DO l = 1,llm
    3131c
    3232      ijb=ij_begin
    … …  
    3636      if (pole_sud)  ije=ij_end-iip1
    3737     
    38       DO 2  ij = ijb, ije-1
     38      DO ij = ijb, ije-1
    3939      du( ij,l ) = 0.125 *(  vorpot(ij-iip1, l) + vorpot( ij, l)  ) *
    4040     *                    (   pbarv(ij-iip1, l) + pbarv(ij-iim,  l) +
    4141     *                        pbarv(   ij  , l) + pbarv(ij+ 1 ,  l)   )
    42    2  CONTINUE
     42      END DO
    4343   
    4444 
    … …  
    4646      if (pole_nord) ijb=ij_begin
    4747     
    48       DO 3 ij = ijb, ije-1
     48      DO ij = ijb, ije-1
    4949      dv( ij+1,l ) = - 0.125 *(  vorpot(ij, l)  + vorpot(ij+1, l)  ) *
    5050     *                        (   pbaru(ij, l)  +  pbaru(ij+1   , l) +
    5151     *                       pbaru(ij+iip1, l)  +  pbaru(ij+iip2, l)  )
    52    3  CONTINUE
     52      END DO
    5353c
    5454c    .... correction  pour  dv( 1,j,l )  .....
    … …  
    5656c
    5757CDIR$ IVDEP
    58       DO 4 ij = ijb, ije, iip1
     58      DO ij = ijb, ije, iip1
    5959      dv( ij,l ) = dv( ij + iim, l )
    60    4  CONTINUE
     60      END DO
    6161c
    62   10  CONTINUE
     62      END DO
    6363c$OMP END DO NOWAIT
    6464      RETURN

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dudv2_loc.F

    r2600 r5086  
    3333c
    3434c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    35       DO 5 l = 1,llm
     35      DO l = 1,llm
    3636c
    3737      ijb=ij_begin
    … …  
    4040      if (pole_sud)  ije=ije-iip1
    4141
    42       DO 2  ij  = ijb, ije - 1
     42      DO ij  = ijb, ije - 1
    4343       du(ij,l) = du(ij,l) + 0.5* ( teta( ij,l ) + teta( ij+1,l ) ) *
    4444     * ( pkf( ij,l ) - pkf(ij+1,l) )  + bern(ij,l) - bern(ij+1,l)
    45    2  CONTINUE
     45      END DO
    4646c
    4747c
    … …  
    5050c
    5151CDIR$ IVDEP
    52       DO 3 ij = ijb+iip1-1, ije, iip1
     52      DO ij = ijb+iip1-1, ije, iip1
    5353      du( ij,l ) = du( ij - iim,l )
    54    3  CONTINUE
     54      END DO
    5555c
    5656c
    5757      if (pole_nord) ijb=ijb-iip1
    5858
    59       DO 4 ij  = ijb,ije
     59      DO ij  = ijb,ije
    6060      dv( ij,l) = dv(ij,l) + 0.5 * ( teta(ij,l) + teta( ij+iip1,l ) ) *
    6161     *                             ( pkf(ij+iip1,l) - pkf(  ij,l  ) )
    6262     *                           +   bern( ij+iip1,l ) - bern( ij  ,l )
    63    4  CONTINUE
     63      END DO
    6464c
    65    5  CONTINUE
     65      END DO
    6666c$OMP END DO NOWAIT
    6767c

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/grad_loc.F

    r4593 r5086  
    2323c
    2424c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    25       DO 6 l = 1,klevel
     25      DO l = 1,klevel
    2626c
    2727      ijb=ij_begin
    2828      ije=ij_end
    29       DO 2  ij = ijb, ije - 1
     29      DO ij = ijb, ije - 1
    3030        pgx( ij,l ) = pg( ij +1,l ) - pg( ij,l )
    31    2  CONTINUE
     31      END DO
    3232c
    3333c    .... correction pour  pgx(ip1,j,l)  ....
    3434c    ...    pgx(iip1,j,l)= pgx(1,j,l)  ....
    3535CDIR$ IVDEP
    36       DO 3  ij = ijb+iip1-1, ije, iip1
     36      DO ij = ijb+iip1-1, ije, iip1
    3737        pgx( ij,l ) = pgx( ij -iim,l )
    38    3  CONTINUE
     38      END DO
    3939c
    4040      ijb=ij_begin-iip1
    … …  
    4343      if (pole_sud)  ije=ij_end-iip1
    4444     
    45       DO 4 ij = ijb,ije
     45      DO ij = ijb,ije
    4646        pgy( ij,l ) = pg( ij,l ) - pg( ij +iip1,l )
    47    4  CONTINUE
     47      END DO
    4848c
    49    6  CONTINUE
     49      END DO
    5050c$OMP END DO NOWAIT
    5151

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/grad_p.F

    r4593 r5086  
    2323c
    2424c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    25       DO 6 l = 1,klevel
     25      DO l = 1,klevel
    2626c
    2727      ijb=ij_begin
    2828      ije=ij_end
    29       DO 2  ij = ijb, ije - 1
     29      DO ij = ijb, ije - 1
    3030        pgx( ij,l ) = pg( ij +1,l ) - pg( ij,l )
    31    2  CONTINUE
     31      END DO
    3232c
    3333c    .... correction pour  pgx(ip1,j,l)  ....
    3434c    ...    pgx(iip1,j,l)= pgx(1,j,l)  ....
    3535CDIR$ IVDEP
    36       DO 3  ij = ijb+iip1-1, ije, iip1
     36      DO ij = ijb+iip1-1, ije, iip1
    3737        pgx( ij,l ) = pgx( ij -iim,l )
    38    3  CONTINUE
     38      END DO
    3939c
    4040      ijb=ij_begin-iip1
    … …  
    4343      if (pole_sud)  ije=ij_end-iip1
    4444     
    45       DO 4 ij = ijb,ije
     45      DO ij = ijb,ije
    4646        pgy( ij,l ) = pg( ij,l ) - pg( ij +iip1,l )
    47    4  CONTINUE
     47      END DO
    4848c
    49    6  CONTINUE
     49      END DO
    5050c$OMP END DO NOWAIT
    5151

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/integrd_loc.F

    r5082 r5086  
    124124
    125125c$OMP DO SCHEDULE(STATIC)
    126       DO 2 ij = ijb,ije
     126      DO ij = ijb,ije
    127127       pscr (ij)    = ps0(ij)
    128128       ps (ij)      = psm1(ij) + dt * dp(ij)     
    129129
    130    2  CONTINUE
     130      END DO
    131131
    132132c$OMP END DO 
    … …  
    250250
    251251c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    252       DO 10 l = 1,llm
     252      DO l = 1,llm
    253253     
    254254      ijb=ij_begin
    … …  
    257257      if (pole_sud)  ije=ij_end-iip1
    258258     
    259       DO 4 ij = ijb,ije
     259      DO ij = ijb,ije
    260260      uscr( ij )   =  ucov( ij,l )
    261261      ucov( ij,l ) = ucovm1( ij,l ) + dt * du( ij,l )
    262    4  CONTINUE
     262      END DO
    263263
    264264      ijb=ij_begin
    … …  
    266266      if (pole_sud)  ije=ij_end-iip1
    267267     
    268       DO 5 ij = ijb,ije
     268      DO ij = ijb,ije
    269269      vscr( ij )   =  vcov( ij,l )
    270270      vcov( ij,l ) = vcovm1( ij,l ) + dt * dv( ij,l )
    271    5  CONTINUE
     271      END DO
    272272     
    273273      ijb=ij_begin
    274274      ije=ij_end
    275275     
    276       DO 6 ij = ijb,ije
     276      DO ij = ijb,ije
    277277      hscr( ij )    =  teta(ij,l)
    278278      teta ( ij,l ) = tetam1(ij,l) *  massem1(ij,l) / masse(ij,l)
    279279     $                + dt * dteta(ij,l) / masse(ij,l)
    280    6  CONTINUE
     280      END DO
    281281
    282282c   ....  Calcul de la valeur moyenne, unique  aux poles pour  teta    ......
    … …  
    324324      END IF
    325325
    326   10  CONTINUE
     326      END DO
    327327c$OMP END DO NOWAIT
    328328

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/massdair_loc.F

    r2597 r5086  
    9292
    9393c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    94       DO   100    l = 1 , llm
     94      DO   l = 1 , llm
    9595c
    9696        DO    ij     = ijb, ije
    … …  
    113113c       ENDDO
    114114       
    115 100   CONTINUE
     115      END DO
    116116c$OMP END DO NOWAIT
    117117c

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_hallo.F90

    r5082 r5086  
    169169    do while (Buffer_Pos(Index_Pos)==-1 .and. Index_Pos>1)
    170170      Index_Pos=Index_Pos-1
    171     end do
     171    END DO
    172172
    173173  end subroutine deallocate_buffer 

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_gam_loc.F

    r4593 r5086  
    2525c
    2626c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    27       DO 10 l = 1,klevel
     27      DO l = 1,klevel
    2828c
    2929      ijb=ij_begin
    … …  
    3131      if(pole_sud) ije=ij_end-iip1
    3232     
    33       DO 1  ij = ijb+1, ije
     33      DO ij = ijb+1, ije
    3434      y( ij,l ) = (rot( ij,l ) - rot( ij-1,l )) * cvscuvgam( ij )
    35    1  CONTINUE
     35      END DO
    3636c
    3737c    ..... correction pour  y ( 1,j,l )  ......
    … …  
    3939c    ....    y(1,j,l)= y(iip1,j,l) ....
    4040CDIR$ IVDEP
    41       DO 2  ij = ijb, ije, iip1
     41      DO ij = ijb, ije, iip1
    4242      y( ij,l ) = y( ij +iim,l )
    43    2  CONTINUE
     43      END DO
    4444c
    4545      ijb=ij_begin
    … …  
    4848      if(pole_sud) ije=ij_end-iip1
    4949     
    50       DO 4  ij = ijb,ije
     50      DO ij = ijb,ije
    5151      x( ij,l ) = (rot( ij,l ) - rot( ij -iip1,l )) * cuscvugam( ij )
    52    4  CONTINUE
     52      END DO
    5353   
    5454      if (pole_nord) then
    … …  
    6464      endif
    6565c
    66   10  CONTINUE
     66      END DO
    6767c$OMP END DO NOWAIT
    6868      RETURN

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_loc.F

    r4593 r5086  
    2323c
    2424c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    25       DO 10 l = 1,klevel
     25      DO l = 1,klevel
    2626c
    2727      ijb=ij_begin
    … …  
    2929      if (pole_sud)  ije=ij_end-iip1
    3030       
    31       DO 1  ij = ijb+1, ije
     31      DO ij = ijb+1, ije
    3232      y( ij,l ) = (  rot( ij,l ) - rot( ij-1,l )  ) * cvsurcuv( ij )
    33    1  CONTINUE
     33      END DO
    3434c
    3535c    ..... correction pour  y ( 1,j,l )  ......
    … …  
    3737c    ....    y(1,j,l)= y(iip1,j,l) ....
    3838CDIR$ IVDEP
    39       DO 2  ij = ijb, ije, iip1
     39      DO ij = ijb, ije, iip1
    4040      y( ij,l ) = y( ij +iim,l )
    41    2  CONTINUE
     41      END DO
    4242c
    4343      ijb=ij_begin
    … …  
    4747      if (pole_sud)  ije=ij_end-iip1
    4848     
    49       DO 4  ij = ijb,ije
     49      DO ij = ijb,ije
    5050      x( ij,l ) = (  rot( ij,l ) - rot( ij -iip1,l )  ) * cusurcvu( ij )
    51    4  CONTINUE
     51      END DO
    5252   
    5353      if (pole_nord) then
    … …  
    6363      endif
    6464c
    65   10  CONTINUE
     65      END DO
    6666c$OMP END DO NOWAIT
    6767      RETURN

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotat_nfil_loc.F

    r4593 r5086  
    3333      if(pole_sud) ije=ij_end-iip1
    3434c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    35       DO  10 l = 1,klevel
     35      DO  l = 1,klevel
    3636c
    3737        DO   ij = ijb, ije - 1
    … …  
    4747        ENDDO
    4848c
    49   10  CONTINUE
     49      END DO
    5050c$OMP END DO NOWAIT
    5151      RETURN

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotat_p.F

    r4593 r5086  
    3434     
    3535c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    36       DO  10 l = 1,klevel
     36      DO  l = 1,klevel
    3737c
    3838        DO   ij = ijb, ije - 1
    … …  
    4848        ENDDO
    4949c
    50   10  CONTINUE
     50      END DO
    5151c$OMP END DO NOWAIT
    5252ccc        CALL filtreg( rot, jjm, klevel, 2, 2, .FALSE., 1 )

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotatf_loc.F

    r4593 r5086  
    3535
    3636c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    37       DO  10 l = 1,klevel
     37      DO  l = 1,klevel
    3838c
    3939        DO   ij = ijb, ije - 1
    … …  
    4949        ENDDO
    5050c
    51   10  CONTINUE
     51      END DO
    5252c$OMP END DO NOWAIT
    5353        jjb=jj_begin

  • LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/calfis.F

    r5082 r5086  
    347347c   ------------
    348348
    349       DO 50 l=1,llm
    350 
    351          DO 25 j=2,jjm
     349      DO l=1,llm
     350
     351         DO j=2,jjm
    352352            ig0 = 1+(j-2)*iim
    353353            zufi(ig0+1,l)= 0.5 *
    … …  
    355355            pcvgu(ig0+1,l)= 0.5 *
    356356     $      ( pducov(iim,j,l)/cu(iim,j) + pducov(1,j,l)/cu(1,j) )
    357             DO 10 i=2,iim
     357            DO i=2,iim
    358358               zufi(ig0+i,l)= 0.5 *
    359359     $         ( pucov(i-1,j,l)/cu(i-1,j) + pucov(i,j,l)/cu(i,j) )
    360360               pcvgu(ig0+i,l)= 0.5 *
    361361     $         ( pducov(i-1,j,l)/cu(i-1,j) + pducov(i,j,l)/cu(i,j) )
    362 10         CONTINUE
    363 25      CONTINUE
    364 
    365 50    CONTINUE
     362      END DO
     363      END DO
     364
     365      END DO
    366366
    367367

  • LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/test_disvert_m.F90

    r2597 r5086  
    5555                     p(i, l + 1) / 100., " hPa"
    5656             end if
    57           end do
    58        end do
     57          END DO
     58       END DO
    5959       call abort_physic("test_disvert", "bad order of pressure values", 1)
    6060    end if

  • LMDZ6/branches/Amaury_dev/libf/filtrez/eigen.F

    r4593 r5086  
    1010      im=iim
    1111c
    12       DO 48 i = 1,im
     12      DO i = 1,im
    1313         asm( i ) = d( im-i+1 )
    14  48   CONTINUE
    15       DO 49 i = 1,iim
     14      END DO
     15      DO i = 1,iim
    1616         d( i ) = asm( i )
    17  49   CONTINUE
     17      END DO
    1818c
    1919c     PRINT 70,d
    … …  
    2121                print *
    2222c
    23       DO 51 i = 1,im
    24          DO 52 j = 1,im
     23      DO i = 1,im
     24         DO j = 1,im
    2525            asm( j ) = e( i , im-j+1 )
    26  52      CONTINUE
    27          DO 50 j = 1,im
     26      END DO
     27         DO j = 1,im
    2828            e( i,j ) = asm( j )
    29  50      CONTINUE
    30  51   CONTINUE
     29      END DO
     30      END DO
    3131
    3232      RETURN

  • 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

  • LMDZ6/branches/Amaury_dev/libf/obsolete/regr1_conserv_m.F90

    r2788 r5086  
    9797             vt(it) = vt(it) + (xs(is + 1) - xs(is)) * vs(is)
    9898             is = is + 1
    99           end do
     99          END DO
    100100          ! 1 <= is <= ns
    101101          vt(it) = (vt(it) + mean_lin(xs(is), xt(it + 1)) * (xt(it + 1) &
    … …  
    105105       if (xs(is + 1) == xt(it + 1)) is = is + 1
    106106       ! 1 <= is <= ns .or. it == nt
    107     end do
     107    END DO
    108108
    109109  contains
    … …  
    170170             vt(it, :) = vt(it, :) + (xs(is + 1) - xs(is)) * vs(is, :)
    171171             is = is + 1
    172           end do
     172          END DO
    173173          ! 1 <= is <= ns
    174174          vt(it, :) = (vt(it, :) + mean_lin(xs(is), xt(it + 1)) * (xt(it + 1) &
    … …  
    178178       if (xs(is + 1) == xt(it + 1)) is = is + 1
    179179       ! 1 <= is <= ns .or. it == nt
    180     end do
     180    END DO
    181181
    182182  contains
    … …  
    246246             vt(it, :, :) = vt(it, :, :) + (xs(is + 1) - xs(is)) * vs(is, :, :)
    247247             is = is + 1
    248           end do
     248          END DO
    249249          ! 1 <= is <= ns
    250250          vt(it, :, :) = (vt(it, :, :) + mean_lin(xs(is), xt(it + 1)) &
    … …  
    254254       if (xs(is + 1) == xt(it + 1)) is = is + 1
    255255       ! 1 <= is <= ns .or. it == nt
    256     end do
     256    END DO
    257257
    258258  contains
    … …  
    324324                  * vs(is, :, :, :)
    325325             is = is + 1
    326           end do
     326          END DO
    327327          ! 1 <= is <= ns
    328328          vt(it, :, :, :) = (vt(it, :, :, :) + mean_lin(xs(is), xt(it + 1)) &
    … …  
    332332       if (xs(is + 1) == xt(it + 1)) is = is + 1
    333333       ! 1 <= is <= ns .or. it == nt
    334     end do
     334    END DO
    335335
    336336  contains

  • LMDZ6/branches/Amaury_dev/libf/obsolete/regr1_lint_m.F90

    r2788 r5086  
    5353       vt(it) = ((xs(is_b+1) - xt(it)) * vs(is_b) &
    5454            + (xt(it) - xs(is_b)) * vs(is_b+1)) / (xs(is_b+1) - xs(is_b))
    55     end do
     55    END DO
    5656
    5757  end function regr11_lint
    … …  
    9292       vt(it, :) = ((xs(is_b+1) - xt(it)) * vs(is_b, :) &
    9393            + (xt(it) - xs(is_b)) * vs(is_b+1, :)) / (xs(is_b+1) - xs(is_b))
    94     end do
     94    END DO
    9595
    9696  end function regr12_lint

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

    r2440 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/obsolete/regr3_lint_m.F90

    r2788 r5086  
    5353       vt(:, :, it) = ((xs(is_b+1) - xt(it)) * vs(:, :, is_b) &
    5454            + (xt(it) - xs(is_b)) * vs(:, :, is_b+1)) / (xs(is_b+1) - xs(is_b))
    55     end do
     55    END DO
    5656
    5757  end function regr33_lint
    … …  
    9494            + (xt(it) - xs(is_b)) * vs(:, :, is_b+1, :)) &
    9595            / (xs(is_b+1) - xs(is_b))
    96     end do
     96    END DO
    9797
    9898  end function regr34_lint

  • LMDZ6/branches/Amaury_dev/libf/obsolete/regr_lat_time_climoz_m.F90

    r2788 r5086  
    249249             do while (o3_in(j, 1, l, m) == missing_value)
    250250                j = j + 1
    251              end do
     251             END DO
    252252             if (j > 1) o3_in(:j-1, :, l, m) = &
    253253                  spread(o3_in(j, :, l, m), dim=1, ncopies=j-1)
    … …  
    257257             do while (o3_in(j, 1, l, m) == missing_value)
    258258                j = j - 1
    259              end do
     259             END DO
    260260             if (j < n_lat) o3_in(j+1:, :, l, m) = &
    261261                  spread(o3_in(j, :, l, m), dim=1, ncopies=n_lat-j)
    … …  
    270270                do while  (o3_in(j, k, l, m) /= missing_value .and. k < n_plev)
    271271                   k = k + 1
    272                 end do
     272                END DO
    273273                ! Replace missing values with the valid value at the
    274274                ! lowest level above missing values:
    275275                if (o3_in(j, k, l, m) == missing_value) &
    276276                     o3_in(j, k:n_plev, l, m) = o3_in(j, k-1, l, m)
    277              end do
    278           end do
     277             END DO
     278          END DO
    279279       else
    280280          print *, "regr_lat_time_climoz: field ", m, &
    281281               ", no missing value attribute"
    282282       end if
    283     end do
     283    END DO
    284284
    285285    call nf95_close(ncid_in)
    … …  
    322322       call nf95_put_var(ncid_out, varid_out(m), o3_out(nbp_lat:1:-1, :, :, m))
    323323       ! (The order of "rlatu" is inverted in the output file)
    324     end do
     324    END DO
    325325
    326326    call nf95_close(ncid_out)

  • LMDZ6/branches/Amaury_dev/libf/obsolete/regr_pr_av_m.F90

    r2788 r5086  
    9999          call handle_err("regr_pr_av nf90_get_var " // trim(name(i)), ncerr, &
    100100               ncid)
    101        end do
     101       END DO
    102102       
    103103       ! Latitudes are in ascending order in the input file while
    … …  
    118118            slopes(v2(i, :, :), press_in_edg))
    119119       ! (invert order of indices because "paprs" is in descending order)
    120     end do
     120    END DO
    121121
    122122  end subroutine regr_pr_av

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Ocean_skin/bulk_flux_m.F90

    r3834 r5086  
    140140                  rain = null_array, qcol = rnl + hf + hlb - dels)
    141141          end if
    142        end do
     142       END DO
    143143    else
    144144       tkt = 0.

  • LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/sulfate_aer_mod.F90

    r5082 r5086  
    731731         JX=0
    732732       ELSE
    733          DO 10 I=1,N
     733         DO I=1,N
    734734           IF (X<XC(I)) GO TO 20
    735  10      CONTINUE
     735         END DO
    736736         IER=1
    737737 20      JX=I-1
    … …  
    756756         JX=0
    757757       ELSE
    758          DO 10 I=1,N
     758         DO I=1,N
    759759           IF (XT>X(I)) GO TO 20
    760  10      CONTINUE
     760         END DO
    761761 20      JX=I
    762762       ENDIF

  • LMDZ6/branches/Amaury_dev/libf/phylmd/concvl.F90

    r4613 r5086  
    340340! em_wght(k)=wght_th(i,k)
    341341! print*,'em_wght=',em_wght(k),wght_th(i,k)
    342 ! end do
     342! END DO
    343343! END DO
    344344

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/icarus.F

    r5082 r5086  
    364364      enddo
    365365
    366       do 12 ilev=1,nlev
     366      do ilev=1,nlev
    367367        do j=1,npoints
    368368         if (pfull(j,ilev) < 40000. .and.
    … …  
    375375           end if
    376376        enddo
    377 12    continue
    378 
    379       do 13 ilev=1,nlev
     377      END DO
     378
     379      do ilev=1,nlev
    380380        do j=1,npoints
    381381           if (at(j,ilev) > atmax(j) .and.
    382382     &              ilev  >= itrop(j)) atmax(j)=at(j,ilev)
    383383        enddo
    384 13    continue
     384      END DO
    385385
    386386      end if
    … …  
    391391              meantb(j) = 0.
    392392              meantbclr(j) = 0.
    393           end do
     393          END DO
    394394      else
    395395          do j=1,npoints
    396396              meantb(j) = output_missing_value
    397397              meantbclr(j) = output_missing_value
    398           end do
     398          END DO
    399399      end if
    400400     
    … …  
    466466 
    467467      !initialize tau and albedocld to zero
    468       do 15 ibox=1,ncol
     468      do ibox=1,ncol
    469469        do j=1,npoints
    470470            tau(j,ibox)=0.
    … …  
    474474          box_cloudy(j,ibox)=.false.
    475475        enddo
    476 15    continue
     476      END DO
    477477
    478478      !compute total cloud optical depth for each column     
    … …  
    541541        if (ncolprint /= 0)
    542542     &         write(6,*)  'ilev   pw (kg/m2)   tauwv(j)      dem_wv'
    543         do 125 ilev=1,nlev
     543        do ilev=1,nlev
    544544          do j=1,npoints
    545545               !press and dpress are dyne/cm2 = Pascals *10
    … …  
    568568               enddo
    569569             endif
    570 125     continue
     570      END DO
    571571
    572572        !initialize variables
    … …  
    740740            bb(j)=1/( exp(1307.27/skt(j)) - 1. )
    741741            !bb(j)=5.67e-8*skt(j)**4
    742           end do
     742          END DO
    743743
    744744        do ibox=1,ncol
    … …  
    751751     &         * trans_layers_above(j,ibox)
    752752           
    753           end do
    754         end do
     753          END DO
     754        END DO
    755755
    756756        !calculate mean infrared brightness temperature
    … …  
    758758          do j=1,npoints
    759759            meantb(j) = meantb(j)+1307.27/(log(1.+(1./fluxtop(j,ibox))))
    760           end do
    761         end do
     760          END DO
     761        END DO
    762762          do j=1, npoints
    763763            meantb(j) = meantb(j) / real(ncol)
    764           end do       
     764          END DO
    765765
    766766        if (ncolprint/=0) then
    … …  
    784784          write (6,'(8f7.2)') (meantb(j),ibox=1,ncolprint)
    785785     
    786           end do
     786          END DO
    787787      endif
    788788   
    … …  
    925925
    926926      !compute cloud top pressure
    927       do 30 ibox=1,ncol
     927      do ibox=1,ncol
    928928        !segregate according to optical thickness
    929929        if (top_height == 1 .or. top_height == 3) then
    … …  
    933933            nmatch(j)=0
    934934          enddo
    935           do 29 k1=1,nlev-1
     935          do k1=1,nlev-1
    936936            if (top_height_direction == 2) then
    937937              ilev = nlev - k1
    … …  
    951951             end if                         
    952952            enddo
    953 29        continue
     953      END DO
    954954
    955955          do j=1,npoints
    … …  
    992992              levmatch(j,ibox)=ilev
    993993              end if
    994             end do
    995           end do
     994            END DO
     995          END DO
    996996        end if                           
    997997         
    … …  
    10031003        enddo
    10041004
    1005 30    continue
     1005      END DO
    10061006             
    10071007!
    … …  
    10321032
    10331033      !reset frequencies
    1034       do 38 ilev=1,7
     1034      do ilev=1,7
    10351035      do 38 ilev2=1,7
    10361036        do j=1,npoints !
    … …  
    10421042        enddo
    1043104338    continue
     1044      END DO
    10441045
    10451046      !reset variables need for averaging cloud properties
    … …  
    10601061      boxarea = 1./real(ncol)
    10611062     
    1062       do 39 ibox=1,ncol
     1063      do ibox=1,ncol
    10631064        do j=1,npoints
    10641065
    … …  
    11661167                       
    11671168        enddo ! j
    1168 39    continue
     1169      END DO
    11691170     
    11701171      !compute mean cloud properties
    … …  
    12271228     &           (cchar_realtops(acc(ilev,ibox)+1),ilev=1,nlev)
    12281229     &           ,(cchar(acc(ilev,ibox)+1),ilev=1,nlev)
    1229              end do
     1230             END DO
    12301231             close(9)
    12311232

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/math_lib.F90

    r5082 r5086  
    273273       exit
    274274    end if
    275   end do
     275  END DO
    276276 
    277277  if (lerror) then
    … …  
    316316    end if
    317317    ilo = ilo + 1
    318   end do
     318  END DO
    319319
    320320  ilo = max ( 2, ilo )
    … …  
    326326    end if
    327327    ihi = ihi - 1
    328   end do
     328  END DO
    329329 
    330330  ihi = min ( ihi, ntab - 1 )
    … …  
    374374    syl = x2
    375375 
    376   end do
     376  END DO
    377377 
    378378  result = sum1 &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_modis_simulator.F90

    r3233 r5086  
    176176              opticalThickness(i, j, k) = 0.   
    177177            end if
    178           end do
    179         end do
    180       end do
     178          END DO
     179        END DO
     180      END DO
    181181
    182182      !
    … …  
    197197          do i = 1, nSunlit
    198198            if(subCols%frac_out(sunlit(i), j, k) == I_CVC) opticalThickness(i, j, k) = gridBox%dtau_c(sunlit(i), k)
    199           end do
    200         end do
    201       end do
     199          END DO
     200        END DO
     201      END DO
    202202
    203203      !
    … …  
    220220                                retrievedPhase(i, :), retrievedCloudTopPressure(i, :),      &
    221221                                retrievedTau(i, :), retrievedSize(i, :))
    222      end do
     222     END DO
    223223     
    224224      ! DJS2015: Call L3 modis simulator used by cospv2.0

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_modis_sim.F90

    r5082 r5086  
    331331        retrievedTau(i) = R_UNDEF
    332332      end if
    333     end do
     333    END DO
    334334    where((retrievedSize(:) < 0.).and.(retrievedSize(:) /= R_UNDEF)) retrievedSize(:) = 1.0e-06*re_fill
    335335
    … …  
    802802        tauMask(:, :, i) = .false.
    803803      end where
    804     end do
     804    END DO
    805805
    806806    do i = 1, numPressureHistogramBins
    … …  
    811811        pressureMask(:, :, i) = .false.
    812812      end where
    813     end do
     813    END DO
    814814   
    815815    do i = 1, numPressureHistogramBins
    … …  
    817817        Optical_Thickness_vs_Cloud_Top_Pressure(:, j, i) = &
    818818          real(count(tauMask(:, :, j) .and. pressureMask(:, :, i), dim = 2)) / real(nSubcols)
    819       end do
    820     end do
     819      END DO
     820    END DO
    821821   
    822822  end subroutine modis_L3_simulator
    … …  
    851851      end if
    852852      if(totalTau >= tauLimit) exit
    853     end do
     853    END DO
    854854    cloud_top_pressure = totalProduct/totalTau
    855855  end function cloud_top_pressure
    … …  
    877877      end if
    878878      if(totalTau >= tauLimit) exit
    879     end do
     879    END DO
    880880    weight_by_extinction = totalProduct/totalTau
    881881  end function weight_by_extinction
    … …  
    11141114    do i = 1, size(cloudIndicies)
    11151115      call two_stream(tau(cloudIndicies(i)), g(cloudIndicies(i)), w0(cloudIndicies(i)), Refl(i), Trans(i))
    1116     end do
     1116    END DO
    11171117                   
    11181118    call adding_doubling(Refl(:), Trans(:), Refl_tot, Trans_tot) 
    … …  
    12921292          Refl_cumulative(i) = Refl_cumulative(i-1) + Refl(i)*(Tran_cumulative(i-1)**2)/(1 - Refl_cumulative(i-1) * Refl(i))
    12931293          Tran_cumulative(i) = (Tran_cumulative(i-1)*Tran(i)) / (1 - Refl_cumulative(i-1) * Refl(i))
    1294       end do
     1294      END DO
    12951295     
    12961296      Refl_tot = Refl_cumulative(size(Refl))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/optics_lib.F90

    r5081 r5086  
    519519
    520520!   // region from 0.045 microns to 167.0 microns - no temperature depend
    521     do i=2,nwl
    522       if(alam < wl(i)) continue
    523     enddo
    524521    x1=log(wl(i-1))
    525522    x2=log(wl(i))
    … …  
    539536    if(tk > temref(1)) tk=temref(1)
    540537    if(tk < temref(4)) tk=temref(4)
    541     do 11 i=2,4
     538    do i=2,4
    542539      if(tk>=temref(i)) go to 12
    543     11 continue
     540    END DO
    544541    12 lt1=i
    545542    lt2=i-1
    546     do 13 i=2,nwlt
     543    do i=2,nwlt
    547544      if(alam<=wlt(i)) go to 14
    548     13 continue
     545    END DO
    549546    14 x1=log(wlt(i-1))
    550547    x2=log(wlt(i))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/scops.F

    r5082 r5086  
    161161     
    162162      !loop over vertical levels
    163       DO 200 ilev = 1,nlev
     163      DO ilev = 1,nlev
    164164                                 
    165165!     Initialise threshold
    … …  
    331331          endif
    332332
    333 200   CONTINUE    !loop over nlev
     333      END DO    !loop over nlev
    334334
    335335

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/zeff.F90

    r5082 r5086  
    113113      call mieint(sizep(i), m0(i), one, dqv, qext(i), dqsc, qbsca(i), &
    114114        dg, xs1, xs2, dph, err)
    115     end do
     115    END DO
    116116   
    117117  else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/cosp.F90

    r5082 r5086  
    731731                                  modisRetrievedCloudTopPressure(i,:),                   &
    732732                                  modisRetrievedTau(i,:),modisRetrievedSize(i,:))
    733           end do
     733          END DO
    734734       endif
    735735    endif

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/icarus.F90

    r5082 r5086  
    155155                  (cchar_realtops(acc(ilev,ibox)+1),ilev=1,nlev),&
    156156                  (cchar(acc(ilev,ibox)+1),ilev=1,nlev)
    157           end do
     157          END DO
    158158          close(9)
    159159
    … …  
    322322       do ibox=1,ncol
    323323          fluxtop(1:npoints,ibox) = fluxtop(1:npoints,ibox) + emsfc_lw*bb(1:npoints)*trans_layers_above(1:npoints,ibox)
    324        end do
     324       END DO
    325325
    326326       ! All Sky brightness temperature
    … …  
    445445                levmatch(1:npoints,ibox)=ilev
    446446             endwhere
    447           end do
     447          END DO
    448448       end if
    449449       where(tau(1:npoints,ibox) <= tauchk)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/math_lib.F90

    r3358 r5086  
    209209          exit
    210210       end if
    211     end do
     211    END DO
    212212   
    213213    if (lerror) then
    … …  
    244244       end if
    245245       ilo = ilo + 1
    246     end do
     246    END DO
    247247   
    248248    ilo = max ( 2, ilo )
    … …  
    254254       end if
    255255       ihi = ihi - 1
    256     end do
     256    END DO
    257257   
    258258    ihi = min ( ihi, ntab - 1 )
    … …  
    305305       syl = x2
    306306       
    307     end do
     307    END DO
    308308
    309309    result = sum1 + ca * ( b**3 - syl**3 ) / 3._wp &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/modis_simulator.F90

    r3358 r5086  
    222222          retrievedTau(i)              = R_UNDEF
    223223       end if
    224     end do
     224    END DO
    225225    where((retrievedSize(1:nSubCols) < 0.).and.(retrievedSize(1:nSubCols) /= R_UNDEF)) &
    226226         retrievedSize(1:nSubCols) = 1.0e-06_wp*re_fill
    … …  
    455455      end if
    456456      if(totalTau >= tauLimit) exit
    457     end do
     457    END DO
    458458
    459459    if (totalTau > 0._wp) then
    … …  
    489489      end if
    490490      if(totalTau >= tauLimit) exit
    491     end do
     491    END DO
    492492
    493493    if (totalTau > 0._wp) then
    … …  
    715715    do i = 1, size(cloudIndicies)
    716716       call two_stream(tau(cloudIndicies(i)), g(cloudIndicies(i)), w0(cloudIndicies(i)), Refl(i), Trans(i))
    717     end do
     717    END DO
    718718   
    719719    call adding_doubling(count(tau(1:nLevels) > 0),Refl(:), Trans(:), Refl_tot, Trans_tot) 
    … …  
    897897       Refl_cumulative(i) = Refl_cumulative(i-1) + Refl(i)*(Tran_cumulative(i-1)**2)/(1._wp - Refl_cumulative(i-1) * Refl(i))
    898898       Tran_cumulative(i) = (Tran_cumulative(i-1)*Tran(i)) / (1._wp - Refl_cumulative(i-1) * Refl(i))
    899     end do
     899    END DO
    900900   
    901901    Refl_tot = Refl_cumulative(size(Refl))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/optics_lib.F90

    r5082 r5086  
    539539    if (alam < cutice) then
    540540       ! Region from 0.045 microns to 167.0 microns - no temperature depend
    541        do i=2,nwl
    542           if(alam < wl(i)) continue
    543        enddo
    544541       x1  = log(wl(i-1))
    545542       x2  = log(wl(i))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/quickbeam_optics.F90

    r5082 r5086  
    10091009          call mieint(sizep(i), m0(i), one, dqv, qext(i), dqsc, qbsca(i), &
    10101010               dg, xs1, xs2, dph, err)
    1011        end do
     1011       END DO
    10121012
    10131013    else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp.F90

    r5082 r5086  
    886886                                  modisRetrievedCloudTopPressure(i,:),                   &
    887887                                  modisRetrievedTau(i,:),modisRetrievedSize(i,:))
    888           end do
     888          END DO
    889889       endif
    890890    endif

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/icarus.F90

    r5082 r5086  
    155155                  (cchar_realtops(acc(ilev,ibox)+1),ilev=1,nlev),&
    156156                  (cchar(acc(ilev,ibox)+1),ilev=1,nlev)
    157           end do
     157          END DO
    158158          close(9)
    159159
    … …  
    322322       do ibox=1,ncol
    323323          fluxtop(1:npoints,ibox) = fluxtop(1:npoints,ibox) + emsfc_lw*bb(1:npoints)*trans_layers_above(1:npoints,ibox)
    324        end do
     324       END DO
    325325
    326326       ! All Sky brightness temperature
    … …  
    445445                levmatch(1:npoints,ibox)=ilev
    446446             endwhere
    447           end do
     447          END DO
    448448       end if
    449449       where(tau(1:npoints,ibox) <= tauchk)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_subsample_and_optics_mod.F90

    r5082 r5086  
    365365             endif
    366366             cospIN%g_vol_cloudsat(i,:,j)=g_vol(i,j)
    367           end do
    368        end do
     367          END DO
     368       END DO
    369369       
    370370       ! Loop over all subcolumns

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/math_lib.F90

    r3491 r5086  
    209209          exit
    210210       end if
    211     end do
     211    END DO
    212212   
    213213    if (lerror) then
    … …  
    244244       end if
    245245       ilo = ilo + 1
    246     end do
     246    END DO
    247247   
    248248    ilo = max ( 2, ilo )
    … …  
    254254       end if
    255255       ihi = ihi - 1
    256     end do
     256    END DO
    257257   
    258258    ihi = min ( ihi, ntab - 1 )
    … …  
    305305       syl = x2
    306306       
    307     end do
     307    END DO
    308308
    309309    result = sum1 + ca * ( b**3 - syl**3 ) / 3._wp &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/modis_simulator.F90

    r3491 r5086  
    222222          retrievedTau(i)              = R_UNDEF
    223223       end if
    224     end do
     224    END DO
    225225    where((retrievedSize(1:nSubCols) < 0.).and.(retrievedSize(1:nSubCols) /= R_UNDEF)) &
    226226         retrievedSize(1:nSubCols) = 1.0e-06_wp*re_fill
    … …  
    455455      end if
    456456      if(totalTau >= tauLimit) exit
    457     end do
     457    END DO
    458458
    459459    if (totalTau > 0._wp) then
    … …  
    489489      end if
    490490      if(totalTau >= tauLimit) exit
    491     end do
     491    END DO
    492492
    493493    if (totalTau > 0._wp) then
    … …  
    715715    do i = 1, size(cloudIndicies)
    716716       call two_stream(tau(cloudIndicies(i)), g(cloudIndicies(i)), w0(cloudIndicies(i)), Refl(i), Trans(i))
    717     end do
     717    END DO
    718718   
    719719    call adding_doubling(count(tau(1:nLevels) > 0),Refl(:), Trans(:), Refl_tot, Trans_tot) 
    … …  
    897897       Refl_cumulative(i) = Refl_cumulative(i-1) + Refl(i)*(Tran_cumulative(i-1)**2)/(1._wp - Refl_cumulative(i-1) * Refl(i))
    898898       Tran_cumulative(i) = (Tran_cumulative(i-1)*Tran(i)) / (1._wp - Refl_cumulative(i-1) * Refl(i))
    899     end do
     899    END DO
    900900   
    901901    Refl_tot = Refl_cumulative(size(Refl))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/optics_lib.F90

    r5081 r5086  
    539539    if (alam < cutice) then
    540540       ! Region from 0.045 microns to 167.0 microns - no temperature depend
    541        do i=2,nwl
    542           if(alam < wl(i)) continue
    543        enddo
    544541       x1  = log(wl(i-1))
    545542       x2  = log(wl(i))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/quickbeam_optics.F90

    r5081 r5086  
    983983          call mieint(sizep(i), m0(i), one, dqv, qext(i), dqsc, qbsca(i), &
    984984               dg, xs1, xs2, dph, err)
    985        end do
     985       END DO
    986986
    987987    else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cv30_routines.F90

    r5082 r5086  
    15481548            ! !!!      traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
    15491549            ! !!!     :      +(1.-sij(il,i,j))*tra(il,nk(il),k)
    1550             ! !!!      end do
     1550            ! !!!      END DO
    15511551            elij(il, i, j) = altem
    15521552            elij(il, i, j) = amax1(0.0, elij(il,i,j))
    … …  
    21442144            ! :            +tra(il,i,j)*(mp(il,i)-mp(il,i+1))
    21452145            ! trap(il,i,j)=trap(il,i,j)/mp(il,i)
    2146             ! end do
     2146            ! END DO
    21472147
    21482148          ELSE
    … …  
    21612161              ! do j=1,ntra
    21622162              ! trap(il,i,j)=trap(il,i+1,j)
    2163               ! end do
     2163              ! END DO
    21642164
    21652165            END IF

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cv3_routines.F90

    r5082 r5086  
    24312431!!!!      traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
    24322432!!!!     :      +(1.-sij(il,i,j))*tra(il,nk(il),k)
    2433 !!!!      end do
     2433!!!!      END DO
    24342434            elij(il, i, j) = altem
    24352435            elij(il, i, j) = max(0.0, elij(il,i,j))
    … …  
    34243424!AC!        endif ! (i.lt.inb(il) .and. lwork(il))
    34253425!AC!       enddo
    3426 !AC!      end do
     3426!AC!      END DO
    34273427
    34283428400 END DO

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h

    r5075 r5086  
    20102010          read (ilesfile,*) height(k),ugprof(k),vgprof(k),wfls(k),         &
    20112011     &                      dqtdxls(k),dqtdyls(k),dqtdtls(k),thlpcar(k)
    2012         end do
     2012        END DO
    20132013        do k=1,kmax
    20142014          if (height(k) .ne. height1(k)) then
    … …  
    20172017            stop
    20182018          endif
    2019         end do
     2019        END DO
    20202020        close(ilesfile)
    20212021
    … …  
    20352035        do k=1,kmax
    20362036          read (ilesfile,*) height(k),(tracer(k,itrac),itrac=nt1,nt2)
    2037         end do
     2037        END DO
    20382038        close(ilesfile)
    20392039        endif

  • LMDZ6/branches/Amaury_dev/libf/phylmd/inlandsis/surf_inlandsis_mod.F90

    r5075 r5086  
    470470                    depth = depth - dzsnSV(ikl,isl) / 2.
    471471                   
    472                 end do
     472                END DO
    473473
    474474            END DO

  • LMDZ6/branches/Amaury_dev/libf/phylmd/isccp_cloud_types.F90

    r1992 r5086  
    10271027    ! write (6,'(a)') '100.*f:'
    10281028    ! write (6,'(8f7.2)') (100.*fluxtop(j,ibox),ibox=1,ncolprint)
    1029     ! end do
     1029    ! END DO
    10301030    ! endif
    10311031
    … …  
    15691569  ! &           (cchar_realtops(acc(ilev,ibox)+1),ilev=1,nlev)
    15701570  ! &           ,(cchar(acc(ilev,ibox)+1),ilev=1,nlev)
    1571   ! end do
     1571  ! END DO
    15721572  ! close(9)
    15731573

  • LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_wake.F90

    r4908 r5086  
    15071507    ! c      do i=1,klon
    15081508    ! c         print*,alpha(i)
    1509     ! c      end do
     1509    ! c      END DO
    15101510    ! cc
    15111511    DO k = 1, klev

  • LMDZ6/branches/Amaury_dev/libf/phylmd/o3_chem_m.F90

    r4103 r5086  
    2424
    2525    integer, intent(in):: julien ! jour julien, 1 <= julien <= 360
    26     real, intent(in):: gmtime ! heure de la journée en fraction de jour
     26    real, intent(in):: gmtime ! heure de la journ�e en fraction de jour
    2727    real, intent(in):: t_seri(:, :) ! (klon, nbp_lev) temperature, in K
    2828
    … …  
    5959    real earth_long
    6060    ! (longitude vraie de la Terre dans son orbite solaire, par
    61     ! rapport au point vernal (21 mars), en degrés)
     61    ! rapport au point vernal (21 mars), en degr�s)
    6262
    6363    real pmu0(klon) ! mean of cosine of solar zenith angle during "pdtphys"
    … …  
    163163    do k =  nbp_lev - 1, 1, -1
    164164       sigma_mass(:, k) = sigma_mass(:, k+1) + zmasse(:, k) * q(:, k)
    165     end do
     165    END DO
    166166
    167167    o3_prod = c + b * q + a6_mass * sigma_mass

  • LMDZ6/branches/Amaury_dev/libf/phylmd/phyetat0_mod.F90

    r5075 r5086  
    321321        IF (.NOT. found) THEN
    322322           PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
    323            PRINT*, "          Il prend donc la valeur de surface"
     323           PRINT*, "          Il prEND DOnc la valeur de surface"
    324324           tsoil(:, isoil, :)=ftsol(:, :)
    325325        ENDIF

  • LMDZ6/branches/Amaury_dev/libf/phylmd/physiq_mod.F90

    r5082 r5086  
    17051705998          CONTINUE
    17061706             CLOSE(98)
    1707              CONTINUE
    17081707             IF(nCFMIP>npCFMIP) THEN
    17091708                print*,'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler'

  • LMDZ6/branches/Amaury_dev/libf/phylmd/regr_lat_time_coefoz_m.F90

    r5075 r5086  
    182182    do i_v = 1, n_o3_param
    183183       call nf95_inq_varid(ncid_in, trim(name_in(i_v)), varid_in(i_v))
    184     end do
     184    END DO
    185185
    186186    ! Create the output file and get the variable IDs:
    … …  
    225225            o3_par_out(nbp_lat:1:-1, :, :))
    226226       ! (The order of "rlatu" is inverted in the output file)
    227     end do
     227    END DO
    228228
    229229    call nf95_close(ncid_out)
    … …  
    309309            & varid_out(i))
    310310       call handle_err_copy_att("standard_name")
    311     end do
     311    END DO
    312312
    313313    ! Global attributes:

  • LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_int_m.F90

    r4489 r5086  
    9898                         v3(i, nbp_lev:1:-1))
    9999       ! (invert order of indices because "pplay" is in descending order)
    100     end do
     100    END DO
    101101
    102102  end subroutine regr_pr_int

  • LMDZ6/branches/Amaury_dev/libf/phylmd/regr_pr_o3_m.F90

    r5075 r5086  
    7777            p3d(1, j, nbp_lev + 1:1:-1), o3_mob_regr(1, j, nbp_lev:1:-1))
    7878       ! (invert order of indices because "p3d" is in descending order)
    79     end do
     79    END DO
    8080
    8181    ! Other latitudes:
    … …  
    8585               p3d(i, j, nbp_lev + 1:1:-1), o3_mob_regr(i, j, nbp_lev:1:-1))
    8686          ! (invert order of indices because "p3d" is in descending order)
    87        end do
    88     end do
     87       END DO
     88    END DO
    8989
    9090    ! Duplicate pole values on all longitudes:

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/dump2ds.F

    r5082 r5086  
    2727      REAL zmin,zmax,zllu,zllm
    2828      write(F1000,'(''(4x,'',I3,''(1H-))'')')im+3
    29       DO 10001 i=1,200
     29      DO i=1,200
    3030      jline(1+(i-1)*5:5*i)='.    '
    31 10001 CONTINUE
     31      END DO
    323210002 zmin=z(1,1)
    3333      imin=1
    … …  
    3737      jmax=1
    3838      kzero=0
    39       DO 10003 j=1,jm
    40       DO 10005 i=1,im
     39      DO j=1,jm
     40      DO i=1,im
    4141      IF(.NOT.( z(i,j)>zmax))GOTO 10007
    4242      zmax=z(i,j)
    … …  
    5050      kzero=kzero+1
    515110011 CONTINUE
    52 10005 CONTINUE
     52      END DO
    535310006 CONTINUE
    54 10003 CONTINUE
     54      END DO
    555510004 zsign=(sign(1.,zmin)*sign(1.,zmax)>0.)
    5656      WRITE(*,*)'>>> dump2ds: ',trim(nom_z)
    … …  
    7373      zinf=.false.
    7474      znan=.false.
    75       DO 10017 j=1,jm
    76       DO 10019 i=1,im
     75      DO j=1,jm
     76      DO i=1,im
    7777      az=abs(z(i,j))
    7878      IF(.NOT.( az==0.))GOTO 10021
    … …  
    9797      kchar(i)=32-kchar(i)
    989810027 CONTINUE
    99 10019 CONTINUE
     99      END DO
    10010010020 WRITE(*,'(1x,i3,''|'',1000a)')j+1,(iform(kchar(i)),i=1,im),'|','|
    101101     *'
    102 10017 CONTINUE
     102      END DO
    10310310018 write(*,F1000)
    104104      WRITE(*,'(5x,1000i1)')(mod(i,10),i=1,im)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/eq_regions_mod.F90

    r5082 r5086  
    353353  do k = 2, n
    354354    w = w * (x - k)
    355   end do
     355  END DO
    356356else
    357357  w = 1
    358358  do k = 0, -n - 1
    359359    y = y * (x + k)
    360   end do
     360  END DO
    361361end if
    362362gamma_res = w / y

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/set99.F

    r5082 r5086  
    1515      NIL=0
    1616      NHL=(N/2)-1
    17       DO 10 K=NIL,NHL
     17      DO K=NIL,NHL
    1818      ANGLE=FLOAT(K)*DEL
    1919      TRIGS(2*K+1)=COS(ANGLE)
    2020      TRIGS(2*K+2)=SIN(ANGLE)
    21    10 CONTINUE
     21      END DO
    2222C
    2323C     FIND FACTORS OF N (8,6,5,4,3,2; ONLY ONE 8 ALLOWED)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/simu_airs.F90

    r5082 r5086  
    3030        do i=1,N-1
    3131        slope(i)=-(T(i+1)-T(i))/(alt(i+1)-alt(i))
    32         end do
     32        END DO
    3333        slope(N)=slope(N-1)
    3434
    … …  
    6060        i=i+i_dir
    6161        if (i<=1.or.i>=N) exit_flag=1
    62         end do
     62        END DO
    6363
    6464        if (first_point<=0) P_tropo=65.4321

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/concvl.F90

    r4613 r5086  
    415415! em_wght(k)=wght_th(i,k)
    416416! print*,'em_wght=',em_wght(k),wght_th(i,k)
    417 ! end do
     417! END DO
    418418! END DO
    419419

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv30_routines.F90

    r4491 r5086  
    20322032            ! !!!      traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
    20332033            ! !!!     :      +(1.-sij(il,i,j))*tra(il,nk(il),k)
    2034             ! !!!      end do
     2034            ! !!!      END DO
    20352035            elij(il, i, j) = altem
    20362036            elij(il, i, j) = amax1(0.0, elij(il,i,j))
    … …  
    31553155            ! :            +tra(il,i,j)*(mp(il,i)-mp(il,i+1))
    31563156            ! trap(il,i,j)=trap(il,i,j)/mp(il,i)
    3157             ! end do
     3157            ! END DO
    31583158
    31593159          ELSE
    … …  
    31723172              ! do j=1,ntra
    31733173              ! trap(il,i,j)=trap(il,i+1,j)
    3174               ! end do
     3174              ! END DO
    31753175
    31763176            END IF

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_routines.F90

    r5082 r5086  
    29652965!!!!      traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
    29662966!!!!     :      +(1.-sij(il,i,j))*tra(il,nk(il),k)
    2967 !!!!      end do
     2967!!!!      END DO
    29682968            elij(il, i, j) = altem
    29692969            elij(il, i, j) = max(0.0, elij(il,i,j))
    … …  
    44854485!AC!        endif ! (i.lt.inb(il) .and. lwork(il))
    44864486!AC!       enddo
    4487 !AC!      end do
     4487!AC!      END DO
    44884488
    44894489#ifdef ISO

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_wake.F90

    r4594 r5086  
    127127  ! wdens_ref: initial number of wakes per unit area (3D) or per
    128128  ! unit length (2D), at the beginning of each time step
    129   ! Tgw    : 1 sur la période de onde de gravité
    130   ! Cgw    : vitesse de propagation de onde de gravité
     129  ! Tgw    : 1 sur la p�riode de onde de gravit�
     130  ! Cgw    : vitesse de propagation de onde de gravit�
    131131  ! LL     : distance entre 2 poches
    132132
    133133  ! -------------------------------------------------------------------------
    134   ! Déclaration de variables
     134  ! D�claration de variables
    135135  ! -------------------------------------------------------------------------
    136136
    … …  
    196196  ! -------------------
    197197
    198   ! Variables à fixer
     198  ! Variables � fixer
    199199  INTEGER, SAVE                                         :: igout
    200200  !$OMP THREADPRIVATE(igout)
    … …  
    383383  ! Configuration de coefgw,stark,wdens (22/02/06 by YU Jingmei)
    384384
    385   ! coefgw : Coefficient pour les ondes de gravité
     385  ! coefgw : Coefficient pour les ondes de gravit�
    386386  ! stark : Coefficient k dans Cstar=k*sqrt(2*WAPE)
    387   ! wdens : Densité surfacique de poche froide
     387  ! wdens : Densit� surfacique de poche froide
    388388  ! -------------------------------------------------------------------------
    389389
    … …  
    10881088
    10891089    ! cc nrlmd   Ajout d'un recalcul de wdens dans le cas d'un entrainement
    1090     ! négatif de ktop à kupper --------
    1091     ! cc           On calcule pour cela une densité wdens0 pour laquelle on
     1090    ! n�gatif de ktop � kupper --------
     1091    ! cc           On calcule pour cela une densit� wdens0 pour laquelle on
    10921092    ! aurait un entrainement nul ---
    10931093    !jyg<
    … …  
    10961096    ! des descentes unsaturees. Nous faisons alors l'hypothese que la
    10971097    ! convection profonde cree directement de nouvelles poches, sans passer
    1098     ! par les thermiques. La nouvelle valeur de wdens est alors imposée.
     1098    ! par les thermiques. La nouvelle valeur de wdens est alors impos�e.
    10991099
    11001100    DO i = 1, klon
    … …  
    11951195      DO i = 1, klon
    11961196        IF (wk_adv(i)) THEN
    1197           ! cc nrlmd          Introduction du taux de mortalité des poches et
     1197          ! cc nrlmd          Introduction du taux de mortalit� des poches et
    11981198          ! test sur sigmaw_max=0.4
    11991199          ! cc         d_sigmaw(i) = gfl(i)*Cstar(i)*dtimesub
    … …  
    13081308
    13091309    ! c      DO i=1,klon
    1310     ! c        print*,'Pente entre 0 et kupper (référence)'
     1310    ! c        print*,'Pente entre 0 et kupper (r�f�rence)'
    13111311    ! c     $           ,omg(i,kupper(i)+1)/(pupper(i)-ph(i,1))
    13121312    ! c        print*,'Pente entre ktop et kupper'
    … …  
    16021602
    16031603
    1604           ! Coefficient de répartition
     1604          ! Coefficient de r�partition
    16051605
    16061606          crep(i, k) = crep_sol*(ph(i,kupper(i))-ph(i,k))/ &
    … …  
    16461646!
    16471647
    1648           ! cc nrlmd          Prise en compte du taux de mortalité
    1649           ! cc               Définitions de entr, detr
     1648          ! cc nrlmd          Prise en compte du taux de mortalit�
     1649          ! cc               D�finitions de entr, detr
    16501650!jyg<
    16511651!!            detr(i, k) = 0.
    … …  
    16641664
    16651665
    1666           ! ajout d'un effet onde de gravité -Tgw(k)*deltatw(k) 03/02/06 YU
     1666          ! ajout d'un effet onde de gravit� -Tgw(k)*deltatw(k) 03/02/06 YU
    16671667          ! Jingmei
    16681668
    … …  
    17481748    ! c      do i=1,klon
    17491749    ! c         print*,alpha(i)
    1750     ! c      end do
     1750    ! c      END DO
    17511751    ! cc
    17521752    DO k = 1, klev
    … …  
    26012601        discrim = b*b - 4.*a*c
    26022602        ! print*, 'x, a, b, c, discrim', x, a, b, c, discrim
    2603         IF (a+b>=0.) THEN !! Condition suffisante pour la positivité de ovap
     2603        IF (a+b>=0.) THEN !! Condition suffisante pour la positivit� de ovap
    26042604          alpha1(i) = 1.
    26052605        ELSE

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyetat0_mod.F90

    r5082 r5086  
    342342        IF (.NOT. found) THEN
    343343           PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
    344            PRINT*, "          Il prend donc la valeur de surface"
     344           PRINT*, "          Il prEND DOnc la valeur de surface"
    345345           tsoil(:, isoil, :)=ftsol(:, :)
    346346        ENDIF

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/physiq_mod.F90

    r5082 r5086  
    18691869998          CONTINUE
    18701870             CLOSE(98)
    1871              CONTINUE
    18721871             IF(nCFMIP>npCFMIP) THEN
    18731872                print*,'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler'

  • LMDZ6/branches/Amaury_dev/tools/netcdf95/Datasets/nf95_create_single.f90

    r5075 r5086  
    4747          call nf95_put_att(ncid, varid_coord(i), coordinates(i)%attr_name(j), &
    4848               coordinates(i)%attr_val(j))
    49        end do
    50     end do
     49       END DO
     50    END DO
    5151
    5252    call nf95_def_var(ncid, name, NF90_FLOAT, dimids, varid)

  • LMDZ6/branches/Amaury_dev/tools/netcdf95/Datasets/nf95_find_coord.f90

    r5075 r5086  
    9696          end if
    9797       end if
    98     end do
     98    END DO
    9999
    100100    if (found) then

  • LMDZ6/branches/Amaury_dev/tools/netcdf95/Groups/nf95_inq_file_ncid.f90

    r5075 r5086  
    3131       if (ncerr_local /= nf95_noerr) exit
    3232       ncid_file = parent_ncid
    33     end do
     33    END DO
    3434
    3535    if (ncerr_local == NF95_ENOGRP) then

  • LMDZ6/branches/Amaury_dev/tools/netcdf95/Variables/nf95_gw_var.f90

    r4918 r5086  
    152152    do i = 1, 4
    153153       call nf95_inquire_dimension(ncid, dimids(i), nclen=len_dim(i))
    154     end do
     154    END DO
    155155
    156156    allocate(values(len_dim(1), len_dim(2), len_dim(3), len_dim(4)))
    … …  
    186186    do i = 1, 5
    187187       call nf95_inquire_dimension(ncid, dimids(i), nclen=len_dim(i))
    188     end do
     188    END DO
    189189
    190190    allocate(values(len_dim(1), len_dim(2), len_dim(3), len_dim(4), len_dim(5)))
    … …  
    323323    do i = 1, 4
    324324       call nf95_inquire_dimension(ncid, dimids(i), nclen=len_dim(i))
    325     end do
     325    END DO
    326326
    327327    allocate(values(len_dim(1), len_dim(2), len_dim(3), len_dim(4)))
Note: See TracChangeset for help on using the changeset viewer.