Changeset 1359 for palm/trunk/SOURCE/lpm_release_set.f90
- Timestamp:
- Apr 11, 2014 5:15:14 PM (11 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/lpm_release_set.f90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/lpm_release_set.f90
r1329 r1359 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! New particle structure integrated. 23 ! Kind definition added to all floating point numbers. 24 ! lpm_init changed form a subroutine to a module. 23 25 ! 24 26 ! Former revisions: … … 53 55 ONLY: iran, message_string, netcdf_data_format 54 56 57 USE lpm_init_mod, & 58 ONLY: lpm_create_particle, PHASE_RELEASE 59 55 60 USE grid_variables, & 56 61 ONLY: dx, dy … … 62 67 63 68 USE particle_attributes, & 64 ONLY: initial_particles, iran_part, maximum_number_of_particles, & 65 maximum_number_of_tails, minimum_tailpoint_distance, & 66 number_of_initial_particles, number_of_initial_tails, & 67 number_of_particles, number_of_tails, particles, & 68 particle_tail_coordinates, pdx, pdy, pdz, psb, psl, psn, psr, & 69 pss, pst, random_start_position, use_particle_tails 70 71 USE random_function_mod, & 72 ONLY: random_function 69 ONLY: minimum_tailpoint_distance, number_of_tails, particles, & 70 particle_tail_coordinates, use_particle_tails 73 71 74 72 IMPLICIT NONE … … 80 78 81 79 80 CALL lpm_create_particle(PHASE_RELEASE) 82 81 ! 83 !-- Check, if particle storage must be extended 84 IF ( number_of_particles + number_of_initial_particles > & 85 maximum_number_of_particles ) THEN 86 IF ( netcdf_data_format < 3 ) THEN 87 message_string = 'maximum_number_of_particles needs to be increa' // & 88 'sed &but this is not allowed with netcdf_data_' // & 89 'format < 3' 90 CALL message( 'lpm_release_set', 'PA0146', 2, 2, -1, 6, 1 ) 91 ELSE 92 CALL lpm_extend_particle_array( number_of_initial_particles ) 93 ENDIF 94 ENDIF 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 95 116 96 !97 !-- Check, if tail storage must be extended98 IF ( use_particle_tails ) THEN99 IF ( number_of_tails + number_of_initial_tails > &100 maximum_number_of_tails ) THEN101 IF ( netcdf_data_format < 3 ) THEN102 message_string = 'maximum_number_of_tails needs to be increas' // &103 'ed &but this is not allowed with netcdf_dat' // &104 'a_format < 3'105 CALL message( 'lpm_release_set', 'PA0147', 2, 2, -1, 6, 1 )106 ELSE107 CALL lpm_extend_tail_array( number_of_initial_tails )108 ENDIF109 ENDIF110 ENDIF111 112 IF ( number_of_initial_particles /= 0 ) THEN113 114 is = number_of_particles + 1115 ie = number_of_particles + number_of_initial_particles116 particles(is:ie) = initial_particles(1:number_of_initial_particles)117 !118 !-- Add random fluctuation to particle positions. Particles should119 !-- remain in the subdomain.120 IF ( random_start_position ) THEN121 122 DO n = is, ie123 124 IF ( psl(particles(n)%group) /= psr(particles(n)%group) ) THEN125 particles(n)%x = particles(n)%x + &126 ( random_function( iran_part ) - 0.5 ) * &127 pdx(particles(n)%group)128 IF ( particles(n)%x <= ( nxl - 0.5 ) * dx ) THEN129 particles(n)%x = ( nxl - 0.4999999999 ) * dx130 ELSEIF ( particles(n)%x >= ( nxr + 0.5 ) * dx ) THEN131 particles(n)%x = ( nxr + 0.4999999999 ) * dx132 ENDIF133 ENDIF134 135 IF ( pss(particles(n)%group) /= psn(particles(n)%group) ) THEN136 particles(n)%y = particles(n)%y + &137 ( random_function( iran_part ) - 0.5 ) * &138 pdy(particles(n)%group)139 IF ( particles(n)%y <= ( nys - 0.5 ) * dy ) THEN140 particles(n)%y = ( nys - 0.4999999999 ) * dy141 ELSEIF ( particles(n)%y >= ( nyn + 0.5 ) * dy ) THEN142 particles(n)%y = ( nyn + 0.4999999999 ) * dy143 ENDIF144 ENDIF145 146 IF ( psb(particles(n)%group) /= pst(particles(n)%group) ) THEN147 particles(n)%z = particles(n)%z + &148 ( random_function( iran_part ) - 0.5 ) * &149 pdz(particles(n)%group)150 ENDIF151 152 ENDDO153 154 ENDIF155 156 !157 !-- Set the beginning of the new particle tails and their age158 IF ( use_particle_tails ) THEN159 160 DO n = is, ie161 !162 !-- New particles which should have a tail, already have got a163 !-- provisional tail id unequal zero (see lpm_init)164 IF ( particles(n)%tail_id /= 0 ) THEN165 166 number_of_tails = number_of_tails + 1167 nn = number_of_tails168 particles(n)%tail_id = nn ! set the final tail id169 particle_tail_coordinates(1,1,nn) = particles(n)%x170 particle_tail_coordinates(1,2,nn) = particles(n)%y171 particle_tail_coordinates(1,3,nn) = particles(n)%z172 particle_tail_coordinates(1,4,nn) = particles(n)%class173 particles(n)%tailpoints = 1174 175 IF ( minimum_tailpoint_distance /= 0.0 ) THEN176 particle_tail_coordinates(2,1,nn) = particles(n)%x177 particle_tail_coordinates(2,2,nn) = particles(n)%y178 particle_tail_coordinates(2,3,nn) = particles(n)%z179 particle_tail_coordinates(2,4,nn) = particles(n)%class180 particle_tail_coordinates(1:2,5,nn) = 0.0181 particles(n)%tailpoints = 2182 ENDIF183 184 ENDIF185 186 ENDDO187 188 ENDIF189 190 number_of_particles = number_of_particles + number_of_initial_particles191 192 ENDIF193 117 194 118 END SUBROUTINE lpm_release_set
Note: See TracChangeset
for help on using the changeset viewer.
