Home

Context Navigation

source: palm/trunk/SOURCE/init_particles.f90 @ 825

Last change on this file since 825 was 824, checked in by raasch, 12 years ago
preliminary checkin of new curvature/solution effects on droplet growth
Property svn:keywords set to `Id`
File size: 23.5 KB

Line
1	SUBROUTINE init_particles
2
3	!------------------------------------------------------------------------------!
4	! Current revisions:
5	! -----------------
6	! particle attributes speed_x\|y\|z_sgs renamed rvar1\|2\|3.
7	! array particles implemented as pointer.
8	!
9	! Former revisions:
10	! -----------------
11	! $Id: init_particles.f90 824 2012-02-17 09:09:57Z raasch $
12	!
13	! 667 2010-12-23 12:06:00Z suehring/gryschka
14	! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng for allocation
15	! of arrays.
16	!
17	! 622 2010-12-10 08:08:13Z raasch
18	! optional barriers included in order to speed up collective operations
19	!
20	! 336 2009-06-10 11:19:35Z raasch
21	! Maximum number of tails is calculated from maximum number of particles and
22	! skip_particles_for_tail,
23	! output of messages replaced by message handling routine
24	! Bugfix: arrays for tails are allocated with a minimum size of 10 tails if
25	! there is no tail initially
26	!
27	! 150 2008-02-29 08:19:58Z raasch
28	! Setting offset_ocean_* needed for calculating vertical indices within ocean
29	! runs
30	!
31	! 117 2007-10-11 03:27:59Z raasch
32	! Sorting of particles only in case of cloud droplets
33	!
34	! 106 2007-08-16 14:30:26Z raasch
35	! variable iran replaced by iran_part
36	!
37	! 82 2007-04-16 15:40:52Z raasch
38	! Preprocessor directives for old systems removed
39	!
40	! 70 2007-03-18 23:46:30Z raasch
41	! displacements for mpi_particle_type changed, age_m initialized,
42	! particles-package is now part of the default code
43	!
44	! 16 2007-02-15 13:16:47Z raasch
45	! Bugfix: MPI_REAL in MPI_ALLREDUCE replaced by MPI_INTEGER
46	!
47	! r4 \| raasch \| 2007-02-13 12:33:16 +0100 (Tue, 13 Feb 2007)
48	! RCS Log replace by Id keyword, revision history cleaned up
49	!
50	! Revision 1.24 2007/02/11 13:00:17 raasch
51	! Bugfix: allocation of tail_mask and new_tail_id in case of restart-runs
52	! Bugfix: __ was missing in a cpp-directive
53	!
54	! Revision 1.1 1999/11/25 16:22:38 raasch
55	! Initial revision
56	!
57	!
58	! Description:
59	! ------------
60	! This routine initializes a set of particles and their attributes (position,
61	! radius, ..). Advection of these particles is carried out by advec_particles,
62	! plotting is done in data_output_dvrp.
63	!------------------------------------------------------------------------------!
64
65	USE arrays_3d
66	USE cloud_parameters
67	USE control_parameters
68	USE dvrp_variables
69	USE grid_variables
70	USE indices
71	USE particle_attributes
72	USE pegrid
73	USE random_function_mod
74
75
76	IMPLICIT NONE
77
78	CHARACTER (LEN=10) :: particle_binary_version, version_on_file
79
80	INTEGER :: i, j, n, nn
81	#if defined( __parallel )
82	INTEGER, DIMENSION(3) :: blocklengths, displacements, types
83	#endif
84	LOGICAL :: uniform_particles_l
85	REAL :: factor, pos_x, pos_y, pos_z, value
86
87
88	#if defined( __parallel )
89	!
90	!-- Define MPI derived datatype for FORTRAN datatype particle_type (see module
91	!-- particle_attributes). Integer length is 4 byte, Real is 8 byte
92	blocklengths(1) = 19; blocklengths(2) = 4; blocklengths(3) = 1
93	displacements(1) = 0; displacements(2) = 152; displacements(3) = 168
94
95	types(1) = MPI_REAL
96	types(2) = MPI_INTEGER
97	types(3) = MPI_UB
98	CALL MPI_TYPE_STRUCT( 3, blocklengths, displacements, types, &
99	mpi_particle_type, ierr )
100	CALL MPI_TYPE_COMMIT( mpi_particle_type, ierr )
101	#endif
102
103	!
104	!-- In case of oceans runs, the vertical index calculations need an offset,
105	!-- because otherwise the k indices will become negative
106	IF ( ocean ) THEN
107	offset_ocean_nzt = nzt
108	offset_ocean_nzt_m1 = nzt - 1
109	ENDIF
110
111
112	!
113	!-- Check the number of particle groups.
114	IF ( number_of_particle_groups > max_number_of_particle_groups ) THEN
115	WRITE( message_string, * ) 'max_number_of_particle_groups =', &
116	max_number_of_particle_groups , &
117	'&number_of_particle_groups reset to ', &
118	max_number_of_particle_groups
119	CALL message( 'init_particles', 'PA0213', 0, 1, 0, 6, 0 )
120	number_of_particle_groups = max_number_of_particle_groups
121	ENDIF
122
123	!
124	!-- Set default start positions, if necessary
125	IF ( psl(1) == 9999999.9 ) psl(1) = -0.5 * dx
126	IF ( psr(1) == 9999999.9 ) psr(1) = ( nx + 0.5 ) * dx
127	IF ( pss(1) == 9999999.9 ) pss(1) = -0.5 * dy
128	IF ( psn(1) == 9999999.9 ) psn(1) = ( ny + 0.5 ) * dy
129	IF ( psb(1) == 9999999.9 ) psb(1) = zu(nz/2)
130	IF ( pst(1) == 9999999.9 ) pst(1) = psb(1)
131
132	IF ( pdx(1) == 9999999.9 .OR. pdx(1) == 0.0 ) pdx(1) = dx
133	IF ( pdy(1) == 9999999.9 .OR. pdy(1) == 0.0 ) pdy(1) = dy
134	IF ( pdz(1) == 9999999.9 .OR. pdz(1) == 0.0 ) pdz(1) = zu(2) - zu(1)
135
136	DO j = 2, number_of_particle_groups
137	IF ( psl(j) == 9999999.9 ) psl(j) = psl(j-1)
138	IF ( psr(j) == 9999999.9 ) psr(j) = psr(j-1)
139	IF ( pss(j) == 9999999.9 ) pss(j) = pss(j-1)
140	IF ( psn(j) == 9999999.9 ) psn(j) = psn(j-1)
141	IF ( psb(j) == 9999999.9 ) psb(j) = psb(j-1)
142	IF ( pst(j) == 9999999.9 ) pst(j) = pst(j-1)
143	IF ( pdx(j) == 9999999.9 .OR. pdx(j) == 0.0 ) pdx(j) = pdx(j-1)
144	IF ( pdy(j) == 9999999.9 .OR. pdy(j) == 0.0 ) pdy(j) = pdy(j-1)
145	IF ( pdz(j) == 9999999.9 .OR. pdz(j) == 0.0 ) pdz(j) = pdz(j-1)
146	ENDDO
147
148	!
149	!-- For the first model run of a possible job chain initialize the
150	!-- particles, otherwise read the particle data from file.
151	IF ( TRIM( initializing_actions ) == 'read_restart_data' &
152	.AND. read_particles_from_restartfile ) THEN
153
154	!
155	!-- Read particle data from previous model run.
156	!-- First open the input unit.
157	IF ( myid_char == '' ) THEN
158	OPEN ( 90, FILE='PARTICLE_RESTART_DATA_IN'//myid_char, &
159	FORM='UNFORMATTED' )
160	ELSE
161	OPEN ( 90, FILE='PARTICLE_RESTART_DATA_IN/'//myid_char, &
162	FORM='UNFORMATTED' )
163	ENDIF
164
165	!
166	!-- First compare the version numbers
167	READ ( 90 ) version_on_file
168	particle_binary_version = '3.0'
169	IF ( TRIM( version_on_file ) /= TRIM( particle_binary_version ) ) THEN
170	message_string = 'version mismatch concerning data from prior ' // &
171	'run &version on file = "' // &
172	TRIM( version_on_file ) // &
173	'&version in program = "' // &
174	TRIM( particle_binary_version ) // '"'
175	CALL message( 'init_particles', 'PA0214', 1, 2, 0, 6, 0 )
176	ENDIF
177
178	!
179	!-- Read some particle parameters and the size of the particle arrays,
180	!-- allocate them and read their contents.
181	READ ( 90 ) bc_par_b, bc_par_lr, bc_par_ns, bc_par_t, &
182	maximum_number_of_particles, maximum_number_of_tailpoints, &
183	maximum_number_of_tails, number_of_initial_particles, &
184	number_of_particles, number_of_particle_groups, &
185	number_of_tails, particle_groups, time_prel, &
186	time_write_particle_data, uniform_particles
187
188	IF ( number_of_initial_particles /= 0 ) THEN
189	ALLOCATE( initial_particles(1:number_of_initial_particles) )
190	READ ( 90 ) initial_particles
191	ENDIF
192
193	ALLOCATE( prt_count(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
194	prt_start_index(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
195	particle_mask(maximum_number_of_particles), &
196	part_1(maximum_number_of_particles), &
197	part_2(maximum_number_of_particles) )
198
199	part_1 = particle_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
200	0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
201	0.0, 0, 0, 0, 0 )
202
203	part_2 = particle_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
204	0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
205	0.0, 0, 0, 0, 0 )
206
207	sort_count = 0
208
209	particles => part_1
210
211	READ ( 90 ) prt_count, prt_start_index
212	READ ( 90 ) particles
213
214	IF ( use_particle_tails ) THEN
215	ALLOCATE( particle_tail_coordinates(maximum_number_of_tailpoints,5, &
216	maximum_number_of_tails), &
217	new_tail_id(maximum_number_of_tails), &
218	tail_mask(maximum_number_of_tails) )
219	READ ( 90 ) particle_tail_coordinates
220	ENDIF
221
222	CLOSE ( 90 )
223
224	ELSE
225
226	!
227	!-- Allocate particle arrays and set attributes of the initial set of
228	!-- particles, which can be also periodically released at later times.
229	!-- Also allocate array for particle tail coordinates, if needed.
230	ALLOCATE( prt_count(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
231	prt_start_index(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &
232	particle_mask(maximum_number_of_particles), &
233	part_1(maximum_number_of_particles), &
234	part_2(maximum_number_of_particles) )
235
236	particles => part_1
237
238	sort_count = 0
239
240	!
241	!-- Initialize all particles with dummy values (otherwise errors may
242	!-- occur within restart runs). The reason for this is still not clear
243	!-- and may be presumably caused by errors in the respective user-interface.
244	particles = particle_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
245	0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
246	0.0, 0, 0, 0, 0 )
247	particle_groups = particle_groups_type( 0.0, 0.0, 0.0, 0.0 )
248
249	!
250	!-- Set the default particle size used for dvrp plots
251	IF ( dvrp_psize == 9999999.9 ) dvrp_psize = 0.2 * dx
252
253	!
254	!-- Set values for the density ratio and radius for all particle
255	!-- groups, if necessary
256	IF ( density_ratio(1) == 9999999.9 ) density_ratio(1) = 0.0
257	IF ( radius(1) == 9999999.9 ) radius(1) = 0.0
258	DO i = 2, number_of_particle_groups
259	IF ( density_ratio(i) == 9999999.9 ) THEN
260	density_ratio(i) = density_ratio(i-1)
261	ENDIF
262	IF ( radius(i) == 9999999.9 ) radius(i) = radius(i-1)
263	ENDDO
264
265	DO i = 1, number_of_particle_groups
266	IF ( density_ratio(i) /= 0.0 .AND. radius(i) == 0 ) THEN
267	WRITE( message_string, * ) 'particle group #', i, 'has a', &
268	'density ratio /= 0 but radius = 0'
269	CALL message( 'init_particles', 'PA0215', 1, 2, 0, 6, 0 )
270	ENDIF
271	particle_groups(i)%density_ratio = density_ratio(i)
272	particle_groups(i)%radius = radius(i)
273	ENDDO
274
275	!
276	!-- Calculate particle positions and store particle attributes, if
277	!-- particle is situated on this PE
278	n = 0
279
280	DO i = 1, number_of_particle_groups
281
282	pos_z = psb(i)
283
284	DO WHILE ( pos_z <= pst(i) )
285
286	pos_y = pss(i)
287
288	DO WHILE ( pos_y <= psn(i) )
289
290	IF ( pos_y >= ( nys - 0.5 ) * dy .AND. &
291	pos_y < ( nyn + 0.5 ) * dy ) THEN
292
293	pos_x = psl(i)
294
295	DO WHILE ( pos_x <= psr(i) )
296
297	IF ( pos_x >= ( nxl - 0.5 ) * dx .AND. &
298	pos_x < ( nxr + 0.5 ) * dx ) THEN
299
300	DO j = 1, particles_per_point
301
302	n = n + 1
303	IF ( n > maximum_number_of_particles ) THEN
304	WRITE( message_string, * ) 'number of initial', &
305	'particles (', n, ') exceeds', &
306	'&maximum_number_of_particles (', &
307	maximum_number_of_particles, ') on PE ', &
308	myid
309	CALL message( 'init_particles', 'PA0216', &
310	2, 2, -1, 6, 1 )
311	ENDIF
312	particles(n)%x = pos_x
313	particles(n)%y = pos_y
314	particles(n)%z = pos_z
315	particles(n)%age = 0.0
316	particles(n)%age_m = 0.0
317	particles(n)%dt_sum = 0.0
318	particles(n)%dvrp_psize = dvrp_psize
319	particles(n)%e_m = 0.0
320	IF ( curvature_solution_effects ) THEN
321	!
322	!-- Initial values (internal timesteps, derivative)
323	!-- for Rosenbrock method
324	particles(n)%rvar1 = 1.0E-12
325	particles(n)%rvar2 = 1.0E-3
326	particles(n)%rvar3 = -9999999.9
327	ELSE
328	!
329	!-- Initial values for SGS velocities
330	particles(n)%rvar1 = 0.0
331	particles(n)%rvar2 = 0.0
332	particles(n)%rvar3 = 0.0
333	ENDIF
334	particles(n)%speed_x = 0.0
335	particles(n)%speed_y = 0.0
336	particles(n)%speed_z = 0.0
337	particles(n)%origin_x = pos_x
338	particles(n)%origin_y = pos_y
339	particles(n)%origin_z = pos_z
340	particles(n)%radius = particle_groups(i)%radius
341	particles(n)%weight_factor =initial_weighting_factor
342	particles(n)%color = 1
343	particles(n)%group = i
344	particles(n)%tailpoints = 0
345	IF ( use_particle_tails .AND. &
346	MOD( n, skip_particles_for_tail ) == 0 ) THEN
347	number_of_tails = number_of_tails + 1
348	!
349	!-- This is a temporary provisional setting (see
350	!-- further below!)
351	particles(n)%tail_id = number_of_tails
352	ELSE
353	particles(n)%tail_id = 0
354	ENDIF
355
356	ENDDO
357
358	ENDIF
359
360	pos_x = pos_x + pdx(i)
361
362	ENDDO
363
364	ENDIF
365
366	pos_y = pos_y + pdy(i)
367
368	ENDDO
369
370	pos_z = pos_z + pdz(i)
371
372	ENDDO
373
374	ENDDO
375
376	number_of_initial_particles = n
377	number_of_particles = n
378
379	!
380	!-- Calculate the number of particles and tails of the total domain
381	#if defined( __parallel )
382	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
383	CALL MPI_ALLREDUCE( number_of_particles, total_number_of_particles, 1, &
384	MPI_INTEGER, MPI_SUM, comm2d, ierr )
385	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
386	CALL MPI_ALLREDUCE( number_of_tails, total_number_of_tails, 1, &
387	MPI_INTEGER, MPI_SUM, comm2d, ierr )
388	#else
389	total_number_of_particles = number_of_particles
390	total_number_of_tails = number_of_tails
391	#endif
392
393	!
394	!-- Set a seed value for the random number generator to be exclusively
395	!-- used for the particle code. The generated random numbers should be
396	!-- different on the different PEs.
397	iran_part = iran_part + myid
398
399	!
400	!-- User modification of initial particles
401	CALL user_init_particles
402
403	!
404	!-- Store the initial set of particles for release at later times
405	IF ( number_of_initial_particles /= 0 ) THEN
406	ALLOCATE( initial_particles(1:number_of_initial_particles) )
407	initial_particles(1:number_of_initial_particles) = &
408	particles(1:number_of_initial_particles)
409	ENDIF
410
411	!
412	!-- Add random fluctuation to particle positions
413	IF ( random_start_position ) THEN
414
415	DO n = 1, number_of_initial_particles
416	IF ( psl(particles(n)%group) /= psr(particles(n)%group) ) THEN
417	particles(n)%x = particles(n)%x + &
418	( random_function( iran_part ) - 0.5 ) * &
419	pdx(particles(n)%group)
420	IF ( particles(n)%x <= ( nxl - 0.5 ) * dx ) THEN
421	particles(n)%x = ( nxl - 0.4999999999 ) * dx
422	ELSEIF ( particles(n)%x >= ( nxr + 0.5 ) * dx ) THEN
423	particles(n)%x = ( nxr + 0.4999999999 ) * dx
424	ENDIF
425	ENDIF
426	IF ( pss(particles(n)%group) /= psn(particles(n)%group) ) THEN
427	particles(n)%y = particles(n)%y + &
428	( random_function( iran_part ) - 0.5 ) * &
429	pdy(particles(n)%group)
430	IF ( particles(n)%y <= ( nys - 0.5 ) * dy ) THEN
431	particles(n)%y = ( nys - 0.4999999999 ) * dy
432	ELSEIF ( particles(n)%y >= ( nyn + 0.5 ) * dy ) THEN
433	particles(n)%y = ( nyn + 0.4999999999 ) * dy
434	ENDIF
435	ENDIF
436	IF ( psb(particles(n)%group) /= pst(particles(n)%group) ) THEN
437	particles(n)%z = particles(n)%z + &
438	( random_function( iran_part ) - 0.5 ) * &
439	pdz(particles(n)%group)
440	ENDIF
441	ENDDO
442	ENDIF
443
444	!
445	!-- Sort particles in the sequence the gridboxes are stored in the memory.
446	!-- Only required if cloud droplets are used.
447	IF ( cloud_droplets ) CALL sort_particles
448
449	!
450	!-- Open file for statistical informations about particle conditions
451	IF ( write_particle_statistics ) THEN
452	CALL check_open( 80 )
453	WRITE ( 80, 8000 ) current_timestep_number, simulated_time, &
454	number_of_initial_particles, &
455	maximum_number_of_particles
456	CALL close_file( 80 )
457	ENDIF
458
459	!
460	!-- Check if particles are really uniform in color and radius (dvrp_size)
461	!-- (uniform_particles is preset TRUE)
462	IF ( uniform_particles ) THEN
463	IF ( number_of_initial_particles == 0 ) THEN
464	uniform_particles_l = .TRUE.
465	ELSE
466	n = number_of_initial_particles
467	IF ( MINVAL( particles(1:n)%dvrp_psize ) == &
468	MAXVAL( particles(1:n)%dvrp_psize ) .AND. &
469	MINVAL( particles(1:n)%color ) == &
470	MAXVAL( particles(1:n)%color ) ) THEN
471	uniform_particles_l = .TRUE.
472	ELSE
473	uniform_particles_l = .FALSE.
474	ENDIF
475	ENDIF
476
477	#if defined( __parallel )
478	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
479	CALL MPI_ALLREDUCE( uniform_particles_l, uniform_particles, 1, &
480	MPI_LOGICAL, MPI_LAND, comm2d, ierr )
481	#else
482	uniform_particles = uniform_particles_l
483	#endif
484
485	ENDIF
486
487	!
488	!-- Particles will probably become none-uniform, if their size and color
489	!-- will be determined by flow variables
490	IF ( particle_color /= 'none' .OR. particle_dvrpsize /= 'none' ) THEN
491	uniform_particles = .FALSE.
492	ENDIF
493
494	!
495	!-- Set the beginning of the particle tails and their age
496	IF ( use_particle_tails ) THEN
497	!
498	!-- Choose the maximum number of tails with respect to the maximum number
499	!-- of particles and skip_particles_for_tail
500	maximum_number_of_tails = maximum_number_of_particles / &
501	skip_particles_for_tail
502
503	!
504	!-- Create a minimum number of tails in case that there is no tail
505	!-- initially (otherwise, index errors will occur when adressing the
506	!-- arrays below)
507	IF ( maximum_number_of_tails == 0 ) maximum_number_of_tails = 10
508
509	ALLOCATE( particle_tail_coordinates(maximum_number_of_tailpoints,5, &
510	maximum_number_of_tails), &
511	new_tail_id(maximum_number_of_tails), &
512	tail_mask(maximum_number_of_tails) )
513
514	particle_tail_coordinates = 0.0
515	minimum_tailpoint_distance = minimum_tailpoint_distance**2
516	number_of_initial_tails = number_of_tails
517
518	nn = 0
519	DO n = 1, number_of_particles
520	!
521	!-- Only for those particles marked above with a provisional tail_id
522	!-- tails will be created. Particles now get their final tail_id.
523	IF ( particles(n)%tail_id /= 0 ) THEN
524
525	nn = nn + 1
526	particles(n)%tail_id = nn
527
528	particle_tail_coordinates(1,1,nn) = particles(n)%x
529	particle_tail_coordinates(1,2,nn) = particles(n)%y
530	particle_tail_coordinates(1,3,nn) = particles(n)%z
531	particle_tail_coordinates(1,4,nn) = particles(n)%color
532	particles(n)%tailpoints = 1
533	IF ( minimum_tailpoint_distance /= 0.0 ) THEN
534	particle_tail_coordinates(2,1,nn) = particles(n)%x
535	particle_tail_coordinates(2,2,nn) = particles(n)%y
536	particle_tail_coordinates(2,3,nn) = particles(n)%z
537	particle_tail_coordinates(2,4,nn) = particles(n)%color
538	particle_tail_coordinates(1:2,5,nn) = 0.0
539	particles(n)%tailpoints = 2
540	ENDIF
541
542	ENDIF
543	ENDDO
544	ENDIF
545
546	!
547	!-- Plot initial positions of particles (only if particle advection is
548	!-- switched on from the beginning of the simulation (t=0))
549	IF ( particle_advection_start == 0.0 ) CALL data_output_dvrp
550
551	ENDIF
552
553	!
554	!-- Check boundary condition and set internal variables
555	SELECT CASE ( bc_par_b )
556
557	CASE ( 'absorb' )
558	ibc_par_b = 1
559
560	CASE ( 'reflect' )
561	ibc_par_b = 2
562
563	CASE DEFAULT
564	WRITE( message_string, * ) 'unknown boundary condition ', &
565	'bc_par_b = "', TRIM( bc_par_b ), '"'
566	CALL message( 'init_particles', 'PA0217', 1, 2, 0, 6, 0 )
567
568	END SELECT
569	SELECT CASE ( bc_par_t )
570
571	CASE ( 'absorb' )
572	ibc_par_t = 1
573
574	CASE ( 'reflect' )
575	ibc_par_t = 2
576
577	CASE DEFAULT
578	WRITE( message_string, * ) 'unknown boundary condition ', &
579	'bc_par_t = "', TRIM( bc_par_t ), '"'
580	CALL message( 'init_particles', 'PA0218', 1, 2, 0, 6, 0 )
581
582	END SELECT
583	SELECT CASE ( bc_par_lr )
584
585	CASE ( 'cyclic' )
586	ibc_par_lr = 0
587
588	CASE ( 'absorb' )
589	ibc_par_lr = 1
590
591	CASE ( 'reflect' )
592	ibc_par_lr = 2
593
594	CASE DEFAULT
595	WRITE( message_string, * ) 'unknown boundary condition ', &
596	'bc_par_lr = "', TRIM( bc_par_lr ), '"'
597	CALL message( 'init_particles', 'PA0219', 1, 2, 0, 6, 0 )
598
599	END SELECT
600	SELECT CASE ( bc_par_ns )
601
602	CASE ( 'cyclic' )
603	ibc_par_ns = 0
604
605	CASE ( 'absorb' )
606	ibc_par_ns = 1
607
608	CASE ( 'reflect' )
609	ibc_par_ns = 2
610
611	CASE DEFAULT
612	WRITE( message_string, * ) 'unknown boundary condition ', &
613	'bc_par_ns = "', TRIM( bc_par_ns ), '"'
614	CALL message( 'init_particles', 'PA0220', 1, 2, 0, 6, 0 )
615
616	END SELECT
617	!
618	!-- Formats
619	8000 FORMAT (I6,1X,F7.2,4X,I6,71X,I6)
620
621	END SUBROUTINE init_particles

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |