Changeset 4260 for palm/trunk/SOURCE/pmc_interface_mod.f90
- Timestamp:
- Oct 9, 2019 2:04:03 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/pmc_interface_mod.f90 (modified) (26 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_interface_mod.f90
r4249 r4260 25 25 ! ----------------- 26 26 ! $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 27 31 ! Several grid-line matching tests changed to a round-off-error tolerant form 28 32 ! in pmci_setup_parent, pmci_define_index_mapping and pmci_check_grid_matching. … … 509 513 SUBROUTINE pmci_init( world_comm ) 510 514 511 USE control_parameters, &515 USE control_parameters, & 512 516 ONLY: message_string 513 517 … … 521 525 522 526 523 CALL pmc_init_model( world_comm, nesting_datatransfer_mode, nesting_mode, &527 CALL pmc_init_model( world_comm, nesting_datatransfer_mode, nesting_mode, & 524 528 anterpolation_buffer_width, pmc_status ) 525 529 … … 536 540 ! 537 541 !-- 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' ) & 541 545 THEN 542 546 message_string = 'illegal nesting mode: ' // TRIM( nesting_mode ) … … 544 548 ENDIF 545 549 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' ) & 549 553 THEN 550 message_string = 'illegal nesting datatransfer mode: ' & 551 // TRIM( nesting_datatransfer_mode ) 554 message_string = 'illegal nesting datatransfer mode: ' // TRIM( nesting_datatransfer_mode ) 552 555 CALL message( 'pmci_init', 'PA0418', 3, 2, 0, 6, 0 ) 553 556 ENDIF … … 558 561 !-- Get some variables required by the pmc-interface (and in some cases in the 559 562 !-- 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, & 564 567 lower_left_y = lower_left_coord_y ) 565 568 ! … … 688 691 REAL(wp) :: yez !< Minimum separation in the y-direction required between the child and 689 692 !< 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 692 695 REAL(wp) :: tolez !< Tolerance for grid-line matching in z-direction 693 696 … … 752 755 child_height = child_grid_info(1) 753 756 ! 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 756 758 DO kp = 1, nzt 757 ! IF ( zw(kp) > child_height ) THEN758 759 IF ( zw(kp) - child_height > tolez ) THEN 759 760 nz_child = kp … … 790 791 right_limit = upper_right_coord_x 791 792 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 form793 ( child_coord_y(ny_child+1) /= north_limit) ) THEN793 IF ( ( ABS( child_coord_x(nx_child+1) - right_limit ) > tolex ) .OR. & 794 ( ABS( child_coord_y(ny_child+1) - north_limit ) > toley ) ) THEN 794 795 nomatch = 1 795 796 ENDIF … … 812 813 ENDIF 813 814 ! 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 818 818 nomatch = 1 819 819 ENDIF … … 833 833 DO msib = 1, m - 1 834 834 ! 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 ) 852 852 853 853 IF ( ( m_left_in_msib .OR. m_right_in_msib .OR. & … … 1333 1333 INTEGER(iwp) :: jauxn !< Offset between the index bound jpn and the auxiliary index bound jpna 1334 1334 1335 REAL(wp) :: tolex !< Tolerance for grid-line matching in x-direction 1336 REAL(wp) :: toley !< Tolerance for grid-line matching in y-direction 1335 1337 REAL(wp) :: xexl !< Parent-grid array exceedance behind the left edge of the child PE subdomain 1336 1338 REAL(wp) :: xexr !< Parent-grid array exceedance behind the right edge of the child PE subdomain … … 1355 1357 !-- included in the neighbouring subdomain's parent-grid array, or not included at all if 1356 1358 !-- 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 1358 1364 ! 1359 1365 !-- Left boundary. … … 1368 1374 xpl = coord_x(nxl) - xexl 1369 1375 DO ip = 0, pg%nx 1370 IF ( pg%coord_x(ip) + 0.5_wp * pg%dx >= xpl ) THEN ! Consider changing xpl to xpl - tolex1376 IF ( pg%coord_x(ip) + 0.5_wp * pg%dx >= xpl - tolex ) THEN 1371 1377 ipl = MAX( 0, ip ) 1372 1378 EXIT … … 1385 1391 xpr = coord_x(nxr+1) + xexr 1386 1392 DO ip = pg%nx, 0 , -1 1387 IF ( pg%coord_x(ip) + 0.5_wp * pg%dx <= xpr ) THEN ! Consider changing xpr to xpr + tolex1393 IF ( pg%coord_x(ip) + 0.5_wp * pg%dx <= xpr + tolex ) THEN 1388 1394 ipr = MIN( pg%nx, MAX( ipl, ip ) ) 1389 1395 EXIT … … 1402 1408 yps = coord_y(nys) - yexs 1403 1409 DO jp = 0, pg%ny 1404 IF ( pg%coord_y(jp) + 0.5_wp * pg%dy >= yps ) THEN ! Consider changing yps to yps - toley1410 IF ( pg%coord_y(jp) + 0.5_wp * pg%dy >= yps - toley ) THEN 1405 1411 jps = MAX( 0, jp ) 1406 1412 EXIT … … 1419 1425 ypn = coord_y(nyn+1) + yexn 1420 1426 DO jp = pg%ny, 0 , -1 1421 IF ( pg%coord_y(jp) + 0.5_wp * pg%dy <= ypn ) THEN ! Consider changing ypn to ypn + toley1427 IF ( pg%coord_y(jp) + 0.5_wp * pg%dy <= ypn + toley ) THEN 1422 1428 jpn = MIN( pg%ny, MAX( jps, jp ) ) 1423 1429 EXIT … … 1555 1561 !-- First determine kcto and kctw which refer to the uppermost 1556 1562 !-- 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. 1557 1565 kk = 0 1558 1566 DO WHILE ( pg%zu(kk) <= zu(nzt) ) … … 1608 1616 !-- are passed as arguments to the interpolation and anterpolation 1609 1617 !-- subroutines. 1618 !-- Note that this comparison test is round-off-error sensitive 1619 !-- and therefore tolerance buffering is needed here. 1610 1620 i = istart 1611 1621 DO WHILE ( pg%coord_x(ii) - coord_x(i) > tolex .AND. i < nxrg ) … … 1623 1633 WRITE( 9, * ) 1624 1634 ! 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. 1626 1638 istart = nxlg 1627 1639 DO ii = ipla, ipra … … 1655 1667 !-- are passed as arguments to the interpolation and anterpolation 1656 1668 !-- subroutines. 1669 !-- Note that this comparison test is round-off-error sensitive 1670 !-- and therefore tolerance buffering is needed here. 1657 1671 j = jstart 1658 1672 DO WHILE ( pg%coord_y(jj) - coord_y(j) > toley .AND. j < nyng ) … … 1671 1685 ! 1672 1686 !-- 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. 1673 1689 jstart = nysg 1674 1690 DO jj = jpsa, jpna … … 1706 1722 !-- are passed as arguments to the interpolation and anterpolation 1707 1723 !-- subroutines. 1724 !-- Note that this comparison test is round-off-error sensitive 1725 !-- and therefore tolerance buffering is needed here. 1708 1726 k = kstart 1709 1727 DO WHILE ( ( pg%zw(kk) - zw(k) > tolez ) .AND. ( k < nzt+1 ) ) … … 1728 1746 !-- Note that anterpolation index limits are needed also for the top boundary 1729 1747 !-- 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. 1730 1750 DO kk = 1, pg%nz+1 1731 1751 k = kstart … … 1741 1761 kstart = kflo(kk) 1742 1762 ENDDO 1743 !1744 !-- Set the k-index bounds separately for the parent-grid cells pg%nz and pg%nz+11745 !-- although they are not actually needed.1746 ! WHY IS THIS LIKE THIS? REVISE WITH CARE.1747 kflo(pg%nz) = nzt+11748 kfuo(pg%nz) = nzt+kgsr1749 kflo(pg%nz+1) = nzt+kgsr1750 kfuo(pg%nz+1) = nzt+kgsr1751 1763 ! 1752 1764 !-- Print out the index bounds for checking and debugging purposes … … 4521 4533 !-- values. This subroutine is based on the first-order numerical 4522 4534 !-- integration of the child-grid values contained within the anterpolation 4523 !-- cell .4535 !-- cell (Clark & Farley, Journal of the Atmospheric Sciences 41(3), 1984). 4524 4536 4525 4537 IMPLICIT NONE
Note: See TracChangeset
for help on using the changeset viewer.
