Ignore:
Timestamp:
Sep 12, 2018 3:02:00 PM (3 years ago)
Author:
raasch
Message:

various changes to avoid compiler warnings (mainly removal of unused variables)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/pmc_particle_interface.f90

    r3123 r3241  
    2626! -----------------!
    2727! $Id$
     28! unused variables removed
     29!
     30! 3123 2018-07-12 16:21:53Z suehring
    2831! Correct working precision for REAL numbers
    2932!
     
    519522    INTEGER(iwp) ::  child_id            !< id of the child model
    520523    INTEGER(iwp) ::  i                   !< x grid box index
    521     INTEGER(iwp) ::  ierr                !< error code
    522524    INTEGER(iwp) ::  ij                  !< combined xy index for the buffer array
    523525    INTEGER(iwp) ::  ip                  !< loop index (child PEs)
     
    530532    INTEGER(iwp) ::  pindex              !<
    531533    INTEGER(iwp) ::  tot_particle_count  !< Total number of particles per child
    532    
    533     REAL(wp) ::  dx_child   !< child grid spacing
    534     REAL(wp) ::  dy_child   !< child grid spacing
    535     REAL(wp) ::  dz_child   !< child grid spacing
    536     REAL(wp) ::  ny_coord   !< north coordinate of child grid
    537     REAL(wp) ::  ny_coord_b !< north coordinate of child grid boundary
    538     REAL(wp) ::  lx_coord   !< left coordinate of child grid
    539     REAL(wp) ::  lx_coord_b !< left coordinate of child grid boundary
    540     REAL(wp) ::  rx_coord   !< right coordinate of child grid
    541     REAL(wp) ::  rx_coord_b !< right coordinate of child grid boundary
    542     REAL(wp) ::  sy_coord   !< south coordinate of child grid
    543     REAL(wp) ::  sy_coord_b !< south coordinate of child grid boundary
    544     REAL(wp) ::  uz_coord   !< upper coordinate of child grid
    545     REAL(wp) ::  uz_coord_b !< upper coordinate of child grid boundary
    546     REAL(wp) ::  x          !< particle position
    547     REAL(wp) ::  xo         !< origin of particle
    548     REAL(wp) ::  y          !< particle position
    549     REAL(wp) ::  yo         !< origin of particle
    550     REAL(wp) ::  z          !< particle position
    551    
    552     INTEGER(iwp),DIMENSION(1) ::  buf_shape !<
    553    
    554 #if defined( __parallel )
    555     TYPE(pedef), POINTER ::  ape !< TO_DO Klaus: give a description and better name of the variable
    556 
    557     DO  m = 1, get_number_of_childs()
    558 
    559        child_id = get_childid(m)
    560 
    561        CALL get_child_edges( m, lx_coord, lx_coord_b, rx_coord, rx_coord_b,    &
    562                                 sy_coord, sy_coord_b, ny_coord, ny_coord_b,    &
    563                                 uz_coord, uz_coord_b)
    564 
    565        CALL get_child_gridspacing( m, dx_child, dy_child, dz_child )
    566 
    567        IF ( lfirst )   THEN
    568           WRITE(9,'(a,5f10.2)') 'edges          ',lx_coord,rx_coord,sy_coord,ny_coord,uz_coord
    569           WRITE(9,'(a,5f10.2)') 'edges boundary ',lx_coord_b,rx_coord_b,sy_coord_b,ny_coord_b,uz_coord_b
    570           WRITE(9,'(a,5f10.2)') 'child spacing  ',dx_child, dy_child, dz_child,lower_left_coord_x,lower_left_coord_y
    571        ENDIF
    572 !
    573 !--    reset values for every child
    574        tot_particle_count = 0
    575        nr_part  = 0           
    576        part_adr = 0
    577        pindex   = 1
    578 
    579        buf_shape(1) = max_nr_particle_in_rma_win
    580        CALL C_F_POINTER( buf_ptr(m), particle_in_win , buf_shape )
    581 
    582        DO  ip = 1, children(child_id)%inter_npes
    583 
    584           ape => children(child_id)%pes(ip)
    585 
    586           nr_part_col   = 0
    587          
    588           DO  ij = 1, ape%nrele
    589              
    590 !
    591 !--          Inside the PMC adressing of 3d arrays starts with 1
    592              i = ape%locind(ij)%i + nxl - nbgp - 1
    593              j = ape%locind(ij)%j + nys - nbgp - 1
    594              nr_part_col = 0 ! Number of particles to transfer per column
    595              part_adr(j,i) = pindex
    596              
    597              DO  k = nzb + 1, nzt
    598                 number_of_particles = prt_count(k,j,i)
    599                
    600                 IF ( number_of_particles <= 0 )  CYCLE
    601                
    602                 particles => grid_particles(k,j,i)%particles(1:number_of_particles)
    603 
    604                 ! Select particles within boundary area
    605 
    606                 DO n = 1, number_of_particles
    607                    x = particles(n)%x
    608                    y = particles(n)%y
    609                    z = particles(n)%z
    610 !
    611 !--                check if the particle is located in the fine grid area
    612                    active_particle = ((x > lx_coord .AND. x < rx_coord) .AND.  & 
    613                                       (y > sy_coord .AND. y < ny_coord) .AND.  &
    614                                       (z > 0.000000001 .AND. z < uz_coord))
    615                    IF ( active_particle .AND. particles(n)%particle_mask )  THEN
    616                      
    617                       particle_in_win(pindex) = particles(n)
    618 !
    619 !--                   Change particle positions and origin relative to global origin
    620                       particle_in_win(pindex)%x = particle_in_win(pindex)%x + lower_left_coord_x
    621                       particle_in_win(pindex)%y = particle_in_win(pindex)%y + lower_left_coord_y
    622                       particle_in_win(pindex)%origin_x = particle_in_win(pindex)%origin_x + lower_left_coord_x
    623                       particle_in_win(pindex)%origin_y = particle_in_win(pindex)%origin_y + lower_left_coord_y
    624 
    625                       tot_particle_count = tot_particle_count + 1
    626                       nr_part_col        = nr_part_col + 1
    627                       pindex             = pindex + 1
    628                       IF ( pindex > max_nr_particle_in_rma_win ) THEN
    629                          WRITE(9,*) 'RMA window too small on parent ',pindex, max_nr_particle_in_rma_win
    630                          message_string = 'RMA window too small on parent'
    631                          CALL message( 'pmci_create_child_arrays', 'PA0481', 3, 2, 0, 6, 0 )   ! PA number has to be adjusted
    632                      ENDIF
    633                    END IF
    634                 ENDDO
    635              ENDDO
    636              nr_part(j,i) = nr_part_col
    637           ENDDO
    638        ENDDO
    639 
    640        CALL pmc_s_fillbuffer( child_id, particle_transfer = .TRUE. )
    641     ENDDO
    642 
    643     lfirst = .FALSE.
    644 
    645 #endif
    646  END SUBROUTINE pmcp_p_fill_particle_win
    647 
    648  
    649 !------------------------------------------------------------------------------!
    650 ! Description:
    651 ! ------------
    652 !> parent routine:
    653 !> delete particles from the MPI window
    654 !------------------------------------------------------------------------------!
    655  SUBROUTINE pmcp_p_empty_particle_win
    656 
    657     IMPLICIT NONE
    658 
    659     INTEGER(iwp) ::  child_id           !< model id of the child
    660     INTEGER(iwp) ::  ip                 !< loop index (child PEs)
    661     INTEGER(iwp) ::  m                  !< loop index (number of childs)
    662 
    663     INTEGER(iwp),DIMENSION(1) ::  buf_shape !<
    664 
    665 #if defined( __parallel )
    666     DO  m = 1, get_number_of_childs()
    667 
    668        child_id = get_childid(m)
    669 
    670        buf_shape(1) = max_nr_particle_in_rma_win
    671        CALL C_F_POINTER( buf_ptr(m), particle_in_win , buf_shape )
    672 
    673 !
    674 !--    In some cells of the coarse grid, there are contributions from more than one child process
    675 !--    Therfore p_copy_particle_to_org_grid is done for one child process per call
    676 
    677        DO ip = 1, pmc_s_get_child_npes( child_id )
    678           nr_part  = 0
    679           part_adr = 0
    680 
    681           CALL pmc_s_getdata_from_buffer( child_id, particle_transfer = .TRUE., child_process_nr = ip )
    682 
    683           CALL p_copy_particle_to_org_grid( m, child_id )
    684        ENDDO
    685 
    686     ENDDO
    687 
    688 #endif
    689  END SUBROUTINE pmcp_p_empty_particle_win
    690 
    691 
    692 !------------------------------------------------------------------------------!
    693 ! Description:
    694 ! ------------
    695 !> parent routine:
    696 !> After the transfer mark all parent particles that are still inside on of the
    697 !> child areas for deletion.
    698 !------------------------------------------------------------------------------!
    699  SUBROUTINE pmcp_p_delete_particles_in_fine_grid_area
    700 
    701     IMPLICIT NONE
    702 
    703     LOGICAL ::  to_delete !< particles outside of model domain are marked as to_delete
    704    
    705     INTEGER(iwp) ::  i !< loop index (x grid)
    706     INTEGER(iwp) ::  j !< loop index (y grid)
    707     INTEGER(iwp) ::  k !< loop index (z grid)
    708     INTEGER(iwp) ::  m !< loop index (number of particles)
    709     INTEGER(iwp) ::  n !< loop index (number of childs)
    710534   
    711535    REAL(wp) ::  dx_child   !< child grid spacing
     
    725549    REAL(wp) ::  y          !< particle position
    726550    REAL(wp) ::  z          !< particle position
     551   
     552    INTEGER(iwp),DIMENSION(1) ::  buf_shape !<
     553   
     554#if defined( __parallel )
     555    TYPE(pedef), POINTER ::  ape !< TO_DO Klaus: give a description and better name of the variable
     556
     557    DO  m = 1, get_number_of_childs()
     558
     559       child_id = get_childid(m)
     560
     561       CALL get_child_edges( m, lx_coord, lx_coord_b, rx_coord, rx_coord_b,    &
     562                                sy_coord, sy_coord_b, ny_coord, ny_coord_b,    &
     563                                uz_coord, uz_coord_b)
     564
     565       CALL get_child_gridspacing( m, dx_child, dy_child, dz_child )
     566
     567       IF ( lfirst )   THEN
     568          WRITE(9,'(a,5f10.2)') 'edges          ',lx_coord,rx_coord,sy_coord,ny_coord,uz_coord
     569          WRITE(9,'(a,5f10.2)') 'edges boundary ',lx_coord_b,rx_coord_b,sy_coord_b,ny_coord_b,uz_coord_b
     570          WRITE(9,'(a,5f10.2)') 'child spacing  ',dx_child, dy_child, dz_child,lower_left_coord_x,lower_left_coord_y
     571       ENDIF
     572!
     573!--    reset values for every child
     574       tot_particle_count = 0
     575       nr_part  = 0           
     576       part_adr = 0
     577       pindex   = 1
     578
     579       buf_shape(1) = max_nr_particle_in_rma_win
     580       CALL C_F_POINTER( buf_ptr(m), particle_in_win , buf_shape )
     581
     582       DO  ip = 1, children(child_id)%inter_npes
     583
     584          ape => children(child_id)%pes(ip)
     585
     586          nr_part_col   = 0
     587         
     588          DO  ij = 1, ape%nrele
     589             
     590!
     591!--          Inside the PMC adressing of 3d arrays starts with 1
     592             i = ape%locind(ij)%i + nxl - nbgp - 1
     593             j = ape%locind(ij)%j + nys - nbgp - 1
     594             nr_part_col = 0   ! Number of particles to transfer per column
     595             part_adr(j,i) = pindex
     596             
     597             DO  k = nzb + 1, nzt
     598                number_of_particles = prt_count(k,j,i)
     599               
     600                IF ( number_of_particles <= 0 )  CYCLE
     601               
     602                particles => grid_particles(k,j,i)%particles(1:number_of_particles)
     603
     604                ! Select particles within boundary area
     605
     606                DO n = 1, number_of_particles
     607                   x = particles(n)%x
     608                   y = particles(n)%y
     609                   z = particles(n)%z
     610!
     611!--                check if the particle is located in the fine grid area
     612                   active_particle = ((x > lx_coord .AND. x < rx_coord) .AND.  & 
     613                                      (y > sy_coord .AND. y < ny_coord) .AND.  &
     614                                      (z > 0.000000001 .AND. z < uz_coord))
     615                   IF ( active_particle .AND. particles(n)%particle_mask )  THEN
     616                     
     617                      particle_in_win(pindex) = particles(n)
     618!
     619!--                   Change particle positions and origin relative to global origin
     620                      particle_in_win(pindex)%x = particle_in_win(pindex)%x + lower_left_coord_x
     621                      particle_in_win(pindex)%y = particle_in_win(pindex)%y + lower_left_coord_y
     622                      particle_in_win(pindex)%origin_x = particle_in_win(pindex)%origin_x + lower_left_coord_x
     623                      particle_in_win(pindex)%origin_y = particle_in_win(pindex)%origin_y + lower_left_coord_y
     624
     625                      tot_particle_count = tot_particle_count + 1
     626                      nr_part_col        = nr_part_col + 1
     627                      pindex             = pindex + 1
     628                      IF ( pindex > max_nr_particle_in_rma_win ) THEN
     629                         WRITE(9,*) 'RMA window too small on parent ',pindex, max_nr_particle_in_rma_win
     630                         message_string = 'RMA window too small on parent'
     631                         CALL message( 'pmci_create_child_arrays', 'PA0481', 3, 2, 0, 6, 0 )   ! PA number has to be adjusted
     632                     ENDIF
     633                   END IF
     634                ENDDO
     635             ENDDO
     636             nr_part(j,i) = nr_part_col
     637          ENDDO
     638       ENDDO
     639
     640       CALL pmc_s_fillbuffer( child_id, particle_transfer = .TRUE. )
     641    ENDDO
     642
     643    lfirst = .FALSE.
     644
     645#endif
     646 END SUBROUTINE pmcp_p_fill_particle_win
     647
     648 
     649!------------------------------------------------------------------------------!
     650! Description:
     651! ------------
     652!> parent routine:
     653!> delete particles from the MPI window
     654!------------------------------------------------------------------------------!
     655 SUBROUTINE pmcp_p_empty_particle_win
     656
     657    IMPLICIT NONE
     658
     659    INTEGER(iwp) ::  child_id           !< model id of the child
     660    INTEGER(iwp) ::  ip                 !< loop index (child PEs)
     661    INTEGER(iwp) ::  m                  !< loop index (number of childs)
     662
     663    INTEGER(iwp),DIMENSION(1) ::  buf_shape !<
     664
     665#if defined( __parallel )
     666    DO  m = 1, get_number_of_childs()
     667
     668       child_id = get_childid(m)
     669
     670       buf_shape(1) = max_nr_particle_in_rma_win
     671       CALL C_F_POINTER( buf_ptr(m), particle_in_win , buf_shape )
     672
     673!
     674!--    In some cells of the coarse grid, there are contributions from more than
     675!--    one child process. Therefore p_copy_particle_to_org_grid is done for one
     676!--    child process per call
     677       DO ip = 1, pmc_s_get_child_npes( child_id )
     678
     679          nr_part  = 0
     680          part_adr = 0
     681
     682          CALL pmc_s_getdata_from_buffer( child_id, particle_transfer = .TRUE.,&
     683                                          child_process_nr = ip )
     684          CALL p_copy_particle_to_org_grid( m )
     685       ENDDO
     686
     687    ENDDO
     688
     689#endif
     690 END SUBROUTINE pmcp_p_empty_particle_win
     691
     692
     693!------------------------------------------------------------------------------!
     694! Description:
     695! ------------
     696!> parent routine:
     697!> After the transfer mark all parent particles that are still inside on of the
     698!> child areas for deletion.
     699!------------------------------------------------------------------------------!
     700 SUBROUTINE pmcp_p_delete_particles_in_fine_grid_area
     701
     702    IMPLICIT NONE
     703
     704    LOGICAL ::  to_delete !< particles outside of model domain are marked as to_delete
     705   
     706    INTEGER(iwp) ::  i !< loop index (x grid)
     707    INTEGER(iwp) ::  j !< loop index (y grid)
     708    INTEGER(iwp) ::  k !< loop index (z grid)
     709    INTEGER(iwp) ::  m !< loop index (number of particles)
     710    INTEGER(iwp) ::  n !< loop index (number of childs)
     711   
     712    REAL(wp) ::  dx_child   !< child grid spacing
     713    REAL(wp) ::  dy_child   !< child grid spacing
     714    REAL(wp) ::  dz_child   !< child grid spacing
     715    REAL(wp) ::  ny_coord   !< north coordinate of child grid
     716    REAL(wp) ::  ny_coord_b !< north coordinate of child grid boundary
     717    REAL(wp) ::  lx_coord   !< left coordinate of child grid
     718    REAL(wp) ::  lx_coord_b !< left coordinate of child grid boundary
     719    REAL(wp) ::  rx_coord   !< right coordinate of child grid
     720    REAL(wp) ::  rx_coord_b !< right coordinate of child grid boundary
     721    REAL(wp) ::  sy_coord   !< south coordinate of child grid
     722    REAL(wp) ::  sy_coord_b !< south coordinate of child grid boundary
     723    REAL(wp) ::  uz_coord   !< upper coordinate of child grid
     724    REAL(wp) ::  uz_coord_b !< upper coordinate of child grid boundary
     725    REAL(wp) ::  x          !< particle position
     726    REAL(wp) ::  y          !< particle position
     727    REAL(wp) ::  z          !< particle position
    727728   
    728729#if defined( __parallel )
     
    951952                   ENDIF
    952953                   coarse_particles(jc,ic)%parent_particles(n)%x = xc                   ! Adjust coordinates to child grid
    953                    coarse_particles(jc,ic)%parent_particles(n)%y = yc
     954                   coarse_particles(jc,ic)%parent_particles(n)%y = yc
    954955                   coarse_particles(jc,ic)%parent_particles(n)%origin_x = xoc           ! Adjust origins to child grid
    955956                   coarse_particles(jc,ic)%parent_particles(n)%origin_y = yoc
     
    10861087!> copy/sort particles from the MPI window into the respective grid boxes
    10871088!------------------------------------------------------------------------------!
    1088  SUBROUTINE p_copy_particle_to_org_grid( m, child_id )
     1089 SUBROUTINE p_copy_particle_to_org_grid( m )
    10891090
    10901091    IMPLICIT NONE
    10911092
    1092     INTEGER(iwp),INTENT(IN) ::  child_id !<
    10931093    INTEGER(iwp),INTENT(IN) ::  m        !<
    10941094
Note: See TracChangeset for help on using the changeset viewer.