[849] | 1 | SUBROUTINE lpm_release_set |
---|
| 2 | |
---|
[1036] | 3 | !--------------------------------------------------------------------------------! |
---|
| 4 | ! This file is part of PALM. |
---|
| 5 | ! |
---|
| 6 | ! PALM is free software: you can redistribute it and/or modify it under the terms |
---|
| 7 | ! of the GNU General Public License as published by the Free Software Foundation, |
---|
| 8 | ! either version 3 of the License, or (at your option) any later 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 | ! |
---|
[1310] | 17 | ! Copyright 1997-2014 Leibniz Universitaet Hannover |
---|
[1036] | 18 | !--------------------------------------------------------------------------------! |
---|
| 19 | ! |
---|
[849] | 20 | ! Current revisions: |
---|
| 21 | ! ------------------ |
---|
[1359] | 22 | ! New particle structure integrated. |
---|
| 23 | ! Kind definition added to all floating point numbers. |
---|
| 24 | ! lpm_init changed form a subroutine to a module. |
---|
[1329] | 25 | ! |
---|
[1321] | 26 | ! Former revisions: |
---|
| 27 | ! ----------------- |
---|
| 28 | ! $Id: lpm_release_set.f90 1359 2014-04-11 17:15:14Z hoffmann $ |
---|
| 29 | ! |
---|
[1329] | 30 | ! 1327 2014-03-21 11:00:16Z raasch |
---|
| 31 | ! -netcdf output queries |
---|
| 32 | ! |
---|
[1321] | 33 | ! 1320 2014-03-20 08:40:49Z raasch |
---|
[1320] | 34 | ! ONLY-attribute added to USE-statements, |
---|
| 35 | ! kind-parameters added to all INTEGER and REAL declaration statements, |
---|
| 36 | ! kinds are defined in new module kinds, |
---|
| 37 | ! comment fields (!:) to be used for variable explanations added to |
---|
| 38 | ! all variable declaration statements |
---|
[849] | 39 | ! |
---|
[1037] | 40 | ! 1036 2012-10-22 13:43:42Z raasch |
---|
| 41 | ! code put under GPL (PALM 3.9) |
---|
| 42 | ! |
---|
[850] | 43 | ! 849 2012-03-15 10:35:09Z raasch |
---|
| 44 | ! initial revision (former part of advec_particles) |
---|
[849] | 45 | ! |
---|
[850] | 46 | ! |
---|
[849] | 47 | ! Description: |
---|
| 48 | ! ------------ |
---|
| 49 | ! Release a new set of particles and, if required, particle tails. These |
---|
| 50 | ! particles/tails are added at the end of the existing arrays. Extend the |
---|
| 51 | ! respective particle and tail arrays, if neccessary. |
---|
| 52 | !------------------------------------------------------------------------------! |
---|
| 53 | |
---|
[1320] | 54 | USE control_parameters, & |
---|
[1327] | 55 | ONLY: iran, message_string, netcdf_data_format |
---|
[849] | 56 | |
---|
[1359] | 57 | USE lpm_init_mod, & |
---|
| 58 | ONLY: lpm_create_particle, PHASE_RELEASE |
---|
| 59 | |
---|
[1320] | 60 | USE grid_variables, & |
---|
| 61 | ONLY: dx, dy |
---|
| 62 | |
---|
| 63 | USE indices, & |
---|
| 64 | ONLY: nxl, nxr, nyn, nys |
---|
| 65 | |
---|
| 66 | USE kinds |
---|
| 67 | |
---|
| 68 | USE particle_attributes, & |
---|
[1359] | 69 | ONLY: minimum_tailpoint_distance, number_of_tails, particles, & |
---|
| 70 | particle_tail_coordinates, use_particle_tails |
---|
[1320] | 71 | |
---|
[849] | 72 | IMPLICIT NONE |
---|
| 73 | |
---|
[1320] | 74 | INTEGER(iwp) :: ie !: |
---|
| 75 | INTEGER(iwp) :: is !: |
---|
| 76 | INTEGER(iwp) :: n !: |
---|
| 77 | INTEGER(iwp) :: nn !: |
---|
[849] | 78 | |
---|
| 79 | |
---|
[1359] | 80 | CALL lpm_create_particle(PHASE_RELEASE) |
---|
[849] | 81 | ! |
---|
[1359] | 82 | !-- particle tails currently not available |
---|
| 83 | ! ! |
---|
| 84 | ! !-- Set the beginning of the new particle tails and their age |
---|
| 85 | ! IF ( use_particle_tails ) THEN |
---|
| 86 | ! |
---|
| 87 | ! DO n = is, ie |
---|
| 88 | ! ! |
---|
| 89 | ! !-- New particles which should have a tail, already have got a |
---|
| 90 | ! !-- provisional tail id unequal zero (see lpm_init) |
---|
| 91 | ! IF ( particles(n)%tail_id /= 0 ) THEN |
---|
| 92 | ! |
---|
| 93 | ! number_of_tails = number_of_tails + 1 |
---|
| 94 | ! nn = number_of_tails |
---|
| 95 | ! particles(n)%tail_id = nn ! set the final tail id |
---|
| 96 | ! particle_tail_coordinates(1,1,nn) = particles(n)%x |
---|
| 97 | ! particle_tail_coordinates(1,2,nn) = particles(n)%y |
---|
| 98 | ! particle_tail_coordinates(1,3,nn) = particles(n)%z |
---|
| 99 | ! particle_tail_coordinates(1,4,nn) = particles(n)%class |
---|
| 100 | ! particles(n)%tailpoints = 1 |
---|
| 101 | ! |
---|
| 102 | ! IF ( minimum_tailpoint_distance /= 0.0 ) THEN |
---|
| 103 | ! particle_tail_coordinates(2,1,nn) = particles(n)%x |
---|
| 104 | ! particle_tail_coordinates(2,2,nn) = particles(n)%y |
---|
| 105 | ! particle_tail_coordinates(2,3,nn) = particles(n)%z |
---|
| 106 | ! particle_tail_coordinates(2,4,nn) = particles(n)%class |
---|
| 107 | ! particle_tail_coordinates(1:2,5,nn) = 0.0_wp |
---|
| 108 | ! particles(n)%tailpoints = 2 |
---|
| 109 | ! ENDIF |
---|
| 110 | ! |
---|
| 111 | ! ENDIF |
---|
| 112 | ! |
---|
| 113 | ! ENDDO |
---|
| 114 | ! |
---|
| 115 | ! ENDIF |
---|
[849] | 116 | |
---|
| 117 | |
---|
| 118 | END SUBROUTINE lpm_release_set |
---|