Changeset 4499 for palm/trunk/UTIL/inifor/src

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/src

Files:

• inifor_defs.f90 (modified) (2 diffs)
• inifor_util.f90 (modified) (2 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