Home

Context Navigation

source: palm/trunk/SOURCE/pmc_particle_interface.f90 @ 2808

Last change on this file since 2808 was 2808, checked in by thiele, 6 years ago
Bugfixes gfortran C_SIZEOF(zero_particle)
Property svn:keywords set to `Id`
File size: 44.3 KB

Line
1	MODULE pmc_particle_interface
2
3	!------------------------------------------------------------------------------!
4	! This file is part of PALM.
5	!
6	! PALM is free software: you can redistribute it and/or modify it under the
7	! terms of the GNU General Public License as published by the Free Software
8	! Foundation, either version 3 of the License, or (at your option) any later
9	! version.
10	!
11	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
12	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
13	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
14	!
15	! You should have received a copy of the GNU General Public License along with
16	! PALM. If not, see <http://www.gnu.org/licenses/>.
17	!
18	! Copyright 1997-2018 Leibniz Universitaet Hannover
19	!------------------------------------------------------------------------------!
20	!
21	! Current revisions:
22	! ------------------
23	!
24	!
25	! Former revisions:
26	! -----------------
27	!
28	! Bugfixes gfortran C_SIZEOF(zero_particle)
29	!
30	!
31	!
32	!
33	! Initial Version (by Klaus Ketelsen)
34	!
35	!
36	! Description:
37	! ------------
38	! Introduce particle transfer in nested models.
39	! Interface to palm lpm model to handel particle transfer between parent and
40	! child model.
41	!------------------------------------------------------------------------------!
42
43	USE, INTRINSIC :: ISO_C_BINDING
44	USE MPI
45
46	USE kinds
47
48	USE pegrid, &
49	ONLY: myidx,myidy
50
51	USE indices, &
52	ONLY: nx, ny, nxl, nxr, nys, nyn, nzb, nzt, nxlg, nxrg, nysg, nyng, nbgp
53
54	USE grid_variables, &
55	ONLY: dx, dy
56
57	USE arrays_3d, &
58	ONLY: zw
59
60	USE control_parameters, &
61	ONLY: message_string
62
63	USE particle_attributes, &
64	ONLY: prt_count, particles, grid_particles, &
65	particle_type, number_of_particles, zero_particle, &
66	ibc_par_t, ibc_par_lr, ibc_par_ns, alloc_factor
67
68	USE lpm_pack_and_sort_mod
69
70	USE pmc_general, &
71	ONLY: pedef
72
73	USE pmc_parent, &
74	ONLY: children, pmc_s_fillbuffer, pmc_s_getdata_from_buffer, &
75	pmc_s_get_child_npes
76
77	USE pmc_child, &
78	ONLY: me, pmc_c_getbuffer, pmc_c_putbuffer
79
80	USE pmc_interface, &
81	ONLY: cpl_id, get_number_of_childs, nr_part, part_adr, nested_run, &
82	get_childid, get_child_edges, nr_partc, part_adrc, &
83	coarse_bound, coord_x, coord_y, cg, get_child_gridspacing, &
84	lower_left_coord_x, lower_left_coord_y
85
86	USE pmc_handle_communicator, &
87	ONLY: pmc_parent_for_child
88
89	USE pmc_mpi_wrapper, &
90	ONLY: pmc_send_to_parent, pmc_recv_from_child
91
92	USE lpm_exchange_horiz_mod, &
93	ONLY: realloc_particles_array
94
95	IMPLICIT NONE
96	PRIVATE
97	SAVE
98
99	TYPE coarse_particle_def
100	INTEGER(iwp) :: nr_particle
101
102	TYPE(particle_type),ALLOCATABLE,DIMENSION(:) :: parent_particles
103	END TYPE coarse_particle_def
104
105	INTEGER(iwp),PARAMETER :: Min_particles_per_column = 100 !<
106	INTEGER(iwp),PARAMETER :: max_nr_particle_in_rma_win = 100000 !<
107
108	INTEGER(iwp) :: nr_fine_in_coarse !< Number of fine grid cells in coarse grid (one direction)
109	INTEGER(iwp) :: particle_win_child !<
110
111	INTEGER(iwp),ALLOCATABLE,DIMENSION(:) :: particle_win_parent !<
112
113	TYPE(C_PTR), ALLOCATABLE,DIMENSION(:) :: buf_ptr !<
114
115	TYPE(particle_type), DIMENSION(:),POINTER :: particle_in_win !<
116
117	TYPE(coarse_particle_def),ALLOCATABLE,DIMENSION(:,:) :: coarse_particles !<
118
119
120
121	INTERFACE pmcp_g_init
122	MODULE PROCEDURE pmcp_g_init
123	END INTERFACE pmcp_g_init
124
125	INTERFACE pmcp_g_alloc_win
126	MODULE PROCEDURE pmcp_g_alloc_win
127	END INTERFACE pmcp_g_alloc_win
128
129	INTERFACE pmcp_c_get_particle_from_parent
130	MODULE PROCEDURE pmcp_c_get_particle_from_parent
131	END INTERFACE pmcp_c_get_particle_from_parent
132
133	INTERFACE pmcp_c_send_particle_to_parent
134	MODULE PROCEDURE pmcp_c_send_particle_to_parent
135	END INTERFACE pmcp_c_send_particle_to_parent
136
137	INTERFACE pmcp_p_fill_particle_win
138	MODULE PROCEDURE pmcp_p_fill_particle_win
139	END INTERFACE pmcp_p_fill_particle_win
140
141	INTERFACE pmcp_p_empty_particle_win
142	MODULE PROCEDURE pmcp_p_empty_particle_win
143	END INTERFACE pmcp_p_empty_particle_win
144
145	INTERFACE pmcp_g_print_number_of_particles
146	MODULE PROCEDURE pmcp_g_print_number_of_particles
147	END INTERFACE pmcp_g_print_number_of_particles
148
149	INTERFACE pmcp_p_delete_particles_in_fine_grid_area
150	MODULE PROCEDURE pmcp_p_delete_particles_in_fine_grid_area
151	END INTERFACE pmcp_p_delete_particles_in_fine_grid_area
152
153	PUBLIC pmcp_g_init, pmcp_g_alloc_win, pmcp_c_get_particle_from_parent
154	PUBLIC pmcp_c_send_particle_to_parent, pmcp_p_fill_particle_win, pmcp_g_print_number_of_particles
155	PUBLIC pmcp_p_empty_particle_win, pmcp_p_delete_particles_in_fine_grid_area
156
157	CONTAINS
158
159	!------------------------------------------------------------------------------!
160	! Description:
161	! ------------
162	!> general routine:
163	!> Initializing actions of the particle interface
164	!> check particle boundary conditions for the child models
165	!------------------------------------------------------------------------------!
166	SUBROUTINE pmcp_g_init
167
168	IMPLICIT NONE
169
170	INTEGER(iwp) :: nr_childs !< Number of child models of the current model
171
172	nr_childs = get_number_of_childs()
173	!
174	!-- Check if the current model has child models
175	IF ( nr_childs > 0 ) THEN
176	ALLOCATE( nr_part(nysg:nyng, nxlg:nxrg) )
177	ALLOCATE( part_adr(nysg:nyng, nxlg:nxrg) )
178	nr_part = 0
179	part_adr = 0
180	ENDIF
181
182	!
183	!-- Set the boundary conditions to nested for all non root (i.e child) models
184	IF ( cpl_id > 1 ) THEN
185
186	IF ( ibc_par_t /= 3 ) THEN
187	ibc_par_t = 3
188	message_string = 'In Child model: bc_par_t is automatically set to nested '
189	CALL message( 'pmcp_g_init ', 'PA0477', 0, 1, 0, 6, 0 ) ! PA number has to be adjusted
190	ENDIF
191
192	IF ( ibc_par_lr /= 3 ) THEN
193	ibc_par_lr = 3
194	message_string = 'In Child model: bc_par_lr is automatically set to nested '
195	CALL message( 'pmcp_g_init ', 'PA0478', 0, 1, 0, 6, 0 ) ! PA number has to be adjusted
196	ENDIF
197
198	IF ( ibc_par_ns /= 3 ) THEN
199	ibc_par_ns = 3
200	message_string = 'In Child model: bc_par_ns is automatically set to nested '
201	CALL message( 'pmcp_g_init ', 'PA0479', 0, 1, 0, 6, 0 ) ! PA number has to be adjusted
202	ENDIF
203
204	ENDIF
205
206	END SUBROUTINE pmcp_g_init
207	!------------------------------------------------------------------------------!
208	! Description:
209	! ------------
210	!> general routine:
211	!> allocate the MPI windows
212	!------------------------------------------------------------------------------!
213	SUBROUTINE pmcp_g_alloc_win
214
215	IMPLICIT NONE
216
217	INTEGER(iwp) :: m !< loop index
218	INTEGER(iwp) :: ierr !< error code
219	INTEGER(iwp) :: icl !< left boundary in coarse(parent) index space
220	INTEGER(iwp) :: icr !< right boundary in coarse(parent) index space
221	INTEGER(iwp) :: jcs !< south boundary in coarse(parent) index space
222	INTEGER(iwp) :: jcn !< north boundary in coarse(parent) index space
223	INTEGER(iwp) :: child_id !< Id of a child model
224	INTEGER(iwp) :: nr_childs !< Number of child models of the current model
225
226	INTEGER(KIND=MPI_ADDRESS_KIND) :: parsize !<
227	INTEGER(KIND=MPI_ADDRESS_KIND) :: winsize !<
228	TYPE(C_PTR), SAVE :: ptr !<
229
230	TYPE(particle_type),DIMENSION(:),POINTER :: win_buffer !<
231
232	INTEGER(iwp),DIMENSION(1) :: buf_shape !<
233
234	!
235	!-- If the model has a parent model prepare the structures for transfer
236	IF ( cpl_id > 1 ) THEN
237	#if defined( __gfortran )
238	!
239	!-- For the gfortran compiler the function c_sizeof produces strange erros
240	!-- which can probably be attributed to an error in the gfortran compiler.
241	!-- Therefore the particle size in bytes is set manually. Attention: A
242	!-- change of the size of the particle type requires an adjustment of
243	!-- this value
244	parsize = 184
245	#else
246	parsize = C_SIZEOF (zero_particle)
247	#endif
248	CALL MPI_ALLOC_MEM( parsize , MPI_INFO_NULL, ptr, ierr )
249	buf_shape(1) = 1
250	CALL C_F_POINTER( ptr, win_buffer, buf_shape )
251	CALL MPI_WIN_CREATE( win_buffer, parsize, parsize, &
252	MPI_INFO_NULL, me%intra_comm, particle_win_child, &
253	ierr )
254
255	!
256	!-- Child domain boundaries in the parent index space
257	icl = coarse_bound(1)
258	icr = coarse_bound(2)
259	jcs = coarse_bound(3)
260	jcn = coarse_bound(4)
261
262	! ALLOCATE( coarse_particles(jcs:jcn, icl:icr) )
263
264	coarse_particles(:,:)%nr_particle = 0
265	ENDIF
266
267	!
268	!-- If the model has child models prepare the structures for transfer
269	nr_childs = get_number_of_childs()
270	IF ( nr_childs > 0 ) THEN
271	ALLOCATE( particle_win_parent(nr_childs) )
272	ALLOCATE( buf_ptr(nr_childs) )
273	DO m = 1, nr_childs
274	child_id = get_childid(m)
275	#if defined( __gfortran )
276	!
277	!-- For the gfortran compiler the function c_sizeof produces strange erros
278	!-- which can probably be attributed to an error in the gfortran compiler.
279	!-- Therefore the particle size in bytes is set manually. Attention: A
280	!-- change of the size of the particle type requires an adjustment of
281	!-- this value
282	parsize = 184
283	#else
284	parsize = C_SIZEOF (zero_particle)
285	#endif
286	winsize = max_nr_particle_in_rma_win * parsize
287	CALL MPI_ALLOC_MEM( winsize , MPI_INFO_NULL, buf_ptr(m), ierr )
288	buf_shape(1) = max_nr_particle_in_rma_win
289	CALL C_F_POINTER( buf_ptr(m), win_buffer, buf_shape )
290	CALL MPI_WIN_CREATE( win_buffer, winsize, parsize, &
291	MPI_INFO_NULL, children(child_id)%intra_comm, &
292	particle_win_parent(m), ierr )
293	ENDDO
294	ENDIF
295
296	END SUBROUTINE pmcp_g_alloc_win
297	!------------------------------------------------------------------------------!
298	! Description:
299	! ------------
300	!> child routine:
301	!> Read/get particles out of the parent MPI window
302	!------------------------------------------------------------------------------!
303	SUBROUTINE pmcp_c_get_particle_from_parent
304
305	IMPLICIT NONE
306
307	INTEGER(iwp) :: i !< x grid index
308	INTEGER(iwp) :: icl !< left boundary in coarse(parent) index space
309	INTEGER(iwp) :: ierr !< error code
310	INTEGER(iwp) :: ij !< combined xy index for the buffer array
311	INTEGER(iwp) :: ip !< loop index (child PEs)
312	INTEGER(iwp) :: j !< y grid index
313	INTEGER(iwp) :: jcs !< south boundary in coarse(parent) index space
314	INTEGER(iwp) :: nr !< number of particles to receive from a parent box
315
316	INTEGER(KIND=MPI_ADDRESS_KIND) :: parsize !<
317	INTEGER(KIND=MPI_ADDRESS_KIND) :: target_disp !<
318
319	TYPE(pedef), POINTER :: ape !< TO_DO Klaus: give a description and better name of the variable
320
321	IF ( cpl_id > 1 ) THEN
322
323	CALL pmc_c_getbuffer( particle_transfer = .TRUE. ) !Get number of particle/column and offset in RMA window xx
324
325	!
326	!-- Wait for buffer to fill.
327	!
328	!-- The parent side (in pmc_s_fillbuffer) is filling the buffer in the MPI RMA window
329	!-- When the filling is complete, a MPI_BARRIER is called.
330	!-- The child is not allowd to access the parent-buffer before it is completely filled
331	!-- Synchronization is done implicitely in pmc_c_getbuffer and pmc_s_fillbuffer on the parent side
332
333	icl = coarse_bound(1)
334	jcs = coarse_bound(3)
335
336	DO ip = 1, me%inter_npes
337
338	ape => me%pes(ip)
339
340	DO ij = 1, ape%nrele
341	j = ape%locind(ij)%j + jcs - 1
342	i = ape%locind(ij)%i + icl - 1
343	nr = nr_partc(j,i)
344	IF ( nr > 0 ) THEN
345
346	CALL check_and_alloc_coarse_particle (i, j, nr)
347	#if defined( __gfortran )
348	!
349	!-- For the gfortran compiler the function c_sizeof produces strange erros
350	!-- which can probably be attributed to an error in the gfortran compiler.
351	!-- Therefore the particle size in bytes is set manually. Attention: A
352	!-- change of the size of the particle type requires an adjustment of
353	!-- this value
354	parsize = 184
355	#else
356	parsize = C_SIZEOF (zero_particle)
357	#endif
358	target_disp = part_adrc(j,i) - 1
359	CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , ip - 1, 0, particle_win_child, ierr )
360	CALL MPI_GET( coarse_particles(j,i)%parent_particles, &
361	nr * parsize, MPI_BYTE, ip - 1, &
362	target_disp, nr * parsize, &
363	MPI_BYTE, particle_win_child, ierr )
364	CALL MPI_WIN_UNLOCK( ip - 1, particle_win_child, ierr )
365	ENDIF
366	coarse_particles(j,i)%nr_particle = nr
367	ENDDO
368	ENDDO
369
370	CALL c_copy_particle_to_child_grid
371	ENDIF
372
373	END SUBROUTINE pmcp_c_get_particle_from_parent
374	!------------------------------------------------------------------------------!
375	! Description:
376	! ------------
377	!> child routine:
378	!> Write/put particles into the parent MPI window
379	!------------------------------------------------------------------------------!
380	SUBROUTINE pmcp_c_send_particle_to_parent
381
382	IMPLICIT NONE
383
384	INTEGER(iwp) :: disp_offset !<
385	INTEGER(iwp) :: i !< x loop index
386	INTEGER(iwp) :: icl !< left boundary in coarse(parent) index space
387	INTEGER(iwp) :: icr !< right boundary in coarse(parent) index space
388	INTEGER(iwp) :: ierr !< error code
389	INTEGER(iwp) :: ij !< combined xy index for the buffer array
390	INTEGER(iwp) :: ip !< loop index (child PEs)
391	INTEGER(iwp) :: j !< y loop index
392	INTEGER(iwp) :: jcs !< south boundary in coarse(parent) index space
393	INTEGER(iwp) :: jcn !< north boundary in coarse(parent) index space
394	INTEGER(iwp) :: max_nr_particle_per_pe !< maximum number of particles per PE (depending on grid apect ratio)
395	INTEGER(iwp) :: n !< shorter variable name for nr_fine_in_coarse
396	INTEGER(iwp) :: nr !< shorter variabel name for nr_partc
397	INTEGER(iwp) :: pe_offset !< offset index of the current PE
398
399	INTEGER(KIND=MPI_ADDRESS_KIND) :: parsize !<
400	INTEGER(KIND=MPI_ADDRESS_KIND) :: target_disp !<
401
402	REAL(wp) :: eps=0.00001 !< used in calculations to avoid rounding errors
403	REAL(wp) :: xx !< number of fine grid cells inside a coarse grid cell in x-direction
404	REAL(wp) :: yy !< number of fine grid cells inside a coarse grid cell in y-direction
405
406	TYPE(pedef), POINTER :: ape !< TO_DO Klaus: give a description and better name of the variable
407
408	! TYPE(particle_type) :: dummy_part !< dummy particle (needed for size calculations)
409
410
411	IF ( cpl_id > 1 ) THEN
412	CALL c_copy_particle_to_coarse_grid
413
414	!
415	!-- Child domain boundaries in the parent index space
416
417	icl = coarse_bound(1)
418	icr = coarse_bound(2)
419	jcs = coarse_bound(3)
420	jcn = coarse_bound(4)
421
422	nr_partc = 0
423
424	DO i = icl, icr
425	DO j = jcs, jcn
426	nr_partc(j,i) = coarse_particles(j,i)%nr_particle
427	ENDDO
428	ENDDO
429	part_adrc = 0
430
431	!
432	!-- compute number of fine grid cells in coarse grid (one direction)
433	xx = (cg%dx + eps) / dx ! +eps to avoid rounding error
434	yy = (cg%dy + eps) / dy
435	nr_fine_in_coarse = MAX( INT(xx), INT(yy) )
436
437	IF ( MOD( coord_x(0), cg%dx ) /= 0.0 .OR. MOD( coord_y(0), cg%dy ) /= 0.0 ) THEN
438	nr_fine_in_coarse = nr_fine_in_coarse + 1
439	ENDIF
440
441	!
442	!-- Assign a number to my child PE to select different areas in the RMA window on server side
443	!-- With this number a square of child PEs is defined which share the same coarse grid cells
444
445	n = nr_fine_in_coarse ! local variable n to make folloing statements shorter
446	pe_offset = MOD( myidx, n ) * n + MOD( myidy, n)
447	max_nr_particle_per_pe = max_nr_particle_in_rma_win / ( n * n )
448	disp_offset = pe_offset * max_nr_particle_per_pe
449	#if defined( __gfortran )
450	!
451	!-- For the gfortran compiler the function c_sizeof produces strange erros
452	!-- which can probably be attributed to an error in the gfortran compiler.
453	!-- Therefore the particle size in bytes is set manually. Attention: A
454	!-- change of the size of the particle type requires an adjustment of
455	!-- this value
456	parsize = 184
457	#else
458	parsize = C_SIZEOF (zero_particle)
459	#endif
460	DO ip = 1, me%inter_npes
461
462	ape => me%pes(ip)
463
464	target_disp = disp_offset
465	DO ij = 1, ape%nrele
466	j = ape%locind(ij)%j + jcs - 1
467	i = ape%locind(ij)%i + icl - 1
468	nr = nr_partc(j,i)
469	IF( nr > 0 ) THEN
470	IF ( target_disp + nr - disp_offset >= max_nr_particle_per_pe ) THEN
471	WRITE(9,*) 'RMA window too small on child ', &
472	target_disp + nr - disp_offset, &
473	max_nr_particle_per_pe, max_nr_particle_in_rma_win
474	message_string = 'RMA window too small on child'
475	CALL message( 'pmci_create_child_arrays', 'PA0480', 3, 2, 0, 6, 0 ) ! PA number has to be adjusted
476	ENDIF
477	CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , ip - 1, 0, particle_win_child, ierr )
478	CALL MPI_PUT( coarse_particles(j,i)%parent_particles, &
479	nr * parsize, MPI_BYTE, ip - 1, &
480	target_disp, nr * parsize , &
481	MPI_BYTE, particle_win_child, ierr )
482	CALL MPI_WIN_UNLOCK( ip - 1, particle_win_child, ierr )
483	part_adrc(j,i) = target_disp + 1
484	target_disp = target_disp + nr
485	ENDIF
486	ENDDO
487	ENDDO
488
489	CALL pmc_c_putbuffer ( particle_transfer = .TRUE. ) !Send new number of particle/column and offset to parent
490
491	ENDIF
492
493	END SUBROUTINE pmcp_c_send_particle_to_parent
494	!------------------------------------------------------------------------------!
495	! Description:
496	! ------------
497	!> parent routine:
498	!> write particles into the MPI window
499	!------------------------------------------------------------------------------!
500	SUBROUTINE pmcp_p_fill_particle_win
501
502	IMPLICIT NONE
503
504	LOGICAL :: active_particle !< Particles located in the fine/child grid area are marked as active (to be transferred)
505	LOGICAL,SAVE :: lfirst = .TRUE. !<
506
507	INTEGER(iwp) :: child_id !< id of the child model
508	INTEGER(iwp) :: i !< x grid box index
509	INTEGER(iwp) :: ierr !< error code
510	INTEGER(iwp) :: ij !< combined xy index for the buffer array
511	INTEGER(iwp) :: ip !< loop index (child PEs)
512	INTEGER(iwp) :: j !< y grid box index
513	INTEGER(iwp) :: k !< z grid box index
514	INTEGER(iwp) :: m !< loop index (number of childs)
515	INTEGER(iwp) :: n !< loop index (number of particles)
516	INTEGER(iwp) :: nr_part_col !< Number of particles to transfer per column
517	INTEGER(iwp) :: number_of_particles !<
518	INTEGER(iwp) :: pindex !<
519	INTEGER(iwp) :: tot_particle_count !< Total number of particles per child
520
521	REAL(wp) :: dx_child !< child grid spacing
522	REAL(wp) :: dy_child !< child grid spacing
523	REAL(wp) :: dz_child !< child grid spacing
524	REAL(wp) :: ny_coord !< north coordinate of child grid
525	REAL(wp) :: ny_coord_b !< north coordinate of child grid boundary
526	REAL(wp) :: lx_coord !< left coordinate of child grid
527	REAL(wp) :: lx_coord_b !< left coordinate of child grid boundary
528	REAL(wp) :: rx_coord !< right coordinate of child grid
529	REAL(wp) :: rx_coord_b !< right coordinate of child grid boundary
530	REAL(wp) :: sy_coord !< south coordinate of child grid
531	REAL(wp) :: sy_coord_b !< south coordinate of child grid boundary
532	REAL(wp) :: uz_coord !< upper coordinate of child grid
533	REAL(wp) :: uz_coord_b !< upper coordinate of child grid boundary
534	REAL(wp) :: x !< particle position
535	REAL(wp) :: xo !< origin of particle
536	REAL(wp) :: y !< particle position
537	REAL(wp) :: yo !< origin of particle
538	REAL(wp) :: z !< particle position
539
540	INTEGER(iwp),DIMENSION(1) :: buf_shape !<
541
542	TYPE(pedef), POINTER :: ape !< TO_DO Klaus: give a description and better name of the variable
543
544	DO m = 1, get_number_of_childs()
545
546	child_id = get_childid(m)
547
548	CALL get_child_edges( m, lx_coord, lx_coord_b, rx_coord, rx_coord_b, &
549	sy_coord, sy_coord_b, ny_coord, ny_coord_b, &
550	uz_coord, uz_coord_b)
551
552	CALL get_child_gridspacing( m, dx_child, dy_child, dz_child )
553
554	IF ( lfirst ) THEN
555	WRITE(9,'(a,5f10.2)') 'edges ',lx_coord,rx_coord,sy_coord,ny_coord,uz_coord
556	WRITE(9,'(a,5f10.2)') 'edges boundary ',lx_coord_b,rx_coord_b,sy_coord_b,ny_coord_b,uz_coord_b
557	WRITE(9,'(a,5f10.2)') 'child spacing ',dx_child, dy_child, dz_child,lower_left_coord_x,lower_left_coord_y
558	ENDIF
559	!
560	!-- reset values for every child
561	tot_particle_count = 0
562	nr_part = 0
563	part_adr = 0
564	pindex = 1
565
566	buf_shape(1) = max_nr_particle_in_rma_win
567	CALL C_F_POINTER( buf_ptr(m), particle_in_win , buf_shape )
568
569	DO ip = 1, children(child_id)%inter_npes
570
571	ape => children(child_id)%pes(ip)
572
573	nr_part_col = 0
574
575	DO ij = 1, ape%nrele
576
577	!
578	!-- Inside the PMC adressing of 3d arrays starts with 1
579	i = ape%locind(ij)%i + nxl - nbgp - 1
580	j = ape%locind(ij)%j + nys - nbgp - 1
581	nr_part_col = 0 ! Number of particles to transfer per column
582	part_adr(j,i) = pindex
583
584	DO k = nzb + 1, nzt
585	number_of_particles = prt_count(k,j,i)
586
587	IF ( number_of_particles <= 0 ) CYCLE
588
589	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
590
591	! Select particles within boundary area
592
593	DO n = 1, number_of_particles
594	x = particles(n)%x
595	y = particles(n)%y
596	z = particles(n)%z
597	!
598	!-- check if the particle is located in the fine grid area
599	active_particle = ((x > lx_coord .AND. x < rx_coord) .AND. &
600	(y > sy_coord .AND. y < ny_coord) .AND. &
601	(z > 0.000000001 .AND. z < uz_coord))
602	IF ( active_particle .AND. particles(n)%particle_mask ) THEN
603
604	particle_in_win(pindex) = particles(n)
605	!
606	!-- Change particle positions and origin relative to global origin
607	particle_in_win(pindex)%x = particle_in_win(pindex)%x + lower_left_coord_x
608	particle_in_win(pindex)%y = particle_in_win(pindex)%y + lower_left_coord_y
609	particle_in_win(pindex)%origin_x = particle_in_win(pindex)%origin_x + lower_left_coord_x
610	particle_in_win(pindex)%origin_y = particle_in_win(pindex)%origin_y + lower_left_coord_y
611
612	tot_particle_count = tot_particle_count + 1
613	nr_part_col = nr_part_col + 1
614	pindex = pindex + 1
615	IF ( pindex > max_nr_particle_in_rma_win ) THEN
616	WRITE(9,*) 'RMA window too small on parent ',pindex, max_nr_particle_in_rma_win
617	message_string = 'RMA window too small on parent'
618	CALL message( 'pmci_create_child_arrays', 'PA0481', 3, 2, 0, 6, 0 ) ! PA number has to be adjusted
619	ENDIF
620	END IF
621	ENDDO
622	ENDDO
623	nr_part(j,i) = nr_part_col
624	ENDDO
625	ENDDO
626
627	CALL pmc_s_fillbuffer( child_id, particle_transfer = .TRUE. )
628	ENDDO
629
630	lfirst = .FALSE.
631
632	END SUBROUTINE pmcp_p_fill_particle_win
633
634	!------------------------------------------------------------------------------!
635	! Description:
636	! ------------
637	!> parent routine:
638	!> delete particles from the MPI window
639	!------------------------------------------------------------------------------!
640	SUBROUTINE pmcp_p_empty_particle_win
641	IMPLICIT NONE
642
643	INTEGER(iwp) :: child_id !< model id of the child
644	INTEGER(iwp) :: ip !< loop index (child PEs)
645	INTEGER(iwp) :: m !< loop index (number of childs)
646
647	INTEGER(iwp),DIMENSION(1) :: buf_shape !<
648
649	DO m = 1, get_number_of_childs()
650
651	child_id = get_childid(m)
652
653	buf_shape(1) = max_nr_particle_in_rma_win
654	CALL C_F_POINTER( buf_ptr(m), particle_in_win , buf_shape )
655
656	!
657	!-- In some cells of the coarse grid, there are contributions from more than one child process
658	!-- Therfore p_copy_particle_to_org_grid is done for one child process per call
659
660	DO ip = 1, pmc_s_get_child_npes( child_id )
661	nr_part = 0
662	part_adr = 0
663
664	CALL pmc_s_getdata_from_buffer( child_id, particle_transfer = .TRUE., child_process_nr = ip )
665
666	CALL p_copy_particle_to_org_grid( m, child_id )
667	ENDDO
668
669	ENDDO
670
671	END SUBROUTINE pmcp_p_empty_particle_win
672
673	!------------------------------------------------------------------------------!
674	! Description:
675	! ------------
676	!> parent routine:
677	!> After the transfer mark all parent particles that are still inside on of the
678	!> child areas for deletion.
679	!------------------------------------------------------------------------------!
680	SUBROUTINE pmcp_p_delete_particles_in_fine_grid_area
681
682	IMPLICIT NONE
683
684	LOGICAL :: to_delete !< particles outside of model domain are marked as to_delete
685
686	INTEGER(iwp) :: i !< loop index (x grid)
687	INTEGER(iwp) :: j !< loop index (y grid)
688	INTEGER(iwp) :: k !< loop index (z grid)
689	INTEGER(iwp) :: m !< loop index (number of particles)
690	INTEGER(iwp) :: n !< loop index (number of childs)
691
692	REAL(wp) :: dx_child !< child grid spacing
693	REAL(wp) :: dy_child !< child grid spacing
694	REAL(wp) :: dz_child !< child grid spacing
695	REAL(wp) :: ny_coord !< north coordinate of child grid
696	REAL(wp) :: ny_coord_b !< north coordinate of child grid boundary
697	REAL(wp) :: lx_coord !< left coordinate of child grid
698	REAL(wp) :: lx_coord_b !< left coordinate of child grid boundary
699	REAL(wp) :: rx_coord !< right coordinate of child grid
700	REAL(wp) :: rx_coord_b !< right coordinate of child grid boundary
701	REAL(wp) :: sy_coord !< south coordinate of child grid
702	REAL(wp) :: sy_coord_b !< south coordinate of child grid boundary
703	REAL(wp) :: uz_coord !< upper coordinate of child grid
704	REAL(wp) :: uz_coord_b !< upper coordinate of child grid boundary
705	REAL(wp) :: x !< particle position
706	REAL(wp) :: y !< particle position
707	REAL(wp) :: z !< particle position
708
709	DO m = 1, get_number_of_childs()
710	CALL get_child_edges( m, lx_coord, lx_coord_b, rx_coord, rx_coord_b, &
711	sy_coord, sy_coord_b, ny_coord, ny_coord_b, &
712	uz_coord, uz_coord_b )
713
714
715	CALL get_child_gridspacing( m, dx_child, dy_child, dz_child )
716
717	DO i = nxl, nxr
718	DO j = nys, nyn
719	DO k = nzb, nzt
720	number_of_particles = prt_count(k,j,i)
721
722	IF ( number_of_particles == 0 ) CYCLE
723
724	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
725
726	DO n = 1, number_of_particles
727	x = particles(n)%x
728	y = particles(n)%y
729	z = particles(n)%z
730
731	to_delete = ((x > lx_coord .AND. x < rx_coord) .AND. &
732	(y > sy_coord .AND. y < ny_coord) .AND. &
733	(z > 0.000000001 .AND. z < uz_coord))
734
735	IF ( to_delete ) THEN
736	particles(n)%particle_mask = .FALSE.
737	ENDIF
738	ENDDO
739	ENDDO
740	ENDDO
741	ENDDO
742
743	ENDDO
744
745	END SUBROUTINE pmcp_p_delete_particles_in_fine_grid_area
746	!------------------------------------------------------------------------------!
747	! Description:
748	! ------------
749	!> general routine:
750	!> print the total number of of the current model and its child models into a file
751	!------------------------------------------------------------------------------!
752	SUBROUTINE pmcp_g_print_number_of_particles (my_time,local_nr_particles)
753
754	USE pegrid, &
755	ONLY: myid
756
757	IMPLICIT NONE
758
759	INTEGER(iwp),INTENT(IN) :: local_nr_particles !<
760
761	REAL(wp),INTENT(IN) :: my_time !<
762
763	LOGICAL, SAVE :: is_file_open=.FALSE. !<
764
765	INTEGER(iwp) :: child_id !<
766	INTEGER(iwp) :: child_nr_particles !< total number of particles in all child models
767	INTEGER(iwp) :: ierr !< error code
768	INTEGER(iwp) :: m !< loop index (number of childs)
769
770	CHARACTER(LEN=16) :: fname !< filename
771
772	INTEGER(iwp),DIMENSION(2) :: ivalr !< integer value to be received
773	INTEGER(iwp),DIMENSION(2) :: ivals !< integer value to be send
774
775
776	child_nr_particles = 0
777	IF ( myid == 0 ) THEN
778	IF ( cpl_id > 1 ) THEN
779	ivals(1) = local_nr_particles
780	CALL pmc_send_to_parent( ivals, 1, 0, 400, ierr )
781	ENDIF
782	DO m = 1, SIZE( pmc_parent_for_child ) - 1
783
784	child_id = pmc_parent_for_child(m)
785	CALL pmc_recv_from_child( child_id, ivalr, 1, 0, 400, ierr )
786	child_nr_particles = child_nr_particles + ivalr(1)
787	ENDDO
788
789	IF ( SIZE( pmc_parent_for_child ) > 1 ) THEN
790	IF ( .NOT. is_file_open ) THEN !kk muss noch auf file_open umgestellt werden
791	WRITE(fname,'(a,i2.2)') 'nr_particles_',cpl_id
792	OPEN (333,file = fname)
793	is_file_open = .true.
794	ENDIF
795	WRITE(333,'(f12.2,3i10)') my_time,local_nr_particles + child_nr_particles,local_nr_particles,child_nr_particles
796	ENDIF
797	ENDIF
798
799	END SUBROUTINE pmcp_g_print_number_of_particles
800
801	!------------------------------------------------------------------------------!
802	!------------------------------------------------------------------------------!
803	! Private subroutines
804	!------------------------------------------------------------------------------!
805	!------------------------------------------------------------------------------!
806
807	!------------------------------------------------------------------------------!
808	! Description:
809	! ------------
810	!> child routine
811	!> update the size of the local buffer (coarse_particles)
812	!------------------------------------------------------------------------------!
813	SUBROUTINE check_and_alloc_coarse_particle (ic,jc,nr,with_copy)
814
815	IMPLICIT NONE
816
817	INTEGER(iwp),INTENT(IN) :: ic !< coarse x grid index
818	INTEGER(iwp),INTENT(IN) :: jc !< coarse y grid index
819	INTEGER(iwp),INTENT(IN) :: nr !< number of particles to be transferred/stored in local buffer
820
821	LOGICAL,INTENT(IN),OPTIONAL :: with_copy !< copy particles in buffer? or reallocate empty buffer
822
823	LOGICAL :: with_copy_lo !< local variable of with copy
824
825	INTEGER(iwp) :: new_size !< new size of the local buffer
826	INTEGER(iwp) :: old_size !< old size of the local buffer
827
828	TYPE(particle_type), DIMENSION(:), ALLOCATABLE :: tmp_particles_d !<
829
830	with_copy_lo = .FALSE.
831	IF ( PRESENT( with_copy ) ) with_copy_lo = with_copy
832
833	IF ( .NOT. ALLOCATED( coarse_particles(jc,ic)%parent_particles ) ) THEN
834	new_size = MAX( nr, Min_particles_per_column )
835	ALLOCATE( coarse_particles(jc,ic)%parent_particles(new_size) )
836	ELSEIF ( nr > SIZE( coarse_particles(jc,ic)%parent_particles ) ) THEN
837
838	old_size = SIZE( coarse_particles(jc,ic)%parent_particles )
839	new_size = old_size * ( 1.0_wp + alloc_factor / 100.0_wp )
840	new_size = MAX( nr, new_size, old_size + Min_particles_per_column )
841
842	!
843	!-- Copy existing particles to new particle buffer
844	IF ( with_copy_lo ) THEN
845	ALLOCATE( tmp_particles_d(old_size) )
846	tmp_particles_d(1:old_size) = coarse_particles(jc,ic)%parent_particles
847
848	DEALLOCATE( coarse_particles(jc,ic)%parent_particles )
849	ALLOCATE( coarse_particles(jc,ic)%parent_particles(new_size) )
850
851	coarse_particles(jc,ic)%parent_particles(1:old_size) = tmp_particles_d(1:old_size)
852	coarse_particles(jc,ic)%parent_particles(old_size+1:new_size) = zero_particle
853
854	DEALLOCATE( tmp_particles_d )
855	!
856	!-- allocate or reallocate an empty buffer
857	ELSE
858	DEALLOCATE( coarse_particles(jc,ic)%parent_particles )
859	ALLOCATE( coarse_particles(jc,ic)%parent_particles(new_size) )
860	ENDIF
861	ENDIF
862
863	END SUBROUTINE check_and_alloc_coarse_particle
864
865	!------------------------------------------------------------------------------!
866	! Description:
867	! ------------
868	!> child routine:
869	!> copy/sort particles out of the local buffer into the respective grid boxes
870	!------------------------------------------------------------------------------!
871	SUBROUTINE c_copy_particle_to_child_grid
872
873	IMPLICIT NONE
874
875	INTEGER(iwp) :: ic !< coarse x grid index
876	INTEGER(iwp) :: icl !< left boundary in coarse(parent) index space
877	INTEGER(iwp) :: icr !< right boundary in coarse(parent) index space
878	INTEGER(iwp) :: ip !< x grid index
879	INTEGER(iwp) :: jc !< coarse y grid index
880	INTEGER(iwp) :: jcn !< north boundary in coarse(parent) index space
881	INTEGER(iwp) :: jcs !< south boundary in coarse(parent) index space
882	INTEGER(iwp) :: jp !< y grid index
883	INTEGER(iwp) :: kp !< z grid index
884	INTEGER(iwp) :: n !< loop index (number of particles)
885	INTEGER(iwp) :: nr !< short variable for name number or particles
886
887	REAL(wp) :: xc !< child x coordinate
888	REAL(wp) :: xoc !< child x origin
889	REAL(wp) :: yc !< child y coordinate
890	REAL(wp) :: yoc !< child y origin
891	REAL(wp) :: zc !< child z coordinate
892
893	!
894	!-- Child domain boundaries in the parent index space
895	icl = coarse_bound(1)
896	icr = coarse_bound(2)
897	jcs = coarse_bound(3)
898	jcn = coarse_bound(4)
899
900	DO ic = icl, icr
901	DO jc = jcs, jcn
902	nr = coarse_particles(jc,ic)%nr_particle
903
904	IF ( nr > 0 ) THEN
905	DO n = 1, nr
906	xc = coarse_particles(jc,ic)%parent_particles(n)%x-lower_left_coord_x
907	yc = coarse_particles(jc,ic)%parent_particles(n)%y-lower_left_coord_y
908	zc = coarse_particles(jc,ic)%parent_particles(n)%z
909	xoc = coarse_particles(jc,ic)%parent_particles(n)%origin_x-lower_left_coord_x
910	yoc = coarse_particles(jc,ic)%parent_particles(n)%origin_y-lower_left_coord_y
911	ip = xc / dx
912	jp = yc / dy
913	kp = nzt
914	DO WHILE ( zw(kp-1) > zc .AND. kp > nzb + 1 ) ! kk search loop has to be optimzed !!!
915	kp = kp - 1
916	ENDDO
917
918	IF ( ip >= nxl .AND. ip <= nxr .AND. jp >= nys .AND. jp <= nyn ) THEN
919	prt_count(kp,jp,ip) = prt_count(kp,jp,ip) + 1
920	IF ( prt_count(kp,jp,ip) > SIZE( grid_particles(kp,jp,ip)%particles ) ) THEN
921	CALL realloc_particles_array( ip, jp, kp )
922	ENDIF
923	coarse_particles(jc,ic)%parent_particles(n)%x = xc ! Adjust coordinates to child grid
924	coarse_particles(jc,ic)%parent_particles(n)%y = yc
925	coarse_particles(jc,ic)%parent_particles(n)%origin_x = xoc ! Adjust origins to child grid
926	coarse_particles(jc,ic)%parent_particles(n)%origin_y = yoc
927	grid_particles(kp,jp,ip)%particles(prt_count(kp,jp,ip)) = coarse_particles(jc,ic)%parent_particles(n)
928	ENDIF
929	ENDDO
930	ENDIF
931	ENDDO
932	ENDDO
933
934	END SUBROUTINE c_copy_particle_to_child_grid
935	!------------------------------------------------------------------------------!
936	! Description:
937	! ------------
938	!> child routine:
939	!> copy particles which left the model area into the local buffer
940	!------------------------------------------------------------------------------!
941	SUBROUTINE c_copy_particle_to_coarse_grid
942
943	IMPLICIT NONE
944
945	LOGICAL :: boundary_particle !<
946
947	INTEGER(iwp) :: i !< loop index (x grid)
948	INTEGER(iwp) :: ic !< loop index (coarse x grid)
949	INTEGER(iwp) :: icl !< left boundary in coarse(parent) index space
950	INTEGER(iwp) :: icr !< left boundary in coarse(parent) index space
951	INTEGER(iwp) :: ierr !< error code
952	INTEGER(iwp) :: j !< loop index (y grid)
953	INTEGER(iwp) :: jc !< loop index (coarse y grid)
954	INTEGER(iwp) :: jcs !< south boundary in coarse(parent) index space
955	INTEGER(iwp) :: jcn !< north boundary in coarse(parent) index space
956	INTEGER(iwp) :: k !< loop index (z grid)
957	INTEGER(iwp) :: n !< loop index (number of particles)
958
959	REAL(iwp) :: x !< x coordinate
960	REAL(iwp) :: xo !< x origin
961	REAL(iwp) :: x_left !< absolute left boundary
962	REAL(iwp) :: x_right !< absolute right boundary
963	REAL(iwp) :: y !< left boundary in coarse(parent) index space
964	REAL(iwp) :: yo !< y origin
965	REAL(iwp) :: y_north !< absolute north boundary
966	REAL(iwp) :: y_south !< absoulte south boundary
967	REAL(iwp) :: z !< z coordinate
968
969	!
970	!-- Child domain boundaries in the parent index space
971
972	icl = coarse_bound(1)
973	icr = coarse_bound(2)
974	jcs = coarse_bound(3)
975	jcn = coarse_bound(4)
976
977	!
978	!-- absolute coordinates
979	x_left = coord_x(0)
980	x_right = coord_x(nx) + dx
981	y_south = coord_y(0)
982	y_north = coord_y(ny) + dy
983
984	! Clear Particle Buffer
985
986	DO ic = icl, icr
987	DO jc = jcs, jcn
988	coarse_particles(jc,ic)%nr_particle = 0
989	ENDDO
990	ENDDO
991
992	!
993	!-- Determine particles which leave the inner area in east or west dirextion
994	!-- Compute only first (nxl) and last (nxr) loop iterration.
995	DO i = nxl, nxr
996	DO j = nys, nyn
997	DO k = nzb + 1, nzt
998	number_of_particles = prt_count(k,j,i)
999	IF ( number_of_particles <= 0 ) CYCLE
1000	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
1001	DO n = 1, number_of_particles
1002	IF ( particles(n)%particle_mask ) THEN
1003	x = particles(n)%x+ lower_left_coord_x
1004	y = particles(n)%y+ lower_left_coord_y
1005	xo = particles(n)%origin_x + lower_left_coord_x
1006	yo = particles(n)%origin_y + lower_left_coord_y
1007	z = particles(n)%z
1008
1009	boundary_particle = .FALSE.
1010	boundary_particle = boundary_particle .OR. (x < x_left .OR. x > x_right)
1011	boundary_particle = boundary_particle .OR. (y < y_south .OR. y > y_north)
1012	boundary_particle = boundary_particle .OR. (z > zw(nzt))
1013
1014	IF ( boundary_particle ) THEN
1015	ic = x / cg%dx !TODO anpassen auf Mehrfachnesting
1016	jc = y / cg%dy
1017
1018	IF ( ic >= icl .AND. ic <= icr .AND. jc >= jcs .AND. jc <= jcn ) THEN
1019	coarse_particles(jc,ic)%nr_particle = coarse_particles(jc,ic)%nr_particle + 1
1020	CALL check_and_alloc_coarse_particle( ic, jc, coarse_particles(jc,ic)%nr_particle, with_copy=.TRUE. )
1021
1022	coarse_particles(jc,ic)%parent_particles(coarse_particles(jc,ic)%nr_particle) = particles(n)
1023	coarse_particles(jc,ic)%parent_particles(coarse_particles(jc,ic)%nr_particle)%x = x !adapt to global coordinates
1024	coarse_particles(jc,ic)%parent_particles(coarse_particles(jc,ic)%nr_particle)%y = y
1025	coarse_particles(jc,ic)%parent_particles(coarse_particles(jc,ic)%nr_particle)%origin_x = xo
1026	coarse_particles(jc,ic)%parent_particles(coarse_particles(jc,ic)%nr_particle)%origin_y = yo
1027	!-- Mark particle as deleted after copying it to the transfer buffer
1028	grid_particles(k,j,i)%particles(n)%particle_mask = .FALSE.
1029	ELSE
1030	WRITE(9,'(a,10i6)') 'This should not happen ',i,j,k,ic,jc,icl,icr,jcs,jcn
1031	CALL MPI_Abort( MPI_COMM_WORLD, 9999, ierr )
1032	ENDIF
1033	ENDIF
1034	ENDIF
1035	ENDDO
1036	ENDDO
1037	ENDDO
1038	ENDDO
1039
1040	!
1041	!- Pack particles (eliminate those marked for deletion),
1042	!- determine new number of particles
1043	CALL lpm_sort_in_subboxes
1044
1045	END SUBROUTINE c_copy_particle_to_coarse_grid
1046	!------------------------------------------------------------------------------!
1047	! Description:
1048	! ------------
1049	!> parent routine:
1050	!> copy/sort particles from the MPI window into the respective grid boxes
1051	!------------------------------------------------------------------------------!
1052	SUBROUTINE p_copy_particle_to_org_grid( m, child_id )
1053
1054	IMPLICIT NONE
1055
1056	INTEGER(iwp),INTENT(IN) :: child_id !<
1057	INTEGER(iwp),INTENT(IN) :: m !<
1058
1059	INTEGER(iwp) :: i !< loop index (x grid)
1060	INTEGER(iwp) :: j !< loop index (y grid)
1061	INTEGER(iwp) :: k !< loop index (z grid)
1062	INTEGER(iwp) :: n !< loop index (nr part)
1063	INTEGER(iwp) :: nr !< short variable name for nr_part
1064	INTEGER(iwp) :: pindex !< short variable name part_adr
1065
1066	REAL(iwp) :: x !< x coordinate
1067	REAL(iwp) :: xo !< x origin
1068	REAL(iwp) :: y !< y coordinate
1069	REAL(iwp) :: yo !< y origin
1070	REAL(iwp) :: z !< z coordinate
1071
1072	INTEGER(iwp),DIMENSION(1) :: buf_shape !<
1073
1074	buf_shape(1) = max_nr_particle_in_rma_win
1075	CALL C_F_POINTER( buf_ptr(m), particle_in_win , buf_shape )
1076
1077	DO i = nxl, nxr
1078	DO j = nys, nyn
1079	nr = nr_part(j,i)
1080	IF ( nr > 0 ) THEN
1081	pindex = part_adr(j,i)
1082	DO n = 1, nr
1083	x = particle_in_win(pindex)%x-lower_left_coord_x
1084	y = particle_in_win(pindex)%y-lower_left_coord_y
1085	z = particle_in_win(pindex)%z
1086	xo = particle_in_win(pindex)%origin_x-lower_left_coord_x
1087	yo = particle_in_win(pindex)%origin_y-lower_left_coord_y
1088	k = nzt + 1
1089	DO WHILE ( zw(k-1) > z .AND. k > nzb + 1 ) ! kk search loop has to be optimzed !!!
1090	k = k - 1
1091	END DO
1092
1093	prt_count(k,j,i) = prt_count(k,j,i) + 1
1094	IF ( prt_count(k,j,i) > SIZE( grid_particles(k,j,i)%particles ) ) THEN
1095	CALL realloc_particles_array( i, j, k )
1096	ENDIF
1097	grid_particles(k,j,i)%particles(prt_count(k,j,i)) = particle_in_win(pindex)
1098
1099	!
1100	!-- Update particle positions and origins relative to parent domain
1101	grid_particles(k,j,i)%particles(prt_count(k,j,i))%x = x
1102	grid_particles(k,j,i)%particles(prt_count(k,j,i))%y = y
1103	grid_particles(k,j,i)%particles(prt_count(k,j,i))%origin_x = xo
1104	grid_particles(k,j,i)%particles(prt_count(k,j,i))%origin_y = yo
1105	pindex = pindex + 1
1106	ENDDO
1107	ENDIF
1108	ENDDO
1109	ENDDO
1110
1111	END SUBROUTINE p_copy_particle_to_org_grid
1112
1113
1114	END MODULE pmc_particle_interface

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |