Changeset 1806


Ignore:
Timestamp:
Apr 5, 2016 6:55:35 PM (8 years ago)
Author:
gronemeier
Message:

adjustments to recycling_yshift

Location:
palm/trunk/SOURCE
Files:
2 edited

Legend:

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

    r1805 r1806  
    1919! Current revisions:
    2020! -----------------
    21 !
    22 ! 
     21! Check for recycling_yshift
     22!
    2323! Former revisions:
    2424! -----------------
     
    41484148!--    Calculate the index
    41494149       recycling_plane = recycling_width / dx
     4150!
     4151!--    Because the y-shift is done with a distance of INT( npey / 2 ) no shift
     4152!--    is possible if there is only one PE in y direction.
     4153       IF ( recycling_yshift .AND. pdims(2) < 2 )  THEN
     4154          WRITE( message_string, * )  'recycling_yshift = .T. requires more',  &
     4155                                      ' than one processor in y direction'
     4156          CALL message( 'check_parameters', 'PA0421', 1, 2, 0, 6, 0 )
    41504157    ENDIF
    41514158
  • palm/trunk/SOURCE/inflow_turbulence.f90

    r1683 r1806  
    1919! Current revisions:
    2020! -----------------
    21 !
     21! Added comments to variables and code segments. Removed code redundancies.
    2222!
    2323! Former revisions:
     
    7676        ONLY:  cpu_log, log_point
    7777       
    78     USE grid_variables,                                                        &
    79         ONLY: 
    80        
    8178    USE indices,                                                               &
    8279        ONLY:  nbgp, nxl, ny, nyn, nys, nyng, nysg, nzb, nzt
     
    8986    IMPLICIT NONE
    9087
    91     INTEGER(iwp) ::  i        !<
    92     INTEGER(iwp) ::  j        !<
    93     INTEGER(iwp) ::  k        !<
    94     INTEGER(iwp) ::  l        !<
    95     INTEGER(iwp) ::  next     !<
    96     INTEGER(iwp) ::  ngp_ifd  !<
    97     INTEGER(iwp) ::  ngp_pr   !<
    98     INTEGER(iwp) ::  prev     !<
     88    INTEGER(iwp) ::  i        !< loop index
     89    INTEGER(iwp) ::  j        !< loop index
     90    INTEGER(iwp) ::  k        !< loop index
     91    INTEGER(iwp) ::  l        !< loop index
     92    INTEGER(iwp) ::  next     !< ID of receiving PE for y-shift
     93    INTEGER(iwp) ::  ngp_ifd  !< number of grid points stored in avpr
     94    INTEGER(iwp) ::  ngp_pr   !< number of grid points stored in inflow_dist
     95    INTEGER(iwp) ::  prev     !< ID of sending PE for y-shift
    9996
    10097    REAL(wp), DIMENSION(nzb:nzt+1,6,nbgp)           ::                         &
    101        avpr, avpr_l  !<
     98       avpr               !< stores averaged profiles at recycling plane
     99    REAL(wp), DIMENSION(nzb:nzt+1,6,nbgp)           ::                         &
     100       avpr_l             !< auxiliary variable to calculate avpr
    102101    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,6,nbgp) ::                         &
    103        inflow_dist, local_inflow_dist  !<
     102       inflow_dist        !< turbulence signal of vars, added at inflow boundary
     103    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,6,nbgp) ::                         &
     104       local_inflow_dist  !< auxiliary variable for inflow_dist, used for yshift
    104105
    105106    CALL cpu_log( log_point(40), 'inflow_turbulence', 'start' )
     
    222223    ENDIF
    223224
    224    
     225!
     226!-- y-shift for inflow_dist
     227!-- Shift inflow_dist in positive y direction by a distance of INT( npey / 2 )
    225228    IF ( recycling_yshift .AND. myidx == id_inflow ) THEN
    226 
    227        IF ( pdims(2) >= 2 ) THEN
    228  
    229           IF ( myidy >= INT( pdims(2) / 2 ) ) THEN
    230              prev = myidy - INT( pdims(2) / 2 )
    231           ELSE
    232              prev = pdims(2) - ( INT( pdims(2) / 2 ) - myidy )
    233           ENDIF
    234        
    235           IF ( myidy < pdims(2) - INT( pdims(2) / 2 ) ) THEN
    236              next = myidy + INT( pdims(2) / 2 )
    237           ELSE
    238              next = INT( pdims(2) / 2 ) - ( pdims(2) - myidy )
    239           ENDIF
    240 
     229!
     230!--    Calculate the ID of the PE which sends data to this PE (prev) and of the
     231!--    PE which receives data from this PE (next).
     232       IF ( myidy >= INT( pdims(2) / 2 ) ) THEN
     233          prev = myidy - INT( pdims(2) / 2 )
     234       ELSE
     235          prev = pdims(2) - ( INT( pdims(2) / 2 ) - myidy )
    241236       ENDIF
     237     
     238       IF ( myidy < pdims(2) - INT( pdims(2) / 2 ) ) THEN
     239          next = myidy + INT( pdims(2) / 2 )
     240       ELSE
     241          next = INT( pdims(2) / 2 ) - ( pdims(2) - myidy )
     242       ENDIF
    242243
    243244       local_inflow_dist = 0.0_wp
    244    
     245
    245246       CALL MPI_SENDRECV( inflow_dist(nzb,nysg,1,1), ngp_ifd, MPI_REAL,        &
    246247                          next, 1, local_inflow_dist(nzb,nysg,1,1), ngp_ifd,   &
    247248                          MPI_REAL, prev, 1, comm1dy, status, ierr )
    248        
     249
     250       inflow_dist = local_inflow_dist
     251
    249252    ENDIF
    250253
     
    254257!-- Add the disturbance at the inflow
    255258    IF ( nxl == 0 )  THEN
    256        
    257        IF ( recycling_yshift ) THEN       
    258 
    259           DO  j = nysg, nyng
    260              DO  k = nzb, nzt + 1
    261 
    262                 u(k,j,-nbgp+1:0) = mean_inflow_profiles(k,1) +                 &
    263                                    local_inflow_dist(k,j,1,1:nbgp) *           &
    264                                    inflow_damping_factor(k)
    265                 v(k,j,-nbgp:-1)  = mean_inflow_profiles(k,2) +                 &
    266                                    local_inflow_dist(k,j,2,1:nbgp) *           &
    267                                    inflow_damping_factor(k)
    268                 w(k,j,-nbgp:-1)  =                                             &
    269                                    local_inflow_dist(k,j,3,1:nbgp) *           &
    270                                    inflow_damping_factor(k)
    271                 pt(k,j,-nbgp:-1) = mean_inflow_profiles(k,4) +                 &
    272                                    local_inflow_dist(k,j,4,1:nbgp) *           &
    273                                    inflow_damping_factor(k)
    274                 e(k,j,-nbgp:-1)  = mean_inflow_profiles(k,5) +                 &
    275                                    local_inflow_dist(k,j,5,1:nbgp) *           &
    276                                    inflow_damping_factor(k)
    277                 e(k,j,-nbgp:-1)  = MAX( e(k,j,-nbgp:-1), 0.0_wp )
    278 
    279                 IF ( humidity  .OR.  passive_scalar )                          &
    280                    q(k,j,-nbgp:-1)  = mean_inflow_profiles(k,6) +              &
    281                                       local_inflow_dist(k,j,6,1:nbgp) *        &
    282                                       inflow_damping_factor(k)
    283 
    284              ENDDO
    285           ENDDO
    286 
    287        ELSE
    288 
    289           DO  j = nysg, nyng
    290              DO  k = nzb, nzt + 1
    291  
    292                 u(k,j,-nbgp+1:0) = mean_inflow_profiles(k,1) +                 &
    293                            inflow_dist(k,j,1,1:nbgp) * inflow_damping_factor(k)
    294                 v(k,j,-nbgp:-1)  = mean_inflow_profiles(k,2) +                 &
    295                            inflow_dist(k,j,2,1:nbgp) * inflow_damping_factor(k)
    296                 w(k,j,-nbgp:-1)  =                                             &
    297                            inflow_dist(k,j,3,1:nbgp) * inflow_damping_factor(k)
    298                 pt(k,j,-nbgp:-1) = mean_inflow_profiles(k,4) +                 &
    299                            inflow_dist(k,j,4,1:nbgp) * inflow_damping_factor(k)
    300                 e(k,j,-nbgp:-1)  = mean_inflow_profiles(k,5) +                 &
    301                            inflow_dist(k,j,5,1:nbgp) * inflow_damping_factor(k)
    302                 e(k,j,-nbgp:-1)  = MAX( e(k,j,-nbgp:-1), 0.0_wp )
    303 
    304                 IF ( humidity  .OR.  passive_scalar )                          &
    305                    q(k,j,-nbgp:-1)  = mean_inflow_profiles(k,6) +              &
    306                            inflow_dist(k,j,6,1:nbgp) * inflow_damping_factor(k)
    307 
    308              ENDDO
    309           ENDDO
    310 
    311        ENDIF
    312    
     259
     260       DO  j = nysg, nyng
     261          DO  k = nzb, nzt + 1
     262
     263             u(k,j,-nbgp+1:0) = mean_inflow_profiles(k,1) +                 &
     264                        inflow_dist(k,j,1,1:nbgp) * inflow_damping_factor(k)
     265             v(k,j,-nbgp:-1)  = mean_inflow_profiles(k,2) +                 &
     266                        inflow_dist(k,j,2,1:nbgp) * inflow_damping_factor(k)
     267             w(k,j,-nbgp:-1)  =                                             &
     268                        inflow_dist(k,j,3,1:nbgp) * inflow_damping_factor(k)
     269             pt(k,j,-nbgp:-1) = mean_inflow_profiles(k,4) +                 &
     270                        inflow_dist(k,j,4,1:nbgp) * inflow_damping_factor(k)
     271             e(k,j,-nbgp:-1)  = mean_inflow_profiles(k,5) +                 &
     272                        inflow_dist(k,j,5,1:nbgp) * inflow_damping_factor(k)
     273             e(k,j,-nbgp:-1)  = MAX( e(k,j,-nbgp:-1), 0.0_wp )
     274
     275             IF ( humidity  .OR.  passive_scalar )                          &
     276                q(k,j,-nbgp:-1)  = mean_inflow_profiles(k,6) +              &
     277                        inflow_dist(k,j,6,1:nbgp) * inflow_damping_factor(k)
     278
     279          ENDDO
     280       ENDDO
     281
    313282    ENDIF
    314283
Note: See TracChangeset for help on using the changeset viewer.