Changeset 3634 for palm/trunk/SOURCE/surface_layer_fluxes_mod.f90
- Timestamp:
- Dec 18, 2018 12:31:28 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/surface_layer_fluxes_mod.f90 (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/surface_layer_fluxes_mod.f90
r3597 r3634 26 26 ! ----------------- 27 27 ! $Id$ 28 ! OpenACC port for SPEC 29 ! 30 ! 3597 2018-12-04 08:40:18Z maronga 28 31 ! Added routine for calculating near surface air potential temperature (moved 29 32 ! from urban_surface_mod) … … 1009 1012 ibit = MERGE( 1, 0, .NOT. downward ) 1010 1013 1014 !$ACC PARALLEL LOOP PRIVATE(i, j, k, w_lfc) & 1015 !$ACC PRESENT(surf, u, v) 1011 1016 DO m = 1, surf%ns 1012 1017 … … 1297 1302 ELSE 1298 1303 !$OMP PARALLEL DO PRIVATE( k, z_mo ) 1304 !$ACC PARALLEL LOOP PRIVATE(k, z_mo) & 1305 !$ACC PRESENT(surf, drho_air_zw) 1299 1306 DO m = 1, surf%ns 1300 1307 … … 1319 1326 IF ( TRIM( most_method ) == 'newton' ) THEN 1320 1327 1328 !$ACC PARALLEL LOOP PRIVATE(i, j, z_mo) & 1329 !$ACC PRIVATE(ol_old, ol_m, ol_l, ol_u, f, f_d_ol) & 1330 !$ACC PRESENT(surf) 1321 1331 DO m = 1, surf%ns 1322 1332 … … 1575 1585 IF ( .NOT. downward ) THEN 1576 1586 !$OMP PARALLEL DO PRIVATE( z_mo ) 1587 !$ACC PARALLEL LOOP PRIVATE(z_mo) & 1588 !$ACC PRESENT(surf) 1577 1589 DO m = 1, surf%ns 1578 1590 … … 1591 1603 ELSE 1592 1604 !$OMP PARALLEL DO PRIVATE( z_mo ) 1605 !$ACC PARALLEL LOOP PRIVATE(z_mo) & 1606 !$ACC PRESENT(surf) 1593 1607 DO m = 1, surf%ns 1594 1608 … … 1605 1619 ELSE 1606 1620 !$OMP PARALLEL DO PRIVATE( z_mo ) 1621 !$ACC PARALLEL LOOP PRIVATE(z_mo) & 1622 !$ACC PRESENT(surf) 1607 1623 DO m = 1, surf%ns 1608 1624 z_mo = surf%z_mo(m) … … 1624 1640 1625 1641 !$OMP PARALLEL DO PRIVATE( i, j, k ) 1642 !$ACC PARALLEL LOOP PRIVATE(i, j, k) & 1643 !$ACC PRESENT(surf, pt) 1626 1644 DO m = 1, surf%ns 1627 1645 … … 1630 1648 k = surf%k(m) 1631 1649 1650 #ifndef _OPENACC 1632 1651 IF ( bulk_cloud_model ) THEN 1633 1652 surf%pt1(m) = pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i) … … 1637 1656 surf%qv1(m) = q(k,j,i) 1638 1657 ELSE 1658 #endif 1639 1659 surf%pt1(m) = pt(k,j,i) 1660 #ifndef _OPENACC 1640 1661 IF ( humidity ) THEN 1641 1662 surf%qv1(m) = q(k,j,i) 1642 1663 ELSE 1664 #endif 1643 1665 surf%qv1(m) = 0.0_wp 1666 #ifndef _OPENACC 1644 1667 ENDIF 1645 1668 ENDIF … … 1648 1671 surf%vpt1(m) = pt(k,j,i) * ( 1.0_wp + 0.61_wp * q(k,j,i) ) 1649 1672 ENDIF 1673 #endif 1650 1674 1651 1675 ENDDO … … 1658 1682 !-- ( only for upward-facing surfs ) 1659 1683 SUBROUTINE calc_pt_surface 1684 1685 IMPLICIT NONE 1686 1687 INTEGER(iwp) :: k_off !< index offset between surface and atmosphere grid point (-1 for upward-, +1 for downward-facing walls) 1688 INTEGER(iwp) :: m !< loop variable over all horizontal surf elements 1689 1690 k_off = surf%koff 1691 !$OMP PARALLEL DO PRIVATE( i, j, k ) 1692 !$ACC PARALLEL LOOP PRIVATE(i, j, k) & 1693 !$ACC PRESENT(surf, pt) 1694 DO m = 1, surf%ns 1695 1696 i = surf%i(m) 1697 j = surf%j(m) 1698 k = surf%k(m) 1699 1700 surf%pt_surface(m) = pt(k+k_off,j,i) 1701 1702 ENDDO 1703 1704 END SUBROUTINE calc_pt_surface 1705 1706 ! 1707 !-- Set mixing ratio at surface grid level. ( Only for upward-facing surfs. ) 1708 SUBROUTINE calc_q_surface 1709 1710 IMPLICIT NONE 1711 1712 INTEGER(iwp) :: k_off !< index offset between surface and atmosphere grid point (-1 for upward-, +1 for downward-facing walls) 1713 INTEGER(iwp) :: m !< loop variable over all horizontal surf elements 1714 1715 k_off = surf%koff 1716 !$OMP PARALLEL DO PRIVATE( i, j, k ) 1717 DO m = 1, surf%ns 1718 1719 i = surf%i(m) 1720 j = surf%j(m) 1721 k = surf%k(m) 1722 1723 surf%q_surface(m) = q(k+k_off,j,i) 1724 1725 ENDDO 1726 1727 END SUBROUTINE calc_q_surface 1728 1729 ! 1730 !-- Set virtual potential temperature at surface grid level. 1731 !-- ( only for upward-facing surfs ) 1732 SUBROUTINE calc_vpt_surface 1660 1733 1661 1734 IMPLICIT NONE … … 1672 1745 k = surf%k(m) 1673 1746 1674 surf%pt_surface(m) = pt(k+k_off,j,i)1675 1676 ENDDO1677 1678 END SUBROUTINE calc_pt_surface1679 1680 !1681 !-- Set mixing ratio at surface grid level. ( Only for upward-facing surfs. )1682 SUBROUTINE calc_q_surface1683 1684 IMPLICIT NONE1685 1686 INTEGER(iwp) :: k_off !< index offset between surface and atmosphere grid point (-1 for upward-, +1 for downward-facing walls)1687 INTEGER(iwp) :: m !< loop variable over all horizontal surf elements1688 1689 k_off = surf%koff1690 !$OMP PARALLEL DO PRIVATE( i, j, k )1691 DO m = 1, surf%ns1692 1693 i = surf%i(m)1694 j = surf%j(m)1695 k = surf%k(m)1696 1697 surf%q_surface(m) = q(k+k_off,j,i)1698 1699 ENDDO1700 1701 END SUBROUTINE calc_q_surface1702 1703 !1704 !-- Set virtual potential temperature at surface grid level.1705 !-- ( only for upward-facing surfs )1706 SUBROUTINE calc_vpt_surface1707 1708 IMPLICIT NONE1709 1710 INTEGER(iwp) :: k_off !< index offset between surface and atmosphere grid point (-1 for upward-, +1 for downward-facing walls)1711 INTEGER(iwp) :: m !< loop variable over all horizontal surf elements1712 1713 k_off = surf%koff1714 !$OMP PARALLEL DO PRIVATE( i, j, k )1715 DO m = 1, surf%ns1716 1717 i = surf%i(m)1718 j = surf%j(m)1719 k = surf%k(m)1720 1721 1747 surf%vpt_surface(m) = vpt(k+k_off,j,i) 1722 1748 … … 1741 1767 1742 1768 !$OMP PARALLEL DO PRIVATE( i, j, k ) 1769 !$ACC PARALLEL LOOP PRIVATE(i, j, k) & 1770 !$ACC PRESENT(surf, drho_air_zw) 1743 1771 DO m = 1, surf%ns 1744 1772 … … 2039 2067 IF ( .NOT. downward ) THEN 2040 2068 !$OMP PARALLEL DO PRIVATE( i, j, k, z_mo ) 2069 !$ACC PARALLEL LOOP PRIVATE(i, j, k, z_mo) & 2070 !$ACC PRESENT(surf, u, rho_air_zw) 2041 2071 DO m = 1, surf%ns 2042 2072 … … 2086 2116 IF ( .NOT. downward ) THEN 2087 2117 !$OMP PARALLEL DO PRIVATE( i, j, k, z_mo ) 2118 !$ACC PARALLEL LOOP PRIVATE(i, j, k, z_mo) & 2119 !$ACC PRESENT(surf, v, rho_air_zw) 2088 2120 DO m = 1, surf%ns 2089 2121 i = surf%i(m) … … 2392 2424 !-- Integrated stability function for momentum 2393 2425 FUNCTION psi_m( zeta ) 2426 !$ACC ROUTINE SEQ 2394 2427 2395 2428 USE kinds … … 2429 2462 !-- Integrated stability function for heat and moisture 2430 2463 FUNCTION psi_h( zeta ) 2464 !$ACC ROUTINE SEQ 2431 2465 2432 2466 USE kinds … … 2469 2503 !------------------------------------------------------------------------------! 2470 2504 FUNCTION phi_m( zeta ) 2505 !$ACC ROUTINE SEQ 2471 2506 2472 2507 IMPLICIT NONE
Note: See TracChangeset
for help on using the changeset viewer.
