Changeset 4499 for palm

Timestamp:

Apr 16, 2020 3:51:56 PM (5 years ago)

Author:

eckhard

Message:

bugfix for explicit loop in 'reverse' subroutine, updated test suite

Location:

palm/trunk/UTIL/inifor

Files:

• src/inifor_defs.f90 (modified) (2 diffs)
• src/inifor_util.f90 (modified) (2 diffs)
• tests/test-reverse-even.f90 (added)
• tests/test-reverse-odd.f90 (added)
• tests/test-stretching.f90 (modified) (4 diffs)

palm/trunk/UTIL/inifor/src/inifor_defs.f90

@@ -26 +26 @@
 ! -----------------
 ! $Id$
+! Updated copyright notice, bumped version number
+! 
+! 
+! 4481 2020-03-31 18:55:54Z maronga
 ! Bumped version number
 ! 
@@ -181 +185 @@
  INTEGER, PARAMETER          ::  FORCING_STEP = 1             !< Number of hours between forcing time steps [h]
  REAL(wp), PARAMETER         ::  NUDGING_TAU = 21600.0_wp     !< Nudging relaxation time scale [s]
- CHARACTER(LEN=*), PARAMETER ::  COPYRIGHT = 'Copyright 2017-2019 Leibniz Universitaet Hannover' // &
-    ACHAR( 10 ) // ' Copyright 2017-2019 Deutscher Wetterdienst Offenbach' !< Copyright notice
+ CHARACTER(LEN=*), PARAMETER ::  COPYRIGHT = 'Copyright 2017-2020 Leibniz Universitaet Hannover' // &
+    ACHAR( 10 ) // ' Copyright 2017-2020 Deutscher Wetterdienst Offenbach' !< Copyright notice
  CHARACTER(LEN=*), PARAMETER ::  LOG_FILE_NAME = 'inifor.log' !< Name of INIFOR's log file
- CHARACTER(LEN=*), PARAMETER ::  VERSION = '1.4.11'           !< INIFOR version number
+ CHARACTER(LEN=*), PARAMETER ::  VERSION = '1.4.12'           !< INIFOR version number
  
  END MODULE inifor_defs

palm/trunk/UTIL/inifor/src/inifor_util.f90

@@ -26 +26 @@
 ! -----------------
 ! $Id$
+! Bugfix: avoid using already overwritten elements in 'reverse' subroutine
+! 
+! 
+! 4481 2020-03-31 18:55:54Z maronga
 ! Bugfix: use explicit loop in 'reverse' subroutine instead of implicit loop
 ! 
@@ -272 +276 @@
  SUBROUTINE reverse(input_arr)
 
-    INTEGER ::  i
+    INTEGER ::  idx, opposite_idx, half_idx
+    INTEGER ::  size_1st_dimension
+    INTEGER ::  size_2nd_dimension
+    INTEGER ::  size_3rd_dimension
     INTEGER ::  lbound_3rd_dimension
     INTEGER ::  ubound_3rd_dimension
 
     REAL(wp), INTENT(INOUT) ::  input_arr(:,:,:)
+    REAL(wp), ALLOCATABLE  :: buffer_arr(:,:)
 
     lbound_3rd_dimension = LBOUND(input_arr, 3)
     ubound_3rd_dimension = UBOUND(input_arr, 3)
-
-    DO  i = lbound_3rd_dimension, ubound_3rd_dimension
-       input_arr(:,:,i) = input_arr(:,:,                    &
-         ubound_3rd_dimension - ( i - lbound_3rd_dimension ))
+    size_1st_dimension = SIZE(input_arr, 1)
+    size_2nd_dimension = SIZE(input_arr, 2)
+    size_3rd_dimension = SIZE(input_arr, 3)
+    half_idx = lbound_3rd_dimension + size_3rd_dimension / 2 - 1
+
+    ALLOCATE( buffer_arr(size_1st_dimension, size_2nd_dimension) )
+
+    DO  idx = lbound_3rd_dimension, half_idx
+       opposite_idx = ubound_3rd_dimension - ( idx - lbound_3rd_dimension )
+       buffer_arr(:,:) = input_arr(:,:,idx)
+       input_arr(:,:,idx) = input_arr(:,:,opposite_idx)
+       input_arr(:,:,opposite_idx) = buffer_arr(:,:)
     ENDDO
+    
+    DEALLOCATE( buffer_arr )
 
  END SUBROUTINE reverse

palm/trunk/UTIL/inifor/tests/test-stretching.f90

@@ -26 +26 @@
 ! -----------------
 ! $Id$
+! Bugfix: carry over variable name change of 'dp' to 'wp'
+! 
+! 
+! 
 ! Prefixed all INIFOR modules with inifor_
 ! 
@@ -48 +52 @@
 
     USE inifor_defs,                                                           &
-        ONLY :  dp
+        ONLY :  wp
 
     USE inifor_grid,                                                           &
@@ -63 +67 @@
     INTEGER            ::  k  = nz - 2
 
-    REAL(dp) ::  z(1:nz)
-    REAL(dp) ::  dz(10)            = -1.0_dp
-    REAL(dp) ::  dz_max            = 1000.0_dp
-    REAL(dp) ::  dz_stretch_factor = 1.08_dp
-    REAL(dp) ::  dz_stretch_level  = 2.0_dp
-    REAL(dp) ::  dz_stretch_level_start(9) = -9999999.9_dp
-    REAL(dp) ::  dz_stretch_level_end(9) = 9999999.9_dp
-    REAL(dp) ::  dz_stretch_factor_array(9) = 1.08_dp
+    REAL(wp) ::  z(1:nz)
+    REAL(wp) ::  dz(10)            = -1.0_wp
+    REAL(wp) ::  dz_max            = 1000.0_wp
+    REAL(wp) ::  dz_stretch_factor = 1.08_wp
+    REAL(wp) ::  dz_stretch_level  = 2.0_wp
+    REAL(wp) ::  dz_stretch_level_start(9) = -9999999.9_wp
+    REAL(wp) ::  dz_stretch_level_end(9) = 9999999.9_wp
+    REAL(wp) ::  dz_stretch_factor_array(9) = 1.08_wp
 
     CALL begin_test(title, res)
 
     ! Arange
-    z(:)   = 0.0_dp
-    dz(1)  = 1.0_dp
+    z(:)   = 0.0_wp
+    dz(1)  = 1.0_wp
 
     ! Act
@@ -96 +100 @@
     res = res .AND. &
           assert_equal( (/ z(UBOUND(z, 1)) - z(1)              /),             &
-                        (/ (1.0_dp - dz_stretch_factor**(k+1)) /               &
-                           (1.0_dp - dz_stretch_factor)        /),             &
+                        (/ (1.0_wp - dz_stretch_factor**(k+1)) /               &
+                           (1.0_wp - dz_stretch_factor)        /),             &
                         'length of stretched grid' )