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

Last change on this file since 2807 was 2807, checked in by thiele, 3 years ago

Bugfixes gfortran c_sizeof

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