Ignore:
Timestamp:
Mar 11, 2020 2:20:43 PM (13 months ago)
Author:
raasch
Message:

ghost point exchange modularized, bugfix for wrong 2d-exchange

File:
1 moved

Legend:

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

    r4456 r4457  
    2525! -----------------
    2626! $Id$
     27! routine has been modularized, file exchange_horiz_2d has been merged
     28!
     29! 4429 2020-02-27 15:24:30Z raasch
    2730! bugfix: cpp-directives added for serial mode
    2831!
     
    4548!> lateral boundary conditions, respectively.
    4649!------------------------------------------------------------------------------!
     50 MODULE exchange_horiz_mod
     51
     52    USE kinds
     53
     54    USE pegrid
     55
     56    IMPLICIT NONE
     57
     58    PRIVATE
     59    PUBLIC exchange_horiz, exchange_horiz_int, exchange_horiz_2d, exchange_horiz_2d_byte,          &
     60           exchange_horiz_2d_int
     61
     62    INTERFACE exchange_horiz
     63       MODULE PROCEDURE exchange_horiz
     64    END INTERFACE exchange_horiz
     65
     66    INTERFACE exchange_horiz_int
     67       MODULE PROCEDURE exchange_horiz_int
     68    END INTERFACE exchange_horiz_int
     69
     70    INTERFACE exchange_horiz_2d
     71       MODULE PROCEDURE exchange_horiz_2d
     72    END INTERFACE exchange_horiz_2d
     73
     74    INTERFACE exchange_horiz_2d_byte
     75       MODULE PROCEDURE exchange_horiz_2d_byte
     76    END INTERFACE exchange_horiz_2d_byte
     77
     78    INTERFACE exchange_horiz_2d_int
     79       MODULE PROCEDURE exchange_horiz_2d_int
     80    END INTERFACE exchange_horiz_2d_int
     81
     82
     83 CONTAINS
     84
     85
    4786 SUBROUTINE exchange_horiz( ar, nbgp_local)
    48  
    4987
    5088    USE control_parameters,                                                    &
     
    62100        ONLY:  nxl, nxr, nyn, nys, nzb, nzt
    63101       
    64     USE kinds
    65    
    66     USE pegrid
    67 
    68     IMPLICIT NONE
    69 
    70102
    71103#if defined( _OPENACC )
     
    293325    USE indices,                                                               &
    294326        ONLY:  nzb
    295        
    296     USE kinds
    297    
    298     USE pegrid
    299 
    300     IMPLICIT NONE
    301327
    302328    INTEGER(iwp) ::  nxl_l       !< local index bound at current grid level, left side
     
    379405#endif
    380406
    381 
    382407 END SUBROUTINE exchange_horiz_int
     408
     409! Description:
     410! ------------
     411!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
     412!> boundary conditions, respectively, for 2D-arrays.
     413!------------------------------------------------------------------------------!
     414 SUBROUTINE exchange_horiz_2d( ar )
     415
     416    USE control_parameters,                                                    &
     417        ONLY :  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r,                &
     418                bc_dirichlet_s, bc_radiation_l,                                &
     419                bc_radiation_n, bc_radiation_r, bc_radiation_s
     420
     421    USE cpulog,                                                                &
     422        ONLY :  cpu_log, log_point_s
     423
     424    USE indices,                                                               &
     425        ONLY :  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg
     426
     427#if ! defined( __parallel )
     428    USE control_parameters,                                                    &
     429        ONLY:  bc_lr_cyc, bc_ns_cyc
     430#endif
     431
     432
     433    INTEGER(iwp) :: i  !<
     434
     435    REAL(wp) ::  ar(nysg:nyng,nxlg:nxrg)  !<
     436
     437
     438    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
     439
     440#if defined( __parallel )
     441
     442!
     443!-- Exchange of lateral boundary values for parallel computers
     444    IF ( pdims(1) == 1 )  THEN
     445
     446!
     447!--    One-dimensional decomposition along y, boundary values can be exchanged
     448!--    within the PE memory
     449       ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
     450       ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
     451
     452    ELSE
     453!
     454!--    Send left boundary, receive right one
     455
     456       CALL MPI_SENDRECV( ar(nysg,nxl), 1, type_y, pleft,  0,                 &
     457                          ar(nysg,nxr+1), 1, type_y, pright, 0,               &
     458                          comm2d, status, ierr )
     459!
     460!--    Send right boundary, receive left one
     461       CALL MPI_SENDRECV( ar(nysg,nxr+1-nbgp), 1, type_y, pright,  1,         &
     462                          ar(nysg,nxlg), 1, type_y, pleft,   1,               &
     463                          comm2d, status, ierr )
     464
     465
     466    ENDIF
     467
     468    IF ( pdims(2) == 1 )  THEN
     469!
     470!--    One-dimensional decomposition along x, boundary values can be exchanged
     471!--    within the PE memory
     472       ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
     473       ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
     474
     475    ELSE
     476!
     477!--    Send front boundary, receive rear one
     478
     479       CALL MPI_SENDRECV( ar(nys,nxlg), 1, type_x, psouth, 0,                 &
     480                          ar(nyn+1,nxlg), 1, type_x, pnorth, 0,               &
     481                          comm2d, status, ierr )
     482!
     483!--    Send rear boundary, receive front one
     484       CALL MPI_SENDRECV( ar(nyn+1-nbgp,nxlg), 1, type_x, pnorth, 1,          &
     485                          ar(nysg,nxlg), 1, type_x, psouth, 1,                &
     486                          comm2d, status, ierr )
     487
     488    ENDIF
     489
     490#else
     491
     492!
     493!-- Lateral boundary conditions in the non-parallel case
     494    IF ( bc_lr_cyc )  THEN
     495       ar(:,nxlg:nxl-1) = ar(:,nxr-nbgp+1:nxr)
     496       ar(:,nxr+1:nxrg) = ar(:,nxl:nxl+nbgp-1)
     497    ENDIF
     498
     499    IF ( bc_ns_cyc )  THEN
     500       ar(nysg:nys-1,:) = ar(nyn-nbgp+1:nyn,:)
     501       ar(nyn+1:nyng,:) = ar(nys:nys+nbgp-1,:)
     502    ENDIF
     503
     504#endif
     505
     506!
     507!-- Neumann-conditions at inflow/outflow/nested boundaries
     508    IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
     509       DO  i = nbgp, 1, -1
     510          ar(:,nxl-i) = ar(:,nxl)
     511       ENDDO
     512    ENDIF
     513    IF ( bc_dirichlet_r  .OR.  bc_radiation_r )  THEN
     514       DO  i = 1, nbgp
     515          ar(:,nxr+i) = ar(:,nxr)
     516       ENDDO
     517    ENDIF
     518    IF ( bc_dirichlet_s  .OR.  bc_radiation_s )  THEN
     519       DO  i = nbgp, 1, -1
     520          ar(nys-i,:) = ar(nys,:)
     521       ENDDO
     522    ENDIF
     523    IF ( bc_dirichlet_n  .OR.  bc_radiation_n )  THEN
     524       DO  i = 1, nbgp
     525          ar(nyn+i,:) = ar(nyn,:)
     526       ENDDO
     527    ENDIF
     528
     529    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
     530
     531 END SUBROUTINE exchange_horiz_2d
     532
     533
     534!------------------------------------------------------------------------------!
     535! Description:
     536! ------------
     537!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
     538!> boundary conditions, respectively, for 2D 8-bit integer arrays.
     539!------------------------------------------------------------------------------!
     540 SUBROUTINE exchange_horiz_2d_byte( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local )
     541
     542
     543    USE control_parameters,                                                    &
     544        ONLY:  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, &
     545               bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s, &
     546               bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s
     547
     548    USE cpulog,                                                                &
     549        ONLY:  cpu_log, log_point_s
     550
     551#if ! defined( __parallel )
     552    USE control_parameters,                                                    &
     553        ONLY:  bc_lr_cyc, bc_ns_cyc
     554#endif
     555
     556    INTEGER(iwp) ::  i           !< dummy index to zero-gradient conditions at in/outflow boundaries
     557    INTEGER(iwp) ::  nxl_l       !< local index bound at current grid level, left side
     558    INTEGER(iwp) ::  nxr_l       !< local index bound at current grid level, right side
     559    INTEGER(iwp) ::  nyn_l       !< local index bound at current grid level, north side
     560    INTEGER(iwp) ::  nys_l       !< local index bound at current grid level, south side
     561    INTEGER(iwp) ::  nbgp_local  !< number of ghost layers to be exchanged
     562
     563    INTEGER(KIND=1), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local,              &
     564                               nxl_l-nbgp_local:nxr_l+nbgp_local) ::  ar  !< treated array
     565
     566    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
     567
     568#if defined( __parallel )
     569
     570!
     571!-- Exchange of lateral boundary values for parallel computers
     572    IF ( pdims(1) == 1 )  THEN
     573
     574!
     575!--    One-dimensional decomposition along y, boundary values can be exchanged
     576!--    within the PE memory
     577       ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
     578       ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
     579
     580    ELSE
     581!
     582!--    Send left boundary, receive right one
     583       CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l),   1,                     &
     584                          type_y_byte, pleft,  0,                              &
     585                          ar(nys_l-nbgp_local,nxr_l+1), 1,                     &
     586                          type_y_byte, pright, 0,                              &
     587                          comm2d, status, ierr )
     588!
     589!--    Send right boundary, receive left one
     590       CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1,          &
     591                          type_y_byte, pright, 1,                              &
     592                          ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,          &
     593                          type_y_byte, pleft,  1,                              &
     594                          comm2d, status, ierr )
     595
     596    ENDIF
     597
     598    IF ( pdims(2) == 1 )  THEN
     599!
     600!--    One-dimensional decomposition along x, boundary values can be exchanged
     601!--    within the PE memory
     602       ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
     603       ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
     604
     605
     606    ELSE
     607!
     608!--    Send front boundary, receive rear one
     609       CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local),   1,                    &
     610                          type_x_byte, psouth, 0,                             &
     611                          ar(nyn_l+1,nxl_l-nbgp_local), 1,                    &
     612                          type_x_byte, pnorth, 0,                             &
     613                          comm2d, status, ierr )
     614
     615!
     616!--    Send rear boundary, receive front one
     617       CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1,         &
     618                          type_x_byte, pnorth, 1,                             &
     619                          ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,         &
     620                          type_x_byte, psouth, 1,                             &
     621                          comm2d, status, ierr )
     622
     623    ENDIF
     624
     625#else
     626
     627!
     628!-- Lateral boundary conditions in the non-parallel case
     629    IF ( bc_lr_cyc )  THEN
     630       ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
     631       ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
     632    ENDIF
     633
     634    IF ( bc_ns_cyc )  THEN
     635       ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
     636       ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
     637    ENDIF
     638
     639#endif
     640!
     641!-- Neumann-conditions at inflow/outflow/nested boundaries
     642    IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
     643       DO  i = nbgp_local, 1, -1
     644         ar(:,nxl_l-i) = ar(:,nxl_l)
     645       ENDDO
     646    ENDIF
     647    IF ( bc_dirichlet_r  .OR.  bc_radiation_r  )  THEN
     648       DO  i = 1, nbgp_local
     649          ar(:,nxr_l+i) = ar(:,nxr_l)
     650       ENDDO
     651    ENDIF
     652    IF ( bc_dirichlet_s  .OR.  bc_radiation_s  )  THEN
     653       DO  i = nbgp_local, 1, -1
     654         ar(nys_l-i,:) = ar(nys_l,:)
     655       ENDDO
     656    ENDIF
     657    IF ( bc_dirichlet_n  .OR.  bc_radiation_n  )  THEN
     658       DO  i = 1, nbgp_local
     659         ar(nyn_l+i,:) = ar(nyn_l,:)
     660       ENDDO
     661    ENDIF
     662
     663    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
     664
     665 END SUBROUTINE exchange_horiz_2d_byte
     666
     667
     668!------------------------------------------------------------------------------!
     669! Description:
     670! ------------
     671!> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
     672!> boundary conditions, respectively, for 2D 32-bit integer arrays.
     673!------------------------------------------------------------------------------!
     674 SUBROUTINE exchange_horiz_2d_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local )
     675
     676
     677    USE control_parameters,                                                    &
     678        ONLY:  bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, &
     679               bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s, &
     680               bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s
     681
     682#if defined( __parallel )
     683    USE control_parameters,                                                    &
     684        ONLY:  grid_level
     685#endif
     686
     687    USE cpulog,                                                                &
     688        ONLY:  cpu_log, log_point_s
     689
     690#if ! defined( __parallel )
     691    USE control_parameters,                                                    &
     692        ONLY:  bc_lr_cyc, bc_ns_cyc
     693#endif
     694
     695    INTEGER(iwp) ::  i           !< dummy index to zero-gradient conditions at in/outflow boundaries
     696    INTEGER(iwp) ::  nxl_l       !< local index bound at current grid level, left side
     697    INTEGER(iwp) ::  nxr_l       !< local index bound at current grid level, right side
     698    INTEGER(iwp) ::  nyn_l       !< local index bound at current grid level, north side
     699    INTEGER(iwp) ::  nys_l       !< local index bound at current grid level, south side
     700    INTEGER(iwp) ::  nbgp_local  !< number of ghost layers to be exchanged
     701
     702    INTEGER(iwp), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local,                 &
     703                            nxl_l-nbgp_local:nxr_l+nbgp_local) ::  ar  !< treated array
     704
     705    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
     706
     707#if defined( __parallel )
     708
     709!
     710!-- Exchange of lateral boundary values for parallel computers
     711    IF ( pdims(1) == 1 )  THEN
     712
     713!
     714!--    One-dimensional decomposition along y, boundary values can be exchanged
     715!--    within the PE memory
     716       ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
     717       ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
     718
     719    ELSE
     720!
     721!--    Send left boundary, receive right one
     722       CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l),   1,                     &
     723                          type_y_int(grid_level), pleft,  0,                   &
     724                          ar(nys_l-nbgp_local,nxr_l+1), 1,                     &
     725                          type_y_int(grid_level), pright, 0,                   &
     726                          comm2d, status, ierr )
     727!
     728!--    Send right boundary, receive left one
     729       CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1,          &
     730                          type_y_int(grid_level), pright, 1,                   &
     731                          ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,          &
     732                          type_y_int(grid_level), pleft,  1,                   &
     733                          comm2d, status, ierr )
     734
     735    ENDIF
     736
     737    IF ( pdims(2) == 1 )  THEN
     738!
     739!--    One-dimensional decomposition along x, boundary values can be exchanged
     740!--    within the PE memory
     741       ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
     742       ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
     743
     744
     745    ELSE
     746!
     747!--    Send front boundary, receive rear one
     748       CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local),   1,                    &
     749                          type_x_int(grid_level), psouth, 0,                  &
     750                          ar(nyn_l+1,nxl_l-nbgp_local), 1,                    &
     751                          type_x_int(grid_level), pnorth, 0,                  &
     752                          comm2d, status, ierr )
     753
     754!
     755!--    Send rear boundary, receive front one
     756       CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1,         &
     757                          type_x_int(grid_level), pnorth, 1,                  &
     758                          ar(nys_l-nbgp_local,nxl_l-nbgp_local),   1,         &
     759                          type_x_int(grid_level), psouth, 1,                  &
     760                          comm2d, status, ierr )
     761
     762    ENDIF
     763
     764#else
     765
     766!
     767!-- Lateral boundary conditions in the non-parallel case
     768    IF ( bc_lr_cyc )  THEN
     769       ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l)
     770       ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1)
     771    ENDIF
     772
     773    IF ( bc_ns_cyc )  THEN
     774       ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:)
     775       ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:)
     776    ENDIF
     777
     778#endif
     779!
     780!-- Neumann-conditions at inflow/outflow/nested boundaries
     781    IF ( bc_dirichlet_l  .OR.  bc_radiation_l )  THEN
     782       DO  i = nbgp_local, 1, -1
     783         ar(:,nxl_l-i) = ar(:,nxl_l)
     784       ENDDO
     785    ENDIF
     786    IF ( bc_dirichlet_r  .OR.  bc_radiation_r  )  THEN
     787       DO  i = 1, nbgp_local
     788          ar(:,nxr_l+i) = ar(:,nxr_l)
     789       ENDDO
     790    ENDIF
     791    IF ( bc_dirichlet_s  .OR.  bc_radiation_s  )  THEN
     792       DO  i = nbgp_local, 1, -1
     793         ar(nys_l-i,:) = ar(nys_l,:)
     794       ENDDO
     795    ENDIF
     796    IF ( bc_dirichlet_n  .OR.  bc_radiation_n  )  THEN
     797       DO  i = 1, nbgp_local
     798         ar(nyn_l+i,:) = ar(nyn_l,:)
     799       ENDDO
     800    ENDIF
     801
     802    CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
     803
     804 END SUBROUTINE exchange_horiz_2d_int
     805
     806
     807 END MODULE exchange_horiz_mod
Note: See TracChangeset for help on using the changeset viewer.