Changeset 4499 for palm


Ignore:
Timestamp:
Apr 16, 2020 3:51:56 PM (14 months ago)
Author:
eckhard
Message:

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

Location:
palm/trunk/UTIL/inifor
Files:
2 added
3 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/UTIL/inifor/src/inifor_defs.f90

    r4481 r4499  
    2626! -----------------
    2727! $Id$
     28! Updated copyright notice, bumped version number
     29!
     30!
     31! 4481 2020-03-31 18:55:54Z maronga
    2832! Bumped version number
    2933!
     
    181185 INTEGER, PARAMETER          ::  FORCING_STEP = 1             !< Number of hours between forcing time steps [h]
    182186 REAL(wp), PARAMETER         ::  NUDGING_TAU = 21600.0_wp     !< Nudging relaxation time scale [s]
    183  CHARACTER(LEN=*), PARAMETER ::  COPYRIGHT = 'Copyright 2017-2019 Leibniz Universitaet Hannover' // &
    184     ACHAR( 10 ) // ' Copyright 2017-2019 Deutscher Wetterdienst Offenbach' !< Copyright notice
     187 CHARACTER(LEN=*), PARAMETER ::  COPYRIGHT = 'Copyright 2017-2020 Leibniz Universitaet Hannover' // &
     188    ACHAR( 10 ) // ' Copyright 2017-2020 Deutscher Wetterdienst Offenbach' !< Copyright notice
    185189 CHARACTER(LEN=*), PARAMETER ::  LOG_FILE_NAME = 'inifor.log' !< Name of INIFOR's log file
    186  CHARACTER(LEN=*), PARAMETER ::  VERSION = '1.4.11'           !< INIFOR version number
     190 CHARACTER(LEN=*), PARAMETER ::  VERSION = '1.4.12'           !< INIFOR version number
    187191 
    188192 END MODULE inifor_defs
  • palm/trunk/UTIL/inifor/src/inifor_util.f90

    r4481 r4499  
    2626! -----------------
    2727! $Id$
     28! Bugfix: avoid using already overwritten elements in 'reverse' subroutine
     29!
     30!
     31! 4481 2020-03-31 18:55:54Z maronga
    2832! Bugfix: use explicit loop in 'reverse' subroutine instead of implicit loop
    2933!
     
    272276 SUBROUTINE reverse(input_arr)
    273277
    274     INTEGER ::  i
     278    INTEGER ::  idx, opposite_idx, half_idx
     279    INTEGER ::  size_1st_dimension
     280    INTEGER ::  size_2nd_dimension
     281    INTEGER ::  size_3rd_dimension
    275282    INTEGER ::  lbound_3rd_dimension
    276283    INTEGER ::  ubound_3rd_dimension
    277284
    278285    REAL(wp), INTENT(INOUT) ::  input_arr(:,:,:)
     286    REAL(wp), ALLOCATABLE  :: buffer_arr(:,:)
    279287
    280288    lbound_3rd_dimension = LBOUND(input_arr, 3)
    281289    ubound_3rd_dimension = UBOUND(input_arr, 3)
    282 
    283     DO  i = lbound_3rd_dimension, ubound_3rd_dimension
    284        input_arr(:,:,i) = input_arr(:,:,                    &
    285          ubound_3rd_dimension - ( i - lbound_3rd_dimension ))
     290    size_1st_dimension = SIZE(input_arr, 1)
     291    size_2nd_dimension = SIZE(input_arr, 2)
     292    size_3rd_dimension = SIZE(input_arr, 3)
     293    half_idx = lbound_3rd_dimension + size_3rd_dimension / 2 - 1
     294
     295    ALLOCATE( buffer_arr(size_1st_dimension, size_2nd_dimension) )
     296
     297    DO  idx = lbound_3rd_dimension, half_idx
     298       opposite_idx = ubound_3rd_dimension - ( idx - lbound_3rd_dimension )
     299       buffer_arr(:,:) = input_arr(:,:,idx)
     300       input_arr(:,:,idx) = input_arr(:,:,opposite_idx)
     301       input_arr(:,:,opposite_idx) = buffer_arr(:,:)
    286302    ENDDO
     303   
     304    DEALLOCATE( buffer_arr )
    287305
    288306 END SUBROUTINE reverse
  • palm/trunk/UTIL/inifor/tests/test-stretching.f90

    r4481 r4499  
    2626! -----------------
    2727! $Id$
     28! Bugfix: carry over variable name change of 'dp' to 'wp'
     29!
     30!
     31!
    2832! Prefixed all INIFOR modules with inifor_
    2933!
     
    4852
    4953    USE inifor_defs,                                                           &
    50         ONLY :  dp
     54        ONLY :  wp
    5155
    5256    USE inifor_grid,                                                           &
     
    6367    INTEGER            ::  k  = nz - 2
    6468
    65     REAL(dp) ::  z(1:nz)
    66     REAL(dp) ::  dz(10)            = -1.0_dp
    67     REAL(dp) ::  dz_max            = 1000.0_dp
    68     REAL(dp) ::  dz_stretch_factor = 1.08_dp
    69     REAL(dp) ::  dz_stretch_level  = 2.0_dp
    70     REAL(dp) ::  dz_stretch_level_start(9) = -9999999.9_dp
    71     REAL(dp) ::  dz_stretch_level_end(9) = 9999999.9_dp
    72     REAL(dp) ::  dz_stretch_factor_array(9) = 1.08_dp
     69    REAL(wp) ::  z(1:nz)
     70    REAL(wp) ::  dz(10)            = -1.0_wp
     71    REAL(wp) ::  dz_max            = 1000.0_wp
     72    REAL(wp) ::  dz_stretch_factor = 1.08_wp
     73    REAL(wp) ::  dz_stretch_level  = 2.0_wp
     74    REAL(wp) ::  dz_stretch_level_start(9) = -9999999.9_wp
     75    REAL(wp) ::  dz_stretch_level_end(9) = 9999999.9_wp
     76    REAL(wp) ::  dz_stretch_factor_array(9) = 1.08_wp
    7377
    7478    CALL begin_test(title, res)
    7579
    7680    ! Arange
    77     z(:)   = 0.0_dp
    78     dz(1)  = 1.0_dp
     81    z(:)   = 0.0_wp
     82    dz(1)  = 1.0_wp
    7983
    8084    ! Act
     
    96100    res = res .AND. &
    97101          assert_equal( (/ z(UBOUND(z, 1)) - z(1)              /),             &
    98                         (/ (1.0_dp - dz_stretch_factor**(k+1)) /               &
    99                            (1.0_dp - dz_stretch_factor)        /),             &
     102                        (/ (1.0_wp - dz_stretch_factor**(k+1)) /               &
     103                           (1.0_wp - dz_stretch_factor)        /),             &
    100104                        'length of stretched grid' )
    101105
Note: See TracChangeset for help on using the changeset viewer.