Changeset 2229 for palm/trunk

Timestamp:

May 30, 2017 2:52:52 PM (7 years ago)

Author:

hellstea

Message:

minor bugfix in pmc interface

File:

• palm/trunk/SOURCE/pmc_interface_mod.f90 (modified) (8 diffs)

palm/trunk/SOURCE/pmc_interface_mod.f90

@@ -21 +21 @@
 ! Current revisions:
 ! ------------------
-! 
+! A minor indexing error in init_anterp_tophat is corrected.
 ! 
 ! Former revisions:
@@ -27 +27 @@
 ! $Id$
 !
-! 2219 2017-05-09 14:16:14Z hellstea
-! Two near-wall correction-related array indexing bugs corrected in the
-! interpolation routines.
-! 
 ! 2174 2017-03-13 08:18:57Z maronga
 ! Added support for cloud physics quantities, syntax layout improvements. Data
@@ -2159 +2155 @@
        INTEGER(iwp) ::  ii       !: Coarse-grid index
        INTEGER(iwp) ::  istart   !:
+       INTEGER(iwp) ::  ir       !:
        INTEGER(iwp) ::  j        !: Fine-grid index
        INTEGER(iwp) ::  jj       !: Coarse-grid index
        INTEGER(iwp) ::  jstart   !:
+       INTEGER(iwp) ::  jr       !:
        INTEGER(iwp) ::  k        !: Fine-grid index
        INTEGER(iwp) ::  kk       !: Coarse-grid index
@@ -2228 +2226 @@
           DO  WHILE ( ( coord_x(i) < cg%coord_x(ii) - 0.5_wp * cg%dx )  .AND.   &
                       ( i < nxrg ) )
-             i = i + 1
+             i  = i + 1
           ENDDO
           iflu(ii) = MIN( MAX( i, nxlg ), nxrg )
-          DO  WHILE ( ( coord_x(i) <= cg%coord_x(ii) + 0.5_wp * cg%dx )  .AND.  &
+          ir = i
+          DO  WHILE ( ( coord_x(ir) <= cg%coord_x(ii) + 0.5_wp * cg%dx )  .AND. &
                       ( i < nxrg+1 ) )
-             i = i + 1
+             i  = i + 1
+             ir = MIN( i, nxrg )
           ENDDO
           ifuu(ii) = MIN( MAX( i-1, iflu(ii) ), nxrg )
@@ -2249 +2249 @@
           DO  WHILE ( ( coord_x(i) + 0.5_wp * dx < cg%coord_x(ii) )  .AND.      &
                       ( i < nxrg ) )
-             i = i + 1
+             i  = i + 1
           ENDDO
           iflo(ii) = MIN( MAX( i, nxlg ), nxrg )
-          DO  WHILE ( ( coord_x(i) + 0.5_wp * dx <= cg%coord_x(ii) + cg%dx )    &
+          ir = i
+          DO  WHILE ( ( coord_x(ir) + 0.5_wp * dx <= cg%coord_x(ii) + cg%dx )   &
                       .AND.  ( i < nxrg+1 ) )
-             i = i + 1
+             i  = i + 1
+             ir = MIN( i, nxrg )
           ENDDO
           ifuo(ii) = MIN( MAX( i-1, iflo(ii) ), nxrg )
@@ -2270 +2272 @@
           DO  WHILE ( ( coord_y(j) < cg%coord_y(jj) - 0.5_wp * cg%dy )  .AND.   &
                       ( j < nyng ) )
-             j = j + 1
+             j  = j + 1
           ENDDO
           jflv(jj) = MIN( MAX( j, nysg ), nyng )
-          DO  WHILE ( ( coord_y(j) <= cg%coord_y(jj) + 0.5_wp * cg%dy )  .AND.  &
+          jr = j
+          DO  WHILE ( ( coord_y(jr) <= cg%coord_y(jj) + 0.5_wp * cg%dy )  .AND. &
                       ( j < nyng+1 ) )
-             j = j + 1
+             j  = j + 1
+             jr = MIN( j, nyng )
           ENDDO
           jfuv(jj) = MIN( MAX( j-1, jflv(jj) ), nyng )
@@ -2290 +2294 @@
           DO  WHILE ( ( coord_y(j) + 0.5_wp * dy < cg%coord_y(jj) )  .AND.      &
                       ( j < nyng ) )
-             j = j + 1
+             j  = j + 1
           ENDDO
           jflo(jj) = MIN( MAX( j, nysg ), nyng )
-          DO  WHILE ( ( coord_y(j) + 0.5_wp * dy <= cg%coord_y(jj) + cg%dy )    &
+          jr = j
+          DO  WHILE ( ( coord_y(jr) + 0.5_wp * dy <= cg%coord_y(jj) + cg%dy )   &
                       .AND.  ( j < nyng+1 ) )
-             j = j + 1
+             j  = j + 1
+             jr = MIN( j, nyng )
           ENDDO
           jfuo(jj) = MIN( MAX( j-1, jflo(jj) ), nyng )
@@ -2315 +2321 @@
           kflw(kk) = MIN( MAX( k, 1 ), nzt + 1 )
           DO  WHILE ( ( zw(k) <= cg%zu(kk+1) )  .AND.  ( k < nzt+1 ) )
-             k = k + 1
+             k  = k + 1
           ENDDO
           kfuw(kk) = MIN( MAX( k-1, kflw(kk) ), nzt + 1 )