Changeset 4260 for palm/trunk/SOURCE


Ignore:
Timestamp:
Oct 9, 2019 2:04:03 PM (5 years ago)
Author:
hellstea
Message:

Rest of the grid-line matching tests in pmc_interface_mod changed to round-off-error tolerant forms

File:
1 edited

Legend:

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

    r4249 r4260  
    2525! -----------------
    2626! $Id$
     27! Rest of the possibly round-off-error sensitive grid-line matching tests
     28! changed to round-off-error tolerant forms throughout the module.
     29!
     30! 4249 2019-10-01 12:27:47Z hellstea
    2731! Several grid-line matching tests changed to a round-off-error tolerant form
    2832! in pmci_setup_parent, pmci_define_index_mapping and pmci_check_grid_matching.
     
    509513 SUBROUTINE pmci_init( world_comm )
    510514
    511     USE control_parameters,                                                    &
     515    USE control_parameters,                                                                         &
    512516        ONLY:  message_string
    513517
     
    521525
    522526
    523     CALL pmc_init_model( world_comm, nesting_datatransfer_mode, nesting_mode,  &
     527    CALL pmc_init_model( world_comm, nesting_datatransfer_mode, nesting_mode,                       &
    524528                         anterpolation_buffer_width, pmc_status )
    525529
     
    536540!
    537541!-- Check steering parameter values
    538     IF ( TRIM( nesting_mode ) /= 'one-way'  .AND.                              &
    539          TRIM( nesting_mode ) /= 'two-way'  .AND.                              &
    540          TRIM( nesting_mode ) /= 'vertical' )                                  &
     542    IF ( TRIM( nesting_mode ) /= 'one-way'  .AND.                                                   &
     543         TRIM( nesting_mode ) /= 'two-way'  .AND.                                                   &
     544         TRIM( nesting_mode ) /= 'vertical' )                                                       &
    541545    THEN
    542546       message_string = 'illegal nesting mode: ' // TRIM( nesting_mode )
     
    544548    ENDIF
    545549
    546     IF ( TRIM( nesting_datatransfer_mode ) /= 'cascade'  .AND.                 &
    547          TRIM( nesting_datatransfer_mode ) /= 'mixed'    .AND.                 &
    548          TRIM( nesting_datatransfer_mode ) /= 'overlap' )                      &
     550    IF ( TRIM( nesting_datatransfer_mode ) /= 'cascade'  .AND.                                      &
     551         TRIM( nesting_datatransfer_mode ) /= 'mixed'    .AND.                                      &
     552         TRIM( nesting_datatransfer_mode ) /= 'overlap' )                                           &
    549553    THEN
    550        message_string = 'illegal nesting datatransfer mode: '                  &
    551                         // TRIM( nesting_datatransfer_mode )
     554       message_string = 'illegal nesting datatransfer mode: ' // TRIM( nesting_datatransfer_mode )
    552555       CALL message( 'pmci_init', 'PA0418', 3, 2, 0, 6, 0 )
    553556    ENDIF
     
    558561!-- Get some variables required by the pmc-interface (and in some cases in the
    559562!-- PALM code out of the pmci) out of the pmc-core
    560     CALL pmc_get_model_info( comm_world_nesting = comm_world_nesting,          &
    561                              cpl_id = cpl_id, cpl_parent_id = cpl_parent_id,   &
    562                              cpl_name = cpl_name, npe_total = cpl_npe_total,   &
    563                              lower_left_x = lower_left_coord_x,                &
     563    CALL pmc_get_model_info( comm_world_nesting = comm_world_nesting,                               &
     564                             cpl_id = cpl_id, cpl_parent_id = cpl_parent_id,                        &
     565                             cpl_name = cpl_name, npe_total = cpl_npe_total,                        &
     566                             lower_left_x = lower_left_coord_x,                                     &
    564567                             lower_left_y = lower_left_coord_y )
    565568!
     
    688691    REAL(wp) ::  yez                  !< Minimum separation in the y-direction required between the child and
    689692                                      !< parent boundaries (south or north)
    690     REAL(wp)     ::  tolex            !< Tolerance for grid-line matching in x-direction   
    691     REAL(wp)     ::  toley            !< Tolerance for grid-line matching in y-direction   
     693    REAL(wp)     ::  tolex            !< Tolerance for grid-line matching in x-direction
     694    REAL(wp)     ::  toley            !< Tolerance for grid-line matching in y-direction
    692695    REAL(wp)     ::  tolez            !< Tolerance for grid-line matching in z-direction   
    693696
     
    752755          child_height = child_grid_info(1)
    753756!
    754 !--       Find the highest child-domain level in the parent grid for the reduced z
    755 !--       transfer
     757!--       Find the highest child-domain level in the parent grid for the reduced z transfer
    756758          DO  kp = 1, nzt                 
    757 !             IF ( zw(kp) > child_height )  THEN
    758759             IF ( zw(kp) - child_height > tolez )  THEN                   
    759760                nz_child = kp
     
    790791             right_limit = upper_right_coord_x
    791792             north_limit = upper_right_coord_y
    792              IF ( ( child_coord_x(nx_child+1) /= right_limit ) .OR.                                 &  ! Change this IF test to a round-off-error tolerant form
    793                   ( child_coord_y(ny_child+1) /= north_limit ) )  THEN               
     793             IF ( ( ABS( child_coord_x(nx_child+1) - right_limit ) > tolex )  .OR.                  &
     794                  ( ABS( child_coord_y(ny_child+1) - north_limit ) > toley ) )  THEN               
    794795                nomatch = 1
    795796             ENDIF
     
    812813          ENDIF
    813814!             
    814 !--       Child domain must be lower than the parent domain such
    815 !--       that the top ghost layer of the child grid does not exceed
    816 !--       the parent domain top boundary.
    817           IF ( child_height > zw(nzt) ) THEN   ! Consider changing also this IF-test although it is not critical.
     815!--       Child domain must be lower than the parent domain such that the top ghost
     816!--       layer of the child grid does not exceed the parent domain top boundary.
     817          IF ( child_height - zw(nzt) > tolez ) THEN
    818818             nomatch = 1
    819819          ENDIF
     
    833833             DO  msib = 1, m - 1
    834834!
    835 !--             Set some logical auxiliary parameters to simplify the IF-condition. 
    836                 m_left_in_msib  = ( child_x_left(m)  >= child_x_left(msib) )  .AND.                 &
    837                                   ( child_x_left(m)  <= child_x_right(msib) )
    838                 m_right_in_msib = ( child_x_right(m) >= child_x_left(msib) )  .AND.                 &
    839                                   ( child_x_right(m) <= child_x_right(msib) )
    840                 msib_left_in_m  = ( child_x_left(msib)  >= child_x_left(m) )  .AND.                 &
    841                                   ( child_x_left(msib)  <= child_x_right(m) )
    842                 msib_right_in_m = ( child_x_right(msib) >= child_x_left(m) )  .AND.                 &
    843                                   ( child_x_right(msib) <= child_x_right(m) )
    844                 m_south_in_msib = ( child_y_south(m) >= child_y_south(msib) )  .AND.                &
    845                                   ( child_y_south(m) <= child_y_north(msib) )
    846                 m_north_in_msib = ( child_y_north(m) >= child_y_south(msib) )  .AND.                &
    847                                   ( child_y_north(m) <= child_y_north(msib) )
    848                 msib_south_in_m = ( child_y_south(msib) >= child_y_south(m) )  .AND.                &
    849                                   ( child_y_south(msib) <= child_y_north(m) )
    850                 msib_north_in_m = ( child_y_north(msib) >= child_y_south(m) )  .AND.                &
    851                                   ( child_y_north(msib) <= child_y_north(m) )
     835!--             Set some logical auxiliary parameters to simplify the IF-condition.                 
     836                m_left_in_msib  = ( child_x_left(m)  >= child_x_left(msib)  - tolex )  .AND.        &
     837                                  ( child_x_left(m)  <= child_x_right(msib) + tolex )
     838                m_right_in_msib = ( child_x_right(m) >= child_x_left(msib)  - tolex )  .AND.        &
     839                                  ( child_x_right(m) <= child_x_right(msib) + tolex )
     840                msib_left_in_m  = ( child_x_left(msib)  >= child_x_left(m)  - tolex )  .AND.        &
     841                                  ( child_x_left(msib)  <= child_x_right(m) + tolex )
     842                msib_right_in_m = ( child_x_right(msib) >= child_x_left(m)  - tolex )  .AND.        &
     843                                  ( child_x_right(msib) <= child_x_right(m) + tolex )
     844                m_south_in_msib = ( child_y_south(m) >= child_y_south(msib) - toley )  .AND.        &
     845                                  ( child_y_south(m) <= child_y_north(msib) + toley )
     846                m_north_in_msib = ( child_y_north(m) >= child_y_south(msib) - toley )  .AND.        &
     847                                  ( child_y_north(m) <= child_y_north(msib) + toley )
     848                msib_south_in_m = ( child_y_south(msib) >= child_y_south(m) - toley )  .AND.        &
     849                                  ( child_y_south(msib) <= child_y_north(m) + toley )
     850                msib_north_in_m = ( child_y_north(msib) >= child_y_south(m) - toley )  .AND.        &
     851                                  ( child_y_north(msib) <= child_y_north(m) + toley )
    852852               
    853853                IF ( ( m_left_in_msib  .OR.  m_right_in_msib  .OR.                                  &
     
    13331333       INTEGER(iwp) ::  jauxn   !< Offset between the index bound jpn and the auxiliary index bound jpna
    13341334
     1335       REAL(wp) ::  tolex       !< Tolerance for grid-line matching in x-direction   
     1336       REAL(wp) ::  toley       !< Tolerance for grid-line matching in y-direction   
    13351337       REAL(wp) ::  xexl        !< Parent-grid array exceedance behind the left edge of the child PE subdomain
    13361338       REAL(wp) ::  xexr        !< Parent-grid array exceedance behind the right edge of the child PE subdomain
     
    13551357!--    included in the neighbouring subdomain's parent-grid array, or not included at all if
    13561358!--    we are at the outer edge of the child domain. This may occur especially when a large
    1357 !--    grid-spacing ratio is used.       
     1359!--    grid-spacing ratio is used.
     1360!
     1361!--    Tolerances for grid-line matching.
     1362       tolex = tolefac * dx
     1363       toley = tolefac * dy
    13581364!
    13591365!--    Left boundary.
     
    13681374       xpl     = coord_x(nxl) - xexl
    13691375       DO  ip = 0, pg%nx
    1370           IF ( pg%coord_x(ip) + 0.5_wp * pg%dx >= xpl )  THEN  ! Consider changing xpl to xpl - tolex
     1376          IF ( pg%coord_x(ip) + 0.5_wp * pg%dx >= xpl - tolex )  THEN
    13711377             ipl = MAX( 0, ip )
    13721378             EXIT
     
    13851391       xpr  = coord_x(nxr+1) + xexr
    13861392       DO  ip = pg%nx, 0 , -1
    1387           IF ( pg%coord_x(ip) + 0.5_wp * pg%dx <= xpr )  THEN  ! Consider changing xpr to xpr + tolex
     1393          IF ( pg%coord_x(ip) + 0.5_wp * pg%dx <= xpr + tolex )  THEN
    13881394             ipr = MIN( pg%nx, MAX( ipl, ip ) )
    13891395             EXIT
     
    14021408       yps  = coord_y(nys) - yexs
    14031409       DO  jp = 0, pg%ny
    1404           IF ( pg%coord_y(jp) + 0.5_wp * pg%dy >= yps )  THEN  ! Consider changing yps to yps - toley
     1410          IF ( pg%coord_y(jp) + 0.5_wp * pg%dy >= yps - toley )  THEN             
    14051411             jps = MAX( 0, jp )
    14061412             EXIT
     
    14191425       ypn  = coord_y(nyn+1) + yexn
    14201426       DO  jp = pg%ny, 0 , -1
    1421           IF ( pg%coord_y(jp) + 0.5_wp * pg%dy <= ypn )  THEN  ! Consider changing ypn to ypn + toley
     1427          IF ( pg%coord_y(jp) + 0.5_wp * pg%dy <= ypn + toley )  THEN
    14221428             jpn = MIN( pg%ny, MAX( jps, jp ) )
    14231429             EXIT
     
    15551561!--    First determine kcto and kctw which refer to the uppermost
    15561562!--    parent-grid levels below the child top-boundary level.
     1563!--    Note that these comparison tests are not round-off-error
     1564!--    sensitive and therefore tolerance buffering is not needed here.
    15571565       kk = 0
    15581566       DO WHILE ( pg%zu(kk) <= zu(nzt) )
     
    16081616!--       are passed as arguments to the interpolation and anterpolation
    16091617!--       subroutines.
     1618!--       Note that this comparison test is round-off-error sensitive
     1619!--       and therefore tolerance buffering is needed here.
    16101620          i = istart
    16111621          DO WHILE ( pg%coord_x(ii) - coord_x(i) > tolex  .AND. i < nxrg )
     
    16231633       WRITE( 9, * )
    16241634!
    1625 !--    i-indices of others for each ii-index value
     1635!--    i-indices of others for each ii-index value.
     1636!--    Note that these comparison tests are not round-off-error
     1637!--    sensitive and therefore tolerance buffering is not needed here.
    16261638       istart = nxlg
    16271639       DO  ii = ipla, ipra
     
    16551667!--       are passed as arguments to the interpolation and anterpolation
    16561668!--       subroutines.
     1669!--       Note that this comparison test is round-off-error sensitive
     1670!--       and therefore tolerance buffering is needed here.
    16571671          j = jstart
    16581672          DO WHILE ( pg%coord_y(jj) - coord_y(j) > toley  .AND. j < nyng )
     
    16711685!
    16721686!--    j-indices of others for each jj-index value
     1687!--    Note that these comparison tests are not round-off-error
     1688!--    sensitive and therefore tolerance buffering is not needed here.
    16731689       jstart = nysg
    16741690       DO  jj = jpsa, jpna
     
    17061722!--       are passed as arguments to the interpolation and anterpolation
    17071723!--       subroutines.
     1724!--       Note that this comparison test is round-off-error sensitive
     1725!--       and therefore tolerance buffering is needed here.
    17081726          k = kstart
    17091727          DO WHILE ( ( pg%zw(kk) - zw(k) > tolez )  .AND.  ( k < nzt+1 ) )
     
    17281746!--    Note that anterpolation index limits are needed also for the top boundary
    17291747!--    ghost cell level because they are used also in the interpolation.
     1748!--    Note that these comparison tests are not round-off-error
     1749!--    sensitive and therefore tolerance buffering is not needed here.
    17301750       DO  kk = 1, pg%nz+1
    17311751          k = kstart
     
    17411761          kstart = kflo(kk)
    17421762       ENDDO
    1743 !
    1744 !--    Set the k-index bounds separately for the parent-grid cells pg%nz and pg%nz+1       
    1745 !--    although they are not actually needed.
    1746 !  WHY IS THIS LIKE THIS? REVISE WITH CARE.
    1747        kflo(pg%nz)   = nzt+1   
    1748        kfuo(pg%nz)   = nzt+kgsr
    1749        kflo(pg%nz+1) = nzt+kgsr
    1750        kfuo(pg%nz+1) = nzt+kgsr
    17511763!
    17521764!--    Print out the index bounds for checking and debugging purposes
     
    45214533!--   values. This subroutine is based on the first-order numerical
    45224534!--   integration of the child-grid values contained within the anterpolation
    4523 !--   cell.
     4535!--   cell (Clark & Farley, Journal of the Atmospheric Sciences 41(3), 1984).
    45244536
    45254537      IMPLICIT NONE
Note: See TracChangeset for help on using the changeset viewer.