source: palm/trunk/SOURCE/lpm_extend_tails.f90 @ 1805

Last change on this file since 1805 was 1683, checked in by knoop, 8 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 4.8 KB
Line 
1!> @file lpm_extend_tails.f90
2!--------------------------------------------------------------------------------!
3! This file is part of PALM.
4!
5! PALM is free software: you can redistribute it and/or modify it under the terms
6! of the GNU General Public License as published by the Free Software Foundation,
7! either version 3 of the License, or (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
10! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
11! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with
14! PALM. If not, see <http://www.gnu.org/licenses/>.
15!
16! Copyright 1997-2014 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------!
18!
19! Current revisions:
20! ------------------
21!
22!
23! Former revisions:
24! -----------------
25! $Id: lpm_extend_tails.f90 1683 2015-10-07 23:57:51Z maronga $
26!
27! 1682 2015-10-07 23:56:08Z knoop
28! Code annotations made doxygen readable
29!
30! 1359 2014-04-11 17:15:14Z hoffmann
31! New particle structure integrated.
32! Kind definition added to all floating point numbers.
33!
34! 1320 2014-03-20 08:40:49Z raasch
35! ONLY-attribute added to USE-statements,
36! kind-parameters added to all INTEGER and REAL declaration statements,
37! kinds are defined in new module kinds,
38! comment fields (!:) to be used for variable explanations added to
39! all variable declaration statements
40!
41! 1036 2012-10-22 13:43:42Z raasch
42! code put under GPL (PALM 3.9)
43!
44! 849 2012-03-15 10:35:09Z raasch
45! initial revision (former part of advec_particles)
46!
47!
48! Description:
49! ------------
50!> Add the current particle positions to the particle tails.
51!------------------------------------------------------------------------------!
52 SUBROUTINE lpm_extend_tails
53 
54
55    USE control_parameters,                                                    &
56        ONLY:  dt_3d
57
58    USE kinds
59
60    USE particle_attributes,                                                   &
61        ONLY:  maximum_number_of_tailpoints, maximum_tailpoint_age,            &
62               minimum_tailpoint_distance, number_of_particles, particles,     &
63               particle_tail_coordinates
64
65    IMPLICIT NONE
66
67    INTEGER(iwp) ::  i       !<
68    INTEGER(iwp) ::  n       !<
69    INTEGER(iwp) ::  nn      !<
70
71    REAL(wp) ::  distance    !<
72
73
74    distance = 0.0_wp
75
76    DO  n = 1, number_of_particles
77
78       nn = particles(n)%tail_id
79
80       IF ( nn /= 0 )  THEN
81!
82!--       Calculate the distance between the actual particle position and the
83!--       next tailpoint
84          IF ( minimum_tailpoint_distance /= 0.0_wp )  THEN
85             distance = ( particle_tail_coordinates(1,1,nn) -      &
86                          particle_tail_coordinates(2,1,nn) )**2 + &
87                        ( particle_tail_coordinates(1,2,nn) -      &
88                          particle_tail_coordinates(2,2,nn) )**2 + &
89                        ( particle_tail_coordinates(1,3,nn) -      &
90                          particle_tail_coordinates(2,3,nn) )**2
91          ENDIF
92
93!
94!--       First, increase the index of all existings tailpoints by one
95          IF ( distance >= minimum_tailpoint_distance )  THEN
96
97             DO  i = particles(n)%tailpoints, 1, -1
98                particle_tail_coordinates(i+1,:,nn) = &
99                                               particle_tail_coordinates(i,:,nn)
100             ENDDO
101!
102!--          Increase the counter which contains the number of tailpoints.
103!--          This must always be smaller than the given maximum number of
104!--          tailpoints because otherwise the index bounds of
105!--          particle_tail_coordinates would be exceeded
106             IF ( particles(n)%tailpoints < maximum_number_of_tailpoints-1 ) &
107             THEN
108                particles(n)%tailpoints = particles(n)%tailpoints + 1
109             ENDIF
110          ENDIF
111!
112!--       In any case, store the new point at the beginning of the tail
113          particle_tail_coordinates(1,1,nn) = particles(n)%x
114          particle_tail_coordinates(1,2,nn) = particles(n)%y
115          particle_tail_coordinates(1,3,nn) = particles(n)%z
116          particle_tail_coordinates(1,4,nn) = particles(n)%class
117!
118!--       Increase the age of the tailpoints
119          IF ( minimum_tailpoint_distance /= 0.0_wp )  THEN
120             particle_tail_coordinates(2:particles(n)%tailpoints,5,nn) =    &
121               particle_tail_coordinates(2:particles(n)%tailpoints,5,nn) + dt_3d
122!
123!--          Delete the last tailpoint, if it has exceeded its maximum age
124             IF ( particle_tail_coordinates(particles(n)%tailpoints,5,nn) > &
125                  maximum_tailpoint_age )  THEN
126                particles(n)%tailpoints = particles(n)%tailpoints - 1
127             ENDIF
128          ENDIF
129
130       ENDIF
131
132    ENDDO
133
134
135 END SUBROUTINE lpm_extend_tails
Note: See TracBrowser for help on using the repository browser.