Changeset 4260 for palm/trunk
 Timestamp:
 Oct 9, 2019 2:04:03 PM (22 months ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

palm/trunk/SOURCE/pmc_interface_mod.f90
r4249 r4260 25 25 !  26 26 ! $Id$ 27 ! Rest of the possibly roundofferror sensitive gridline matching tests 28 ! changed to roundofferror tolerant forms throughout the module. 29 ! 30 ! 4249 20191001 12:27:47Z hellstea 27 31 ! Several gridline matching tests changed to a roundofferror 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 ) /= 'oneway' .AND. &539 TRIM( nesting_mode ) /= 'twoway' .AND. &540 TRIM( nesting_mode ) /= 'vertical' ) &542 IF ( TRIM( nesting_mode ) /= 'oneway' .AND. & 543 TRIM( nesting_mode ) /= 'twoway' .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 pmcinterface (and in some cases in the 559 562 ! PALM code out of the pmci) out of the pmccore 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 ydirection required between the child and 689 692 !< parent boundaries (south or north) 690 REAL(wp) :: tolex !< Tolerance for gridline matching in xdirection 691 REAL(wp) :: toley !< Tolerance for gridline matching in ydirection 693 REAL(wp) :: tolex !< Tolerance for gridline matching in xdirection 694 REAL(wp) :: toley !< Tolerance for gridline matching in ydirection 692 695 REAL(wp) :: tolez !< Tolerance for gridline matching in zdirection 693 696 … … 752 755 child_height = child_grid_info(1) 753 756 ! 754 ! Find the highest childdomain level in the parent grid for the reduced z 755 ! transfer 757 ! Find the highest childdomain 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 roundofferror 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 IFtest 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 IFcondition. 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 IFcondition. 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 gridline matching in xdirection 1336 REAL(wp) :: toley !< Tolerance for gridline matching in ydirection 1335 1337 REAL(wp) :: xexl !< Parentgrid array exceedance behind the left edge of the child PE subdomain 1336 1338 REAL(wp) :: xexr !< Parentgrid array exceedance behind the right edge of the child PE subdomain … … 1355 1357 ! included in the neighbouring subdomain's parentgrid 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 ! gridspacing ratio is used. 1359 ! gridspacing ratio is used. 1360 ! 1361 ! Tolerances for gridline 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 ! parentgrid levels below the child topboundary level. 1563 ! Note that these comparison tests are not roundofferror 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 roundofferror 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 ! iindices of others for each iiindex value 1635 ! iindices of others for each iiindex value. 1636 ! Note that these comparison tests are not roundofferror 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 roundofferror 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 ! jindices of others for each jjindex value 1687 ! Note that these comparison tests are not roundofferror 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 roundofferror 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 roundofferror 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 kindex bounds separately for the parentgrid 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 firstorder numerical 4522 4534 ! integration of the childgrid 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.