source: palm/trunk/UTIL/inifor/tests/test-stretching.f90 @ 4764

Last change on this file since 4764 was 4499, checked in by eckhard, 5 years ago

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

File size: 3.4 KB
RevLine 
[3396]1!> @file tests/test-stretching.f90
2!------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
[4481]17! Copyright 2017-2020 Leibniz Universitaet Hannover
18! Copyright 2017-2020 Deutscher Wetterdienst Offenbach
[3396]19!------------------------------------------------------------------------------!
20!
21! Current revisions:
22! -----------------
23!
24!
25! Former revisions:
26! -----------------
27! $Id$
[4499]28! Bugfix: carry over variable name change of 'dp' to 'wp'
29!
30!
31!
[3618]32! Prefixed all INIFOR modules with inifor_
33!
34!
35!
[3396]36! Initial revision
37!
38!
39!
40!
41!
42! Authors:
43! --------
44! @author Eckhard Kadasch
45!
46! Description:
47! ------------
48!> This program tests INIFOR's implementation of PALM's grid stretching.
49!>
50!------------------------------------------------------------------------------!
51 PROGRAM test_stretching
52
[3618]53    USE inifor_defs,                                                           &
[4499]54        ONLY :  wp
[3396]55
[3618]56    USE inifor_grid,                                                           &
[3396]57        ONLY :  stretched_z
58
59    USE test_utils
60   
61    IMPLICIT NONE
62
63    CHARACTER(LEN=*), PARAMETER ::  title = "stretched grid"
64    LOGICAL                     ::  res
65
66    INTEGER, PARAMETER ::  nz = 9
67    INTEGER            ::  k  = nz - 2
68
[4499]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
[3396]77
78    CALL begin_test(title, res)
79
80    ! Arange
[4499]81    z(:)   = 0.0_wp
82    dz(1)  = 1.0_wp
[3396]83
84    ! Act
85    CALL stretched_z(z, dz, dz_max=dz_max, &
86                     dz_stretch_factor=dz_stretch_factor,                   &
87                     dz_stretch_level=dz_stretch_level,                     &
88                     dz_stretch_level_start=dz_stretch_level_start,         &
89                     dz_stretch_level_end=dz_stretch_level_end,             &
90                     dz_stretch_factor_array=dz_stretch_factor_array)
91
92    ! Assert, that the total distance covered by the stretched region
93    ! matches the therotetial distance, i.e. the sum over the finite
94    ! exponential series
95    !
96    !          Sum_{i=0}^n( dz[i] ) = dz[0] * Sum_{i=0}^n( f^i )
97    !                               = dz[0] * (1 - f^(i+1)) / (1-f)
98    !
99    ! with f being the stretch factor.
100    res = res .AND. &
101          assert_equal( (/ z(UBOUND(z, 1)) - z(1)              /),             &
[4499]102                        (/ (1.0_wp - dz_stretch_factor**(k+1)) /               &
103                           (1.0_wp - dz_stretch_factor)        /),             &
[3396]104                        'length of stretched grid' )
105
106    CALL end_test(title, res)
107
108 END PROGRAM test_stretching
Note: See TracBrowser for help on using the repository browser.