source: palm/trunk/SOURCE/init_advec.f90 @ 4888

Last change on this file since 4888 was 4828, checked in by Giersch, 3 years ago

Copyright updated to year 2021, interface pmc_sort removed to accelarate the nesting code

  • Property svn:keywords set to Id
File size: 3.5 KB
Line 
1!> @file init_advec.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 terms of the GNU General
6! Public License as published by the Free Software Foundation, either version 3 of the License, or
7! (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
10! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
11! Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with PALM. If not, see
14! <http://www.gnu.org/licenses/>.
15!
16! Copyright 1997-2021 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------------------------!
18!
19! Current revisions:
20! -----------------
21!
22!
23! Former revisions:
24! -----------------
25! $Id: init_advec.f90 4828 2021-01-05 11:21:41Z suehring $
26! file re-formatted to follow the PALM coding standard
27!
28! 4360 2020-01-07 11:25:50Z suehring
29! Corrected "Former revisions" section
30!
31! 3655 2019-01-07 16:51:22Z knoop
32! Corrected "Former revisions" section
33!
34! Revision 1.1  1999/02/05 09:07:38  raasch
35! Initial revision
36!
37!
38! Description:
39! ------------
40!> Initialize constant coefficients and parameters for certain advection schemes.
41!--------------------------------------------------------------------------------------------------!
42 SUBROUTINE init_advec
43
44
45    USE advection,                                                                                 &
46        ONLY:  aex, bex, dex, eex
47
48    USE kinds
49
50    USE control_parameters,                                                                        &
51        ONLY:  scalar_advec
52
53    IMPLICIT NONE
54
55    INTEGER(iwp) ::  i          !<
56    INTEGER(iwp) ::  intervals  !<
57    INTEGER(iwp) ::  j          !<
58
59    REAL(wp) :: delt   !<
60    REAL(wp) :: dn     !<
61    REAL(wp) :: dnneu  !<
62    REAL(wp) :: ex1    !<
63    REAL(wp) :: ex2    !<
64    REAL(wp) :: ex3    !<
65    REAL(wp) :: ex4    !<
66    REAL(wp) :: ex5    !<
67    REAL(wp) :: ex6    !<
68    REAL(wp) :: sterm  !<
69
70
71    IF ( scalar_advec == 'bc-scheme' )  THEN
72
73!
74!--    Compute exponential coefficients for the Bott-Chlond scheme
75       intervals = 1000
76       ALLOCATE( aex(intervals), bex(intervals), dex(intervals), eex(intervals) )
77
78       delt  = 1.0_wp / REAL( intervals, KIND=wp )
79       sterm = delt * 0.5_wp
80
81       DO  i = 1, intervals
82
83          IF ( sterm > 0.5_wp )  THEN
84             dn = -5.0_wp
85          ELSE
86             dn = 5.0_wp
87          ENDIF
88
89          DO  j = 1, 15
90             ex1 = dn * EXP( -dn ) - EXP( 0.5_wp * dn ) + EXP( -0.5_wp * dn )
91             ex2 = EXP( dn ) - EXP( -dn )
92             ex3 = EXP( -dn ) * ( 1.0_wp - dn ) - 0.5_wp * EXP(  0.5_wp * dn )                     &
93                                                - 0.5_wp * EXP( -0.5_wp * dn )
94             ex4 = EXP( dn ) + EXP( -dn )
95             ex5 = dn * sterm + ex1 / ex2
96             ex6 = sterm + ( ex3 * ex2 - ex4 * ex1 ) / ( ex2 * ex2 )
97             dnneu = dn - ex5 / ex6
98             dn  = dnneu
99          ENDDO
100
101          IF ( sterm < 0.5_wp )  dn = MAX(  2.95E-2_wp, dn )
102          IF ( sterm > 0.5_wp )  dn = MIN( -2.95E-2_wp, dn )
103          ex1 = EXP( -dn )
104          ex2 = EXP( dn ) - ex1
105          aex(i) = -ex1 / ex2
106          bex(i) = 1.0_wp / ex2
107          dex(i) = dn
108          eex(i) = EXP( dex(i) * 0.5_wp )
109          sterm = sterm + delt
110
111       ENDDO
112
113    ENDIF
114
115 END SUBROUTINE init_advec
Note: See TracBrowser for help on using the repository browser.