Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Changeset 3948 for palm/trunk


Ignore:
Timestamp:
May 3, 2019 2:49:57 PM (6 years ago)
Author:
hellstea
Message:

some cleaning up

Location:
palm/trunk/SOURCE
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/pmc_interface_mod.f90

    r3947 r3948  
    2525! -----------------
    2626! $Id$
     27! Some variables renamed, a little cleaning up and some commenting improvements
     28!
     29! 3947 2019-05-03 07:56:44Z hellstea
    2730! The checks included in 3946 are extended for the z-direction and moved into its
    2831! own subroutine called from pmci_define_index_mapping.
    … …  
    542545!
    543546!-- Children's parent-grid arrays
    544     INTEGER(iwp), SAVE, DIMENSION(5), PUBLIC    ::  coarse_bound        !< subdomain index bounds for children's parent-grid arrays
     547    INTEGER(iwp), SAVE, DIMENSION(5), PUBLIC    ::  parent_bound        !< subdomain index bounds for children's parent-grid arrays
    545548
    546549    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  dissc !< Parent-grid array on child domain - dissipation rate
    … …  
    804807!
    805808!-- Set the steering switch which tells the models that they are nested (of
    806 !-- course the root domain (cpl_id = 1) is not nested)
    807     IF ( cpl_id >= 2 )  THEN
     809!-- course the root domain is not nested)
     810    IF ( .NOT.  pmc_is_rootmodel() )  THEN
    808811       child_domain = .TRUE.
    809812       WRITE( coupling_char, '(A2,I2.2)') '_N', cpl_id
    … …  
    823826!-- because no location messages would be generated otherwise.
    824827!-- world_comm is given a dummy value to avoid compiler warnings (INTENT(OUT)
    825 !-- should get an explicit value)
    826 !-- todo: why don't we print an error message instead of these settings?
     828!-- must get an explicit value).
     829!-- Note that this branch is only to avoid compiler warnings. The actual
     830!-- execution never reaches here because the call of this subroutine is
     831!-- already enclosed by  #if defined( __parallel ).
    827832    cpl_id     = 1
    828833    nested_run = .FALSE.
    … …  
    944949                                      !< of the child msib is within the y-range of the child m
    945950!
    946 !-- Initialize the current pmc parent
     951!-- Initialize the current pmc parent.
    947952    CALL pmc_parentinit
    948953!
    … …  
    980985!--       Find the highest child-domain level in the parent grid for the reduced z
    981986!--       transfer
    982           DO  kp = 1, nz                 
     987          DO  kp = 1, nzt                 
    983988             IF ( zw(kp) > child_height )  THEN
    984989                nz_child = kp
    … …  
    10411046!--       that the top ghost layer of the child grid does not exceed
    10421047!--       the parent domain top boundary.
    1043           IF ( child_height > zw(nz) ) THEN
     1048          IF ( child_height > zw(nzt) ) THEN
    10441049             nomatch = 1
    10451050          ENDIF
    … …  
    14621467          CALL pmc_recv_from_parent( rans_mode_parent, 1, 0, 19, ierr )
    14631468!
    1464 !--       Receive Coarse grid information.
     1469!--       Receive parent-grid information.
    14651470          CALL pmc_recv_from_parent( parent_grid_info_real,                    &
    14661471                                     SIZE(parent_grid_info_real), 0, 21, ierr )
    … …  
    14801485       pg%nz = parent_grid_info_int(3)
    14811486!
    1482 !--    Get parent coordinates on coarse grid
     1487!--    Allocate 1-D arrays for parent-grid coordinates and grid-spacings in the z-direction
    14831488       ALLOCATE( pg%coord_x(-nbgp:pg%nx+nbgp) )
    14841489       ALLOCATE( pg%coord_y(-nbgp:pg%ny+nbgp) )
    … …  
    14881493       ALLOCATE( pg%zw(0:pg%nz+1) )
    14891494!
    1490 !--    Get coarse grid coordinates and values of the z-direction from the parent
     1495!--    Get parent-grid coordinates and grid-spacings in the z-direction from the parent
    14911496       IF ( myid == 0)  THEN
    14921497          CALL pmc_recv_from_parent( pg%coord_x, pg%nx+1+2*nbgp, 0, 24, ierr )
    … …  
    15051510       CALL MPI_BCAST( pg%zu, pg%nz+2,  MPI_REAL, 0, comm2d, ierr )
    15061511       CALL MPI_BCAST( pg%zw, pg%nz+2,  MPI_REAL, 0, comm2d, ierr )
    1507        CALL MPI_BCAST( rans_mode_parent, 1, MPI_LOGICAL, 0, comm2d, ierr )
    1508 
    1509 !  CHECK IF pmci_check_grid_matching COULD BE MOVED HERE.
    1510        
     1512       CALL MPI_BCAST( rans_mode_parent, 1, MPI_LOGICAL, 0, comm2d, ierr )       
    15111513!
    15121514!--    Find the index bounds for the nest domain in the coarse-grid index space
    … …  
    15691571       IMPLICIT NONE
    15701572
    1571        INTEGER(iwp), DIMENSION(5,numprocs) ::  coarse_bound_all     !< Transfer array for parent-grid index bounds
     1573       INTEGER(iwp), DIMENSION(5,numprocs) ::  parent_bound_all     !< Transfer array for parent-grid index bounds
    15721574
    15731575       INTEGER(iwp), DIMENSION(4)          ::  parent_bound_global  !< Transfer array for global parent-grid index bounds
    … …  
    16931695       FLUSH(9)
    16941696
    1695        coarse_bound(1) = ipl
    1696        coarse_bound(2) = ipr
    1697        coarse_bound(3) = jps
    1698        coarse_bound(4) = jpn
    1699        coarse_bound(5) = myid
     1697       parent_bound(1) = ipl
     1698       parent_bound(2) = ipr
     1699       parent_bound(3) = jps
     1700       parent_bound(4) = jpn
     1701       parent_bound(5) = myid
    17001702!
    17011703!--    The following index bounds are used for allocating index mapping and some other auxiliary arrays
    … …  
    17081710!--    This fact is exploited in creating the index list in pmci_create_index_list
    17091711!    IMPROVE THIS COMMENT. EXPLAIN WHERE THIS INFORMATION IS NEEDED.
    1710        CALL MPI_GATHER( coarse_bound, 5, MPI_INTEGER, coarse_bound_all, 5,                          &
     1712       CALL MPI_GATHER( parent_bound, 5, MPI_INTEGER, parent_bound_all, 5,                          &
    17111713                        MPI_INTEGER, 0, comm2d, ierr )
    17121714
    17131715       IF ( myid == 0 )  THEN
    1714           size_of_array(1) = SIZE( coarse_bound_all, 1 )
    1715           size_of_array(2) = SIZE( coarse_bound_all, 2 )
     1716          size_of_array(1) = SIZE( parent_bound_all, 1 )
     1717          size_of_array(2) = SIZE( parent_bound_all, 2 )
    17161718          CALL pmc_send_to_parent( size_of_array, 2, 0, 40, ierr )
    1717           CALL pmc_send_to_parent( coarse_bound_all, SIZE( coarse_bound_all ), 0, 41, ierr )
     1719          CALL pmc_send_to_parent( parent_bound_all, SIZE( parent_bound_all ), 0, 41, ierr )
    17181720!
    17191721!--       Determine the global parent-grid index bounds       
    1720           parent_bound_global(1) = MINVAL( coarse_bound_all(1,:) )
    1721           parent_bound_global(2) = MAXVAL( coarse_bound_all(2,:) )
    1722           parent_bound_global(3) = MINVAL( coarse_bound_all(3,:) )
    1723           parent_bound_global(4) = MAXVAL( coarse_bound_all(4,:) )
     1722          parent_bound_global(1) = MINVAL( parent_bound_all(1,:) )
     1723          parent_bound_global(2) = MAXVAL( parent_bound_all(2,:) )
     1724          parent_bound_global(3) = MINVAL( parent_bound_all(3,:) )
     1725          parent_bound_global(4) = MAXVAL( parent_bound_all(4,:) )
    17241726       ENDIF
    17251727!
    … …  
    24042406    IF ( .NOT. salsa_gases_from_chem )  pmc_max_array = pmc_max_array + ngases_salsa
    24052407
    2406 
    24072408#endif
    24082409   
    … …  
    24112412
    24122413 SUBROUTINE pmci_set_array_pointer( name, child_id, nz_child, n )
    2413 
     2414   
    24142415    IMPLICIT NONE
    24152416   
    … …  
    24202421   
    24212422    CHARACTER(LEN=*), INTENT(IN) ::  name             !<
     2423
     2424#if defined( __parallel )     
    24222425!
    24232426!-- Local variables:       
    … …  
    24872490!
    24882491!--    Give only one message for the root domain
    2489        IF ( myid == 0  .AND.  cpl_id == 1 )  THEN             
     2492       IF ( pmc_is_rootmodel()  .AND.  myid == 0 )  THEN
    24902493          message_string = 'pointer for array "' // TRIM( name ) // '" can''t be associated'
    24912494          CALL message( 'pmci_set_array_pointer', 'PA0117', 3, 2, 0, 6, 0 )
    … …  
    24972500       
    24982501    ENDIF
     2502   
     2503#endif
    24992504   
    25002505 END SUBROUTINE pmci_set_array_pointer
    … …  
    25472552    REAL(wp),INTENT(OUT) ::  lx_coord, lx_coord_b  !<
    25482553    REAL(wp),INTENT(OUT) ::  rx_coord, rx_coord_b  !<
     2554    REAL(wp),INTENT(OUT) ::  ny_coord, ny_coord_b  !<
    25492555    REAL(wp),INTENT(OUT) ::  sy_coord, sy_coord_b  !<
    2550     REAL(wp),INTENT(OUT) ::  ny_coord, ny_coord_b  !<
    25512556    REAL(wp),INTENT(OUT) ::  uz_coord, uz_coord_b  !<
    25522557
     2558   
     2559#if defined( __parallel )
    25532560   
    25542561    lx_coord = childgrid(m)%lx_coord
    … …  
    25642571    uz_coord_b = childgrid(m)%uz_coord_b
    25652572   
     2573#endif
     2574   
    25662575 END SUBROUTINE get_child_edges
    25672576
    … …  
    25782587    REAL(wp), INTENT(OUT), OPTIONAL ::  dz     !<
    25792588
     2589
     2590#if defined( __parallel )
    25802591   
    25812592    dx = childgrid(m)%dx
    … …  
    25852596    ENDIF
    25862597   
     2598#endif
     2599   
    25872600 END SUBROUTINE get_child_gridspacing
    25882601
    … …  
    25982611    INTEGER(iwp), INTENT(IN) ::  js      !<
    25992612    INTEGER(iwp), INTENT(IN) ::  nzc     !<  nzc is pg%nz, but note that pg%nz is not the original nz of parent,
    2600                                             !<  but the highest parent-grid level needed for nesting.
     2613                                         !<  but the highest parent-grid level needed for nesting.
    26012614    INTEGER(iwp), INTENT(IN), OPTIONAL ::  n  !< number of chemical species / salsa variables
    26022615   
    26032616    CHARACTER(LEN=*), INTENT(IN) ::  name    !<
     2617
     2618#if defined( __parallel )
    26042619!       
    26052620!-- Local variables:
    … …  
    26872702    ELSE
    26882703!
    2689 !-- Give only one message for the first child domain.
    2690        IF ( myid == 0  .AND.  cpl_id == 2 )  THEN
     2704!--    Give only one message for the first child domain.
     2705       IF ( cpl_id == 2  .AND.  myid == 0 )  THEN
    26912706          message_string = 'pointer for array "' // TRIM( name ) //            &
    26922707               '" can''t be associated'
    … …  
    27002715    ENDIF
    27012716
     2717#endif
    27022718 END SUBROUTINE pmci_create_childs_parent_grid_arrays
    27032719
    27042720
    2705 !
    2706 ! E N D   O F    S E T U P   R O U T I N E S
    2707 !
    27082721 SUBROUTINE pmci_parent_initialize
    27092722
    … …  
    27482761!
    27492762!-- Root model is never anyone's child
    2750     IF ( cpl_id > 1 )  THEN
     2763    IF ( .NOT.  pmc_is_rootmodel() )  THEN
    27512764!
    27522765!--    Get data from the parent
    … …  
    32023215
    32033216
    3204  SUBROUTINE pmci_datatrans( local_nesting_mode )
     3217 SUBROUTINE pmci_datatrans( local_nesting_mode )   
    32053218!
    32063219!-- This subroutine controls the nesting according to the nestpar
    … …  
    32183231    CHARACTER(LEN=*), INTENT(IN) ::  local_nesting_mode  !<  Nesting mode: 'one-way', 'two-way' or 'vertical'
    32193232
     3233#if defined( __parallel )   
    32203234!
    32213235!-- Debug location message
    … …  
    32663280    ENDIF
    32673281
     3282#endif
    32683283 END SUBROUTINE pmci_datatrans
    32693284
    … …  
    32713286
    32723287 SUBROUTINE pmci_parent_datatrans( direction )
    3273 
     3288   
    32743289    IMPLICIT NONE
    32753290
    … …  
    33443359
    33453360    dtl = dt_3d
    3346     IF ( cpl_id > 1 )  THEN
     3361    IF ( .NOT.  pmc_is_rootmodel() )  THEN
    33473362
    33483363       IF ( direction == parent_to_child )  THEN
    … …  
    39293944      workarr_lr = 0.0_wp     
    39303945      IF ( pdims(2) > 1 )  THEN
    3931 #if defined( __parallel )
     3946         
    39323947         IF ( bc_dirichlet_s )  THEN
    39333948            workarr_lr(0:pg%nz+1,jpsw:jpnw-1,0:2) = parent_array(0:pg%nz+1,jpsw:jpnw-1,ipbeg:ipbeg+2)
    … …  
    39523967                            workarr_lr(0,jpsw,0), 1, workarr_lr_exchange_type, psouth,  1, comm2d,  &
    39533968                            status, ierr )                               
    3954 #endif                                                                       
     3969
    39553970      ELSE                                                                   
    39563971         workarr_lr(0:pg%nz+1,jpsw:jpnw,0:2) = parent_array(0:pg%nz+1,jpsw:jpnw,ipbeg:ipbeg+2)           
    … …  
    41634178      workarr_sn = 0.0_wp     
    41644179      IF ( pdims(1) > 1 )  THEN
    4165 #if defined( __parallel )
     4180
    41664181         IF ( bc_dirichlet_l )  THEN
    41674182            workarr_sn(0:pg%nz+1,0:2,iplw:iprw-1) = parent_array(0:pg%nz+1,jpbeg:jpbeg+2,iplw:iprw-1)
    … …  
    41864201                            workarr_sn(0,0,iplw), 1, workarr_sn_exchange_type, pleft, 1, comm2d,    &
    41874202                            status, ierr )
    4188 #endif                                                                     
     4203
    41894204      ELSE                                                                 
    41904205         workarr_sn(0:pg%nz+1,0:2,iplw+1:iprw-1)                                                    &
    … …  
    44024417!--   Note that in case of 3-D nesting the left and right boundaries are
    44034418!--   not exchanged because the nest domain is not cyclic.
    4404 #if defined( __parallel )
    44054419      IF ( pdims(1) > 1 )  THEN
    44064420!
    … …  
    44314445                            comm2d, status, ierr )
    44324446      ENDIF
    4433 #endif     
    44344447
    44354448      IF  ( var == 'w' )  THEN
    … …  
    46264639!
    46274640!--   Define the index bounds ipl_anterp, ipr_anterp, jps_anterp and jpn_anterp.
    4628 !--   Note that kcb_anterp is simply zero and kct_anterp enters here as a
    4629 !--   parameter and it is determined in pmci_define_index_mapping.
    4630 !--   Note that the grid points used also for interpolation (from parent to
     4641!--   Note that kcb_anterp is simply zero and kct_anterp depends on kct which enters
     4642!--   here as a parameter and it is determined in pmci_define_index_mapping.
     4643!--   Note that the grid points directly used also for interpolation (from parent to
    46314644!--   child) are always excluded from anterpolation, e.g. anterpolation is maximally
    4632 !--   only from nzb:kct-1, as kct is used for interpolation. Similar restriction is
     4645!--   only from 0:kct-1, since kct is directly used for interpolation. Similar restriction is
    46334646!--   applied to the lateral boundaries as well. An additional buffer is
    46344647!--   also applied (default value for anterpolation_buffer_width = 2) in order
    … …  
    47084721 SUBROUTINE pmci_boundary_conds
    47094722
     4723#if defined( __parallel )
    47104724    USE chem_modules,                                                          &
    47114725        ONLY:  ibc_cs_b
    … …  
    49304944    ENDIF
    49314945
     4946#endif
    49324947 END SUBROUTINE pmci_boundary_conds
    49334948   

  • palm/trunk/SOURCE/pmc_particle_interface.f90

    r3883 r3948  
    2626! -----------------!
    2727! $Id$
     28! coarse bound renamed as parent_bound and icl, icr, jcs, jcn as ipl, ipr, jps, jpn.
     29!
     30! 3883 2019-04-10 12:51:50Z hellstea
    2831! Function get_number_of_childs renamed to get_number_of_children and cg
    2932! renamed to pg according to their definitions in pmc_interface_mod
    … …  
    108111       ONLY: cpl_id, get_number_of_children, nr_part, part_adr, nested_run,    &
    109112             get_childid, get_child_edges, nr_partc, part_adrc,                &
    110              coarse_bound, coord_x, coord_y, pg, get_child_gridspacing,        &
     113             parent_bound, coord_x, coord_y, pg, get_child_gridspacing,        &
    111114             lower_left_coord_x, lower_left_coord_y
    112115
    … …  
    251254    INTEGER(iwp) ::  m         !< loop index
    252255    INTEGER(iwp) ::  ierr      !< error code
    253     INTEGER(iwp) ::  icl       !< left boundary in coarse(parent) index space
    254     INTEGER(iwp) ::  icr       !< right boundary in coarse(parent) index space
    255     INTEGER(iwp) ::  jcs       !< south boundary in coarse(parent) index space
    256     INTEGER(iwp) ::  jcn       !< north boundary in coarse(parent) index space
     256    INTEGER(iwp) ::  ipl       !< left boundary in coarse(parent) index space
     257    INTEGER(iwp) ::  ipr       !< right boundary in coarse(parent) index space
     258    INTEGER(iwp) ::  jps       !< south boundary in coarse(parent) index space
     259    INTEGER(iwp) ::  jpn       !< north boundary in coarse(parent) index space
    257260    INTEGER(iwp) ::  child_id  !< Id of a child model
    258261    INTEGER(iwp) ::  nr_childs !< Number of child models of the current model
    … …  
    285288!
    286289!--    Child domain boundaries in the parent index space
    287        icl = coarse_bound(1)
    288        icr = coarse_bound(2)
    289        jcs = coarse_bound(3)
    290        jcn = coarse_bound(4)
    291 
    292        ALLOCATE( coarse_particles(jcs:jcn, icl:icr) )
     290       ipl = parent_bound(1)
     291       ipr = parent_bound(2)
     292       jps = parent_bound(3)
     293       jpn = parent_bound(4)
     294
     295       ALLOCATE( coarse_particles(jps:jpn,ipl:ipr) )
    293296
    294297       coarse_particles(:,:)%nr_particle = 0
    … …  
    331334
    332335    INTEGER(iwp) ::  i    !< x grid index
    333     INTEGER(iwp) ::  icl  !< left boundary in coarse(parent) index space
     336    INTEGER(iwp) ::  ipl  !< left boundary in coarse(parent) index space
    334337    INTEGER(iwp) ::  ierr !< error code
    335338    INTEGER(iwp) ::  ij   !< combined xy index for the buffer array
    336339    INTEGER(iwp) ::  ip   !< loop index (child PEs)
    337340    INTEGER(iwp) ::  j    !< y grid index
    338     INTEGER(iwp) ::  jcs  !< south boundary in coarse(parent) index space
     341    INTEGER(iwp) ::  jps  !< south boundary in coarse(parent) index space
    339342    INTEGER(iwp) ::  nr   !< number of particles to receive from a parent box
    340343   
    … …  
    359362!--    Synchronization is done implicitely in pmc_c_getbuffer and pmc_s_fillbuffer on the parent side
    360363
    361        icl = coarse_bound(1)
    362        jcs = coarse_bound(3)
     364       ipl = parent_bound(1)
     365       jps = parent_bound(3)
    363366
    364367       DO  ip = 1, me%inter_npes
    … …  
    367370
    368371          DO  ij = 1, ape%nrele
    369               j = ape%locind(ij)%j + jcs - 1
    370               i = ape%locind(ij)%i + icl - 1
     372              j = ape%locind(ij)%j + jps - 1
     373              i = ape%locind(ij)%i + ipl - 1
    371374              nr = nr_partc(j,i)
    372375              IF ( nr > 0 )  THEN
    … …  
    406409    INTEGER(iwp) ::  disp_offset            !<
    407410    INTEGER(iwp) ::  i                      !< x loop index
    408     INTEGER(iwp) ::  icl                    !< left boundary in coarse(parent) index space
    409     INTEGER(iwp) ::  icr                    !< right boundary in coarse(parent) index space
     411    INTEGER(iwp) ::  ipl                    !< left boundary in coarse(parent) index space
     412    INTEGER(iwp) ::  ipr                    !< right boundary in coarse(parent) index space
    410413    INTEGER(iwp) ::  ierr                   !< error code
    411414    INTEGER(iwp) ::  ij                     !< combined xy index for the buffer array
    412415    INTEGER(iwp) ::  ip                     !< loop index (child PEs)
    413416    INTEGER(iwp) ::  j                      !< y loop index
    414     INTEGER(iwp) ::  jcs                    !< south boundary in coarse(parent) index space
    415     INTEGER(iwp) ::  jcn                    !< north boundary in coarse(parent) index space
     417    INTEGER(iwp) ::  jps                    !< south boundary in coarse(parent) index space
     418    INTEGER(iwp) ::  jpn                    !< north boundary in coarse(parent) index space
    416419    INTEGER(iwp) ::  max_nr_particle_per_pe !< maximum number of particles per PE (depending on grid apect ratio)
    417420    INTEGER(iwp) ::  n                      !< shorter variable name for nr_fine_in_coarse
    … …  
    440443!--    Child domain boundaries in the parent index space
    441444
    442        icl = coarse_bound(1)
    443        icr = coarse_bound(2)
    444        jcs = coarse_bound(3)
    445        jcn = coarse_bound(4)
     445       ipl = parent_bound(1)
     446       ipr = parent_bound(2)
     447       jps = parent_bound(3)
     448       jpn = parent_bound(4)
    446449
    447450       nr_partc = 0
    448451       
    449        DO i = icl, icr
    450           DO j = jcs, jcn
     452       DO i = ipl, ipr
     453          DO j = jps, jpn
    451454             nr_partc(j,i) = coarse_particles(j,i)%nr_particle
    452455          ENDDO
    … …  
    480483          target_disp = disp_offset
    481484          DO ij = 1, ape%nrele
    482              j  = ape%locind(ij)%j + jcs - 1
    483              i  = ape%locind(ij)%i + icl - 1
     485             j  = ape%locind(ij)%j + jps - 1
     486             i  = ape%locind(ij)%i + ipl - 1
    484487             nr = nr_partc(j,i)
    485488             IF( nr > 0 ) THEN
    … …  
    907910 
    908911    INTEGER(iwp) ::  ic  !< coarse x grid index
    909     INTEGER(iwp) ::  icl !< left boundary in coarse(parent) index space
    910     INTEGER(iwp) ::  icr !< right boundary in coarse(parent) index space
     912    INTEGER(iwp) ::  ipl !< left boundary in coarse(parent) index space
     913    INTEGER(iwp) ::  ipr !< right boundary in coarse(parent) index space
    911914    INTEGER(iwp) ::  ip  !< x grid index
    912915    INTEGER(iwp) ::  jc  !< coarse y grid index
    913     INTEGER(iwp) ::  jcn !< north boundary in coarse(parent) index space
    914     INTEGER(iwp) ::  jcs !< south boundary in coarse(parent) index space
     916    INTEGER(iwp) ::  jpn !< north boundary in coarse(parent) index space
     917    INTEGER(iwp) ::  jps !< south boundary in coarse(parent) index space
    915918    INTEGER(iwp) ::  jp  !< y grid index
    916919    INTEGER(iwp) ::  kp  !< z grid index
    … …  
    927930!
    928931!-- Child domain boundaries in the parent index space
    929     icl = coarse_bound(1)
    930     icr = coarse_bound(2)
    931     jcs = coarse_bound(3)
    932     jcn = coarse_bound(4)
    933 
    934     DO ic = icl, icr
    935        DO jc = jcs, jcn
     932    ipl = parent_bound(1)
     933    ipr = parent_bound(2)
     934    jps = parent_bound(3)
     935    jpn = parent_bound(4)
     936
     937    DO ic = ipl, ipr
     938       DO jc = jps, jpn
    936939          nr = coarse_particles(jc,ic)%nr_particle
    937940
    … …  
    984987    INTEGER(iwp) ::  i    !< loop index (x grid)
    985988    INTEGER(iwp) ::  ic   !< loop index (coarse x grid)
    986     INTEGER(iwp) ::  icl  !< left boundary in coarse(parent) index space
    987     INTEGER(iwp) ::  icr  !< left boundary in coarse(parent) index space
     989    INTEGER(iwp) ::  ipl  !< left boundary in coarse(parent) index space
     990    INTEGER(iwp) ::  ipr  !< left boundary in coarse(parent) index space
    988991    INTEGER(iwp) ::  ierr !< error code
    989992    INTEGER(iwp) ::  j    !< loop index (y grid)
    990993    INTEGER(iwp) ::  jc   !< loop index (coarse y grid)
    991     INTEGER(iwp) ::  jcs  !< south boundary in coarse(parent) index space
    992     INTEGER(iwp) ::  jcn  !< north boundary in coarse(parent) index space
     994    INTEGER(iwp) ::  jps  !< south boundary in coarse(parent) index space
     995    INTEGER(iwp) ::  jpn  !< north boundary in coarse(parent) index space
    993996    INTEGER(iwp) ::  k    !< loop index (z grid)
    994997    INTEGER(iwp) ::  n    !< loop index (number of particles)
    … …  
    10081011!-- Child domain boundaries in the parent index space
    10091012
    1010     icl = coarse_bound(1)
    1011     icr = coarse_bound(2)
    1012     jcs = coarse_bound(3)
    1013     jcn = coarse_bound(4)
     1013    ipl = parent_bound(1)
     1014    ipr = parent_bound(2)
     1015    jps = parent_bound(3)
     1016    jpn = parent_bound(4)
    10141017
    10151018!
    … …  
    10221025!   Clear Particle Buffer
    10231026
    1024     DO ic = icl, icr
    1025        DO jc = jcs, jcn
     1027    DO ic = ipl, ipr
     1028       DO jc = jps, jpn
    10261029          coarse_particles(jc,ic)%nr_particle = 0
    10271030       ENDDO
    … …  
    10541057                      jc = y / pg%dy
    10551058
    1056                       IF ( ic >= icl .AND. ic <= icr .AND. jc >= jcs .AND. jc <= jcn ) THEN
     1059                      IF ( ic >= ipl .AND. ic <= ipr .AND. jc >= jps .AND. jc <= jpn ) THEN
    10571060                         coarse_particles(jc,ic)%nr_particle = coarse_particles(jc,ic)%nr_particle + 1
    10581061                         CALL check_and_alloc_coarse_particle( ic, jc, coarse_particles(jc,ic)%nr_particle, with_copy=.TRUE. )
    … …  
    10661069                         grid_particles(k,j,i)%particles(n)%particle_mask = .FALSE.
    10671070                      ELSE
    1068                          WRITE(9,'(a,10i6)') 'This should not happen ',i,j,k,ic,jc,icl,icr,jcs,jcn
     1071                         WRITE(9,'(a,10i6)') 'This should not happen ',i,j,k,ic,jc,ipl,ipr,jps,jpn
    10691072                         CALL MPI_Abort( MPI_COMM_WORLD, 9999, ierr )
    10701073                      ENDIF
    … …  
    11281131                yo = particle_in_win(pindex)%origin_y-lower_left_coord_y
    11291132                k = nzt + 1
    1130                 DO WHILE ( zw(k-1) > z .AND. k > nzb + 1 )                               ! kk search loop has to be optimzed !!!
     1133                DO WHILE ( zw(k-1) > z .AND. k > nzb + 1 )           ! kk search loop has to be optimzed !!!
    11311134                   k = k - 1
    11321135                END DO
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |