cleaned up amrclaw files with SHARED do warnings

src/2d/addflags.f

@@ -22,12 +22,13 @@ subroutine addflags(rectflags,mibuff,mjbuff,
 c :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 c
 
-      do 10 j = nghost+1, mjtot-nghost
-      do 10 i = nghost+1, mitot-nghost
+      do j = nghost+1, mjtot-nghost
+      do i = nghost+1, mitot-nghost
          if (rctold(1,i,j) .gt. DONTFLAG) then
            rectflags(i,j) = DOFLAG
          endif
- 10   continue
+      end do
+      end do
 c
  99   return
       end

src/2d/advanc.f

@@ -213,8 +213,9 @@ subroutine par_advanc (mptr,mitot,mjtot,nvar,naux,dtnew)
          if (level .lt. mxnest) then
              ntot   = mitot * mjtot * nvar
 cdir$ ivdep
-             do 10 i = 1, ntot
- 10            alloc(locold + i - 1) = alloc(locnew + i - 1)
+             do  i = 1, ntot
+               alloc(locold + i - 1) = alloc(locnew + i - 1)
+             end do
          endif
 c
          xlow = rnode(cornxlo,mptr) - nghost*hx

src/2d/auxcoarsen.f

@@ -16,41 +16,44 @@ subroutine auxcoarsen(auxdub,midub,mjdub,auxbgc,
 !! for error estimation).
 c :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 
-       do 50 iaux = 1, naux
+       do iaux = 1, naux
 
        if (auxtype(iaux) .eq. "center" .or. 
      .     auxtype(iaux) .eq. "capacity") then
-         do 20 j = 1, mj2tot
+         do j = 1, mj2tot
             jfine = 2*(j-1) + 1
-            do 20 i = 1, mi2tot
+            do i = 1, mi2tot
                ifine = 2*(i-1) + 1
                auxbgc(iaux,i,j) = (auxdub(iaux,ifine,jfine) +
      &                             auxdub(iaux,ifine+1,jfine)+
      &                             auxdub(iaux,ifine,jfine+1) +
      &                             auxdub(iaux,ifine+1,jfine+1))/4.d0
-20       continue
+            end do
+         end do
 
        elseif (auxtype(iaux) .eq. "xleft") then 
-         do 10 j = 1, mj2tot
+         do j = 1, mj2tot
             jfine = 2*(j-1) + 1
-            do 10 i = 1, mi2tot
+            do i = 1, mi2tot
                ifine = 2*(i-1) + 1
                auxbgc(iaux,i,j) = (auxdub(iaux,ifine,jfine) +
      &                             auxdub(iaux,ifine,jfine+1)) /2.d0 
-10       continue
+            end do
+         end do
 
        elseif (auxtype(iaux) .eq. "yleft") then 
-         do 15 j = 1, mj2tot
+         do j = 1, mj2tot
             jfine = 2*(j-1) + 1
-            do 15 i = 1, mi2tot
+            do i = 1, mi2tot
                ifine = 2*(i-1) + 1
                auxbgc(iaux,i,j) = (auxdub(iaux,ifine,jfine) +
      &                             auxdub(iaux,ifine+1,jfine))/2.d0
-15       continue
+            end do
+         end do
 
        endif
 
-50     continue
+       end do
 
        return
        end

src/2d/baseCheck.f

@@ -174,7 +174,7 @@ logical function baseCheck(mnew,lbase,ilo,ihi,jlo,jhi,
      .                 ishift,jshift,lbase)
 
 c          compare all regions of coarsened patch with one lbase grid at a time
-           do 25 i = 1, 3
+           do 26 i = 1, 3
               i1 = max(iclo,ist(i))
               i2 = min(ichi, iend(i))
            do 25 j = 1, 3
@@ -207,6 +207,7 @@ logical function baseCheck(mnew,lbase,ilo,ihi,jlo,jhi,
                end do
 
  25       continue
+ 26       continue
 
  30       mptr = node(levelptr, mptr)
           if (mptr .ne. 0) go to 20
@@ -223,13 +224,14 @@ logical function baseCheck(mnew,lbase,ilo,ihi,jlo,jhi,
 c
 c  if any zeroes left mnew not nested
 c
-       do 40 j = jclo, jchi
-       do 40 i = iclo, ichi
+       do j = jclo, jchi
+       do i = iclo, ichi
           if (alloc(iadd(i,j)) .eq. 0) then
              baseCheck = .false.
              go to 99
           endif
- 40    continue
+       end do
+       end do
 
 c      if made it here then grid is nested
        baseCheck = .true.

src/2d/bufnst2.f

@@ -137,10 +137,11 @@ subroutine bufnst2(nvar,naux,numbad,lcheck,lbase)
 c
       numflagged = 0
       do 82 j = 1, mjbuff
-         do 82 i = 1, mibuff
+         do 81 i = 1, mibuff
             if (alloc(iadd(i,j)) .gt. DONTFLAG) then
                numflagged=numflagged + 1
             endif
+ 81      continue
  82      continue
         ! TODO: this output statement is broken?
 c     write(outunit,116) numflagged, mptr

src/2d/coarseGridFlagSet.f

@@ -17,10 +17,11 @@ subroutine coarseGridFlagSet(iflags,ixlo,ixhi,jxlo,jxhi,
 c whole point of this routine is to index using the integer cords, not the
 c  way its dimensioned and indexed in the calling routine setdomflags
 c
-       do 25 j = jxlo,jxhi         
-       do 25 i = ixlo,ixhi         
+       do j = jxlo,jxhi         
+       do i = ixlo,ixhi         
           iflags(i,j) = 1
- 25    continue
+       end do
+       end do
 
        return
        end

src/2d/coarsen.f

@@ -14,20 +14,22 @@ subroutine coarsen(valdub,midub,mjdub,valbgc,mi2tot,mj2tot,nvar)
 !! grid for error estimation.
 c :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 
-       do 10 j = 1, mj2tot
+       do j = 1, mj2tot
 
-          jfine = 2*(j-1) + 1
+         jfine = 2*(j-1) + 1
 
-          do 10 i = 1, mi2tot
+         do i = 1, mi2tot
             ifine = 2*(i-1) + 1
 
-            do 10 ivar = 1, nvar
+           do ivar = 1, nvar
 
              valbgc(ivar,i,j) = (valdub(ivar,ifine,jfine) +
      &                           valdub(ivar,ifine+1,jfine)+
      &                           valdub(ivar,ifine,jfine+1) +
      &                           valdub(ivar,ifine+1,jfine+1))/4.d0
-10     continue
+           end do
+         end do
+       end do
 
        return
        end

src/2d/colate2.f

@@ -102,7 +102,7 @@ subroutine colate2 (badpts, len, lcheck, nUniquePts, lbase)
      .                  imin,imax,jmin,jmax,mptr)
 
 
-             do 60 j = jmin, jmax
+             do 61 j = jmin, jmax
              do 60 i = imin, imax
 
 c             neg means no home was found. throw out
@@ -141,6 +141,7 @@ subroutine colate2 (badpts, len, lcheck, nUniquePts, lbase)
  101          format(2f6.1)
 
  60        continue
+ 61        continue
 
  65         continue
  66         continue

src/2d/conck.f

@@ -45,16 +45,18 @@ subroutine conck(level, nvar, naux, time, rest)
          mjtot  = ny + 2*nghost
 c
          if (mcapa .eq. 0) then
-           do 50 j  = nghost+1, mjtot-nghost
-           do 50 i  = nghost+1, mitot-nghost
+           do j  = nghost+1, mjtot-nghost
+           do i  = nghost+1, mitot-nghost
               totmass = totmass + alloc(iadd(1,i,j)) 
- 50           continue
+           end do
+           end do
           else
 c          # with capa array:
-           do 60 j  = nghost+1, mjtot-nghost
-           do 60 i  = nghost+1, mitot-nghost
+           do j  = nghost+1, mjtot-nghost
+           do i  = nghost+1, mitot-nghost
               totmass = totmass + alloc(iadd(1,i,j))*alloc(iaddaux(i,j)) 
- 60           continue
+           end do
+           end do
           endif
 c
        mptr = node(levelptr,mptr)

src/2d/copysol.f

@@ -10,11 +10,13 @@ subroutine copysol(valbig,val,nvar,mitot,mjtot,nghost,
 c
 c copy solution into grid with different number ghsot cells
 c
-       do 10 j = nghost+1, mjtot-nghost
-       do 10 i = nghost+1, mitot-nghost
-       do 10 ivar = 1, nvar
+       do j = nghost+1, mjtot-nghost
+       do i = nghost+1, mitot-nghost
+       do ivar = 1, nvar
           valbig(ivar,i-nghost+ngbig,j-nghost+ngbig) = val(ivar,i,j)
- 10    continue
+       end do
+       end do
+       end do
 c
        return
        end

src/2d/cstore.f

@@ -27,36 +27,44 @@ subroutine cstore(qc,nrow,ncol,nvar,qc1d,lenbc,naux,auxc,auxc1d)
        do 10 j = 2, ncol-1
          index = index + 1
          do 5 ivar = 1, nvar
- 5         qc1d(ivar,index) = qc(ivar,1,j)
+           qc1d(ivar,index) = qc(ivar,1,j)
+ 5       end do
          do 6 iaux = 1, naux
- 6         auxc1d(iaux,index) = auxc(iaux,1,j)
+           auxc1d(iaux,index) = auxc(iaux,1,j)
+ 6       end do
  10    continue
 
 c      side 2
        do 20 i = 2, nrow-1
          index = index + 1
          do 15 ivar = 1, nvar
- 15        qc1d(ivar,index) = qc(ivar,i,ncol)
+           qc1d(ivar,index) = qc(ivar,i,ncol)
+ 15      end do
          do 16 iaux = 1, naux
- 16        auxc1d(iaux,index) = auxc(iaux,i,ncol)
+           auxc1d(iaux,index) = auxc(iaux,i,ncol)
+ 16      end do
  20    continue
 
 c      side 3
        do 30 j = 2, ncol-1
          index = index + 1
          do 25 ivar = 1, nvar
- 25        qc1d(ivar,index) = qc(ivar,nrow,j)
+           qc1d(ivar,index) = qc(ivar,nrow,j)
+ 25      end do
          do 26 iaux = 1, naux
- 26        auxc1d(iaux,index) = auxc(iaux,nrow,j)
+           auxc1d(iaux,index) = auxc(iaux,nrow,j)
+ 26      end do
  30    continue
 
 c      side 4
        do 40 i = 2, nrow-1
          index = index + 1
          do 35 ivar = 1, nvar
- 35        qc1d(ivar,index) = qc(ivar,i,1)
+           qc1d(ivar,index) = qc(ivar,i,1)
+ 35        end do 
          do 36 iaux = 1, naux
- 36        auxc1d(iaux,index) = auxc(iaux,i,1)
+           auxc1d(iaux,index) = auxc(iaux,i,1)
+ 36      end do
  40    continue
 
        return

src/2d/domcopy.f

@@ -18,10 +18,11 @@ subroutine domcopy(iflags2,iflags,isize,jsize)
 c :::::::::::::::::::::::::::::::::::::::::::::::::::::::
 
 
-      do 10 j = 0, jsize+1
-      do 10 i = 0, isize+1
+      do j = 0, jsize+1
+      do i = 0, isize+1
          iflags2(i,j) = iflags(i,j)
- 10   continue
+      end do
+      end do
 c
 c  take care of periodicity again
 c

src/2d/domprep.f

@@ -17,19 +17,21 @@ subroutine domprep(domflags,lbase,ibase,jbase)
 c :::::::::::::::::::::::::::::::::::::::::::::::::::::::
 
 
-      do 10 j = 0, jbase+1
-      do 10 i = 0, ibase+1
+      do j = 0, jbase+1
+      do i = 0, ibase+1
          domflags(i,j) = 0
- 10   continue
+      end do
+      end do
 
       mptr = lstart(lbase)
  15   continue
 c     domain flags appears to be 1 based indexing, so 0 a ghost cell.
 c     should change it to be 0 based, like grids, so border is at -1.
-      do 20 j = node(ndjlo,mptr) + 1, node(ndjhi,mptr) + 1
-      do 20 i = node(ndilo,mptr) + 1, node(ndihi,mptr) + 1
+      do j = node(ndjlo,mptr) + 1, node(ndjhi,mptr) + 1
+      do i = node(ndilo,mptr) + 1, node(ndihi,mptr) + 1
          domflags(i,j) = 1
- 20   continue
+      end do
+      end do
       mptr = node(levelptr, mptr)
       if (mptr .ne. 0) go to 15
 

src/2d/domshrink.f

@@ -28,8 +28,8 @@ subroutine domshrink(iflags2,iflags,idim,jdim)
  10     continue
       endif
 
-      do 40 j = 1, jdim
-      do 40 i = 1, idim
+      do j = 1, jdim
+      do i = 1, idim
          iflags(i,j) = iflags2(i,j)
          if (iflags2(i  ,j  ) .le. 0 .or.
      1       iflags2(i+1,j  ) .le. 0 .or. iflags2(i-1,j  ) .le. 0 .or. 
@@ -38,7 +38,8 @@ subroutine domshrink(iflags2,iflags,idim,jdim)
      4       iflags2(i+1,j-1) .le. 0 .or. iflags2(i-1,j-1) .le. 0) then
                  iflags(i,j) = 0
           endif
- 40   continue
+      end do
+      end do
 c
 c if border of domain touches a physical boundary then set domain in
 c ghost cell as well

src/2d/domup.f

@@ -26,20 +26,23 @@ subroutine domup(iflags2,iflags,ibase,jbase,isize,jsize,lev)
  5       continue
       endif
 
-      do 10 j = 0, jsize+1
-      do 10 i = 0, isize+1
+      do j = 0, jsize+1
+      do i = 0, isize+1
          iflags2(i,j) = 0
- 10   continue
+      end do
+      end do
 
-      do 20 j = 1, jbase
-      do 20 i = 1, ibase
+      do j = 1, jbase
+      do i = 1, ibase
           ifine = (i-1) * intratx(lev)
           jfine = (j-1) * intraty(lev)
-          do 25 mj = 1, intraty(lev)
-          do 25 mi = 1, intratx(lev)
+          do mj = 1, intraty(lev)
+          do mi = 1, intratx(lev)
             iflags2(ifine+mi,jfine+mj) = iflags(i,j)  
- 25       continue
- 20       continue
+          end do
+          end do
+      end do
+      end do
 c
 c  take care of periodicity again or if border of domain touches a 
 c  physical boundary then set domain in ghost cell as well