[849] | 1 | SUBROUTINE lpm_release_set |
---|
| 2 | |
---|
| 3 | !------------------------------------------------------------------------------! |
---|
| 4 | ! Current revisions: |
---|
| 5 | ! ------------------ |
---|
| 6 | ! |
---|
| 7 | ! |
---|
| 8 | ! Former revisions: |
---|
| 9 | ! ----------------- |
---|
| 10 | ! $Id: lpm_release_set.f90 850 2012-03-15 12:09:25Z suehring $ |
---|
| 11 | ! |
---|
[850] | 12 | ! 849 2012-03-15 10:35:09Z raasch |
---|
| 13 | ! initial revision (former part of advec_particles) |
---|
[849] | 14 | ! |
---|
[850] | 15 | ! |
---|
[849] | 16 | ! Description: |
---|
| 17 | ! ------------ |
---|
| 18 | ! Release a new set of particles and, if required, particle tails. These |
---|
| 19 | ! particles/tails are added at the end of the existing arrays. Extend the |
---|
| 20 | ! respective particle and tail arrays, if neccessary. |
---|
| 21 | !------------------------------------------------------------------------------! |
---|
| 22 | |
---|
| 23 | USE control_parameters |
---|
| 24 | USE grid_variables |
---|
| 25 | USE indices |
---|
| 26 | USE particle_attributes |
---|
| 27 | USE random_function_mod |
---|
| 28 | |
---|
| 29 | IMPLICIT NONE |
---|
| 30 | |
---|
| 31 | INTEGER :: ie, is, n, nn |
---|
| 32 | |
---|
| 33 | |
---|
| 34 | ! |
---|
| 35 | !-- Check, if particle storage must be extended |
---|
| 36 | IF ( number_of_particles + number_of_initial_particles > & |
---|
| 37 | maximum_number_of_particles ) THEN |
---|
| 38 | IF ( netcdf_output .AND. netcdf_data_format < 3 ) THEN |
---|
| 39 | message_string = 'maximum_number_of_particles needs to be increa' // & |
---|
| 40 | 'sed &but this is not allowed with netcdf_data_' // & |
---|
| 41 | 'format < 3' |
---|
| 42 | CALL message( 'lpm_release_set', 'PA0146', 2, 2, -1, 6, 1 ) |
---|
| 43 | ELSE |
---|
| 44 | CALL lpm_extend_particle_array( number_of_initial_particles ) |
---|
| 45 | ENDIF |
---|
| 46 | ENDIF |
---|
| 47 | |
---|
| 48 | ! |
---|
| 49 | !-- Check, if tail storage must be extended |
---|
| 50 | IF ( use_particle_tails ) THEN |
---|
| 51 | IF ( number_of_tails + number_of_initial_tails > & |
---|
| 52 | maximum_number_of_tails ) THEN |
---|
| 53 | IF ( netcdf_output .AND. netcdf_data_format < 3 ) THEN |
---|
| 54 | message_string = 'maximum_number_of_tails needs to be increas' // & |
---|
| 55 | 'ed &but this is not allowed with netcdf_dat' // & |
---|
| 56 | 'a_format < 3' |
---|
| 57 | CALL message( 'lpm_release_set', 'PA0147', 2, 2, -1, 6, 1 ) |
---|
| 58 | ELSE |
---|
| 59 | CALL lpm_extend_tail_array( number_of_initial_tails ) |
---|
| 60 | ENDIF |
---|
| 61 | ENDIF |
---|
| 62 | ENDIF |
---|
| 63 | |
---|
| 64 | IF ( number_of_initial_particles /= 0 ) THEN |
---|
| 65 | |
---|
| 66 | is = number_of_particles + 1 |
---|
| 67 | ie = number_of_particles + number_of_initial_particles |
---|
| 68 | particles(is:ie) = initial_particles(1:number_of_initial_particles) |
---|
| 69 | ! |
---|
| 70 | !-- Add random fluctuation to particle positions. Particles should |
---|
| 71 | !-- remain in the subdomain. |
---|
| 72 | IF ( random_start_position ) THEN |
---|
| 73 | |
---|
| 74 | DO n = is, ie |
---|
| 75 | |
---|
| 76 | IF ( psl(particles(n)%group) /= psr(particles(n)%group) ) THEN |
---|
| 77 | particles(n)%x = particles(n)%x + & |
---|
| 78 | ( random_function( iran_part ) - 0.5 ) * & |
---|
| 79 | pdx(particles(n)%group) |
---|
| 80 | IF ( particles(n)%x <= ( nxl - 0.5 ) * dx ) THEN |
---|
| 81 | particles(n)%x = ( nxl - 0.4999999999 ) * dx |
---|
| 82 | ELSEIF ( particles(n)%x >= ( nxr + 0.5 ) * dx ) THEN |
---|
| 83 | particles(n)%x = ( nxr + 0.4999999999 ) * dx |
---|
| 84 | ENDIF |
---|
| 85 | ENDIF |
---|
| 86 | |
---|
| 87 | IF ( pss(particles(n)%group) /= psn(particles(n)%group) ) THEN |
---|
| 88 | particles(n)%y = particles(n)%y + & |
---|
| 89 | ( random_function( iran_part ) - 0.5 ) * & |
---|
| 90 | pdy(particles(n)%group) |
---|
| 91 | IF ( particles(n)%y <= ( nys - 0.5 ) * dy ) THEN |
---|
| 92 | particles(n)%y = ( nys - 0.4999999999 ) * dy |
---|
| 93 | ELSEIF ( particles(n)%y >= ( nyn + 0.5 ) * dy ) THEN |
---|
| 94 | particles(n)%y = ( nyn + 0.4999999999 ) * dy |
---|
| 95 | ENDIF |
---|
| 96 | ENDIF |
---|
| 97 | |
---|
| 98 | IF ( psb(particles(n)%group) /= pst(particles(n)%group) ) THEN |
---|
| 99 | particles(n)%z = particles(n)%z + & |
---|
| 100 | ( random_function( iran_part ) - 0.5 ) * & |
---|
| 101 | pdz(particles(n)%group) |
---|
| 102 | ENDIF |
---|
| 103 | |
---|
| 104 | ENDDO |
---|
| 105 | |
---|
| 106 | ENDIF |
---|
| 107 | |
---|
| 108 | ! |
---|
| 109 | !-- Set the beginning of the new particle tails and their age |
---|
| 110 | IF ( use_particle_tails ) THEN |
---|
| 111 | |
---|
| 112 | DO n = is, ie |
---|
| 113 | ! |
---|
| 114 | !-- New particles which should have a tail, already have got a |
---|
| 115 | !-- provisional tail id unequal zero (see lpm_init) |
---|
| 116 | IF ( particles(n)%tail_id /= 0 ) THEN |
---|
| 117 | |
---|
| 118 | number_of_tails = number_of_tails + 1 |
---|
| 119 | nn = number_of_tails |
---|
| 120 | particles(n)%tail_id = nn ! set the final tail id |
---|
| 121 | particle_tail_coordinates(1,1,nn) = particles(n)%x |
---|
| 122 | particle_tail_coordinates(1,2,nn) = particles(n)%y |
---|
| 123 | particle_tail_coordinates(1,3,nn) = particles(n)%z |
---|
| 124 | particle_tail_coordinates(1,4,nn) = particles(n)%class |
---|
| 125 | particles(n)%tailpoints = 1 |
---|
| 126 | |
---|
| 127 | IF ( minimum_tailpoint_distance /= 0.0 ) THEN |
---|
| 128 | particle_tail_coordinates(2,1,nn) = particles(n)%x |
---|
| 129 | particle_tail_coordinates(2,2,nn) = particles(n)%y |
---|
| 130 | particle_tail_coordinates(2,3,nn) = particles(n)%z |
---|
| 131 | particle_tail_coordinates(2,4,nn) = particles(n)%class |
---|
| 132 | particle_tail_coordinates(1:2,5,nn) = 0.0 |
---|
| 133 | particles(n)%tailpoints = 2 |
---|
| 134 | ENDIF |
---|
| 135 | |
---|
| 136 | ENDIF |
---|
| 137 | |
---|
| 138 | ENDDO |
---|
| 139 | |
---|
| 140 | ENDIF |
---|
| 141 | |
---|
| 142 | number_of_particles = number_of_particles + number_of_initial_particles |
---|
| 143 | |
---|
| 144 | ENDIF |
---|
| 145 | |
---|
| 146 | END SUBROUTINE lpm_release_set |
---|