Changeset 3634 for palm/trunk/SOURCE/surface_mod.f90
- Timestamp:
- Dec 18, 2018 12:31:28 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/surface_mod.f90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/surface_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 pt_2m and renamed t_surf_10cm to pt_10cm. Removed some _eb variables as 29 32 ! they are no longer used. … … 608 611 END INTERFACE init_surface_arrays 609 612 613 INTERFACE enter_surface_arrays 614 MODULE PROCEDURE enter_surface_arrays 615 END INTERFACE 616 617 INTERFACE exit_surface_arrays 618 MODULE PROCEDURE exit_surface_arrays 619 END INTERFACE 620 610 621 INTERFACE surface_rrd_local 611 622 MODULE PROCEDURE surface_rrd_local … … 634 645 !-- Public subroutines and functions 635 646 PUBLIC get_topography_top_index, get_topography_top_index_ji, init_bc, & 636 init_surfaces, init_surface_arrays, surface_rrd_local, & 637 surface_restore_elements, surface_wrd_local, surface_last_actions 647 init_surfaces, init_surface_arrays, enter_surface_arrays, & 648 exit_surface_arrays, surface_rrd_local, surface_restore_elements, & 649 surface_wrd_local, surface_last_actions 638 650 639 651 … … 1084 1096 1085 1097 END SUBROUTINE init_surface_arrays 1098 1099 1100 !------------------------------------------------------------------------------! 1101 ! Description: 1102 ! ------------ 1103 !> Enter horizontal and vertical surfaces. 1104 !------------------------------------------------------------------------------! 1105 SUBROUTINE enter_surface_arrays 1106 1107 IMPLICIT NONE 1108 1109 INTEGER(iwp) :: l !< 1110 1111 !$ACC ENTER DATA & 1112 !$ACC COPYIN(surf_def_h(0:2)) & 1113 !$ACC COPYIN(surf_def_v(0:3)) & 1114 !$ACC COPYIN(surf_lsm_h) & 1115 !$ACC COPYIN(surf_lsm_v(0:3)) & 1116 !$ACC COPYIN(surf_usm_h) & 1117 !$ACC COPYIN(surf_usm_v(0:3)) 1118 1119 ! Copy data in surf_def_h(0:2) 1120 DO l = 0, 1 1121 CALL enter_surface_attributes_h(surf_def_h(l)) 1122 ENDDO 1123 CALL enter_surface_attributes_h_top(surf_def_h(2)) 1124 ! Copy data in surf_def_v(0:3) 1125 DO l = 0, 3 1126 CALL enter_surface_attributes_v(surf_def_v(l)) 1127 ENDDO 1128 ! Copy data in surf_lsm_h 1129 CALL enter_surface_attributes_h(surf_lsm_h) 1130 ! Copy data in surf_lsm_v(0:3) 1131 DO l = 0, 3 1132 CALL enter_surface_attributes_v(surf_lsm_v(l)) 1133 ENDDO 1134 ! Copy data in surf_usm_h 1135 CALL enter_surface_attributes_h(surf_usm_h) 1136 ! Copy data in surf_usm_v(0:3) 1137 DO l = 0, 3 1138 CALL enter_surface_attributes_v(surf_usm_v(l)) 1139 ENDDO 1140 1141 END SUBROUTINE enter_surface_arrays 1142 1143 1144 !------------------------------------------------------------------------------! 1145 ! Description: 1146 ! ------------ 1147 !> Exit horizontal and vertical surfaces. 1148 !------------------------------------------------------------------------------! 1149 SUBROUTINE exit_surface_arrays 1150 1151 IMPLICIT NONE 1152 1153 INTEGER(iwp) :: l !< 1154 1155 ! Delete data in surf_def_h(0:2) 1156 DO l = 0, 1 1157 CALL exit_surface_attributes_h(surf_def_h(l)) 1158 ENDDO 1159 CALL exit_surface_attributes_h(surf_def_h(2)) 1160 ! Delete data in surf_def_v(0:3) 1161 DO l = 0, 3 1162 CALL exit_surface_attributes_v(surf_def_v(l)) 1163 ENDDO 1164 ! Delete data in surf_lsm_h 1165 CALL exit_surface_attributes_h(surf_lsm_h) 1166 ! Delete data in surf_lsm_v(0:3) 1167 DO l = 0, 3 1168 CALL exit_surface_attributes_v(surf_lsm_v(l)) 1169 ENDDO 1170 ! Delete data in surf_usm_h 1171 CALL exit_surface_attributes_h(surf_usm_h) 1172 ! Delete data in surf_usm_v(0:3) 1173 DO l = 0, 3 1174 CALL exit_surface_attributes_v(surf_usm_v(l)) 1175 ENDDO 1176 1177 !$ACC EXIT DATA & 1178 !$ACC DELETE(surf_def_h(0:2)) & 1179 !$ACC DELETE(surf_def_v(0:3)) & 1180 !$ACC DELETE(surf_lsm_h) & 1181 !$ACC DELETE(surf_lsm_v(0:3)) & 1182 !$ACC DELETE(surf_usm_h) & 1183 !$ACC DELETE(surf_usm_v(0:3)) 1184 1185 END SUBROUTINE exit_surface_arrays 1086 1186 1087 1187 … … 1328 1428 ! Description: 1329 1429 ! ------------ 1430 !> Exit memory for upward and downward-facing horizontal surface types, 1431 !> except for top fluxes. 1432 !------------------------------------------------------------------------------! 1433 SUBROUTINE exit_surface_attributes_h( surfaces ) 1434 1435 IMPLICIT NONE 1436 1437 TYPE(surf_type) :: surfaces !< respective surface type 1438 1439 !$ACC EXIT DATA & 1440 !$ACC DELETE(surfaces%start_index(nys:nyn,nxl:nxr)) & 1441 !$ACC DELETE(surfaces%end_index(nys:nyn,nxl:nxr)) & 1442 !$ACC DELETE(surfaces%i(1:surfaces%ns)) & 1443 !$ACC DELETE(surfaces%j(1:surfaces%ns)) & 1444 !$ACC DELETE(surfaces%k(1:surfaces%ns)) & 1445 !$ACC DELETE(surfaces%z_mo(1:surfaces%ns)) & 1446 !$ACC DELETE(surfaces%uvw_abs(1:surfaces%ns)) & 1447 !$ACC DELETE(surfaces%z0(1:surfaces%ns)) & 1448 !$ACC COPYOUT(surfaces%us(1:surfaces%ns)) & 1449 !$ACC COPYOUT(surfaces%ol(1:surfaces%ns)) & 1450 !$ACC DELETE(surfaces%rib(1:surfaces%ns)) & 1451 !$ACC COPYOUT(surfaces%usws(1:surfaces%ns)) & 1452 !$ACC COPYOUT(surfaces%vsws(1:surfaces%ns)) & 1453 !$ACC COPYOUT(surfaces%ts(1:surfaces%ns)) & 1454 !$ACC COPYOUT(surfaces%shf(1:surfaces%ns)) & 1455 !$ACC DELETE(surfaces%pt_surface(1:surfaces%ns)) & 1456 !$ACC DELETE(surfaces%pt1(1:surfaces%ns)) & 1457 !$ACC DELETE(surfaces%qv1(1:surfaces%ns)) 1458 1459 IF ( .NOT. constant_diffusion ) THEN 1460 !$ACC EXIT DATA & 1461 !$ACC DELETE(surfaces%u_0(1:surfaces%ns)) & 1462 !$ACC DELETE(surfaces%v_0(1:surfaces%ns)) 1463 ENDIF 1464 1465 END SUBROUTINE exit_surface_attributes_h 1466 1467 1468 !------------------------------------------------------------------------------! 1469 ! Description: 1470 ! ------------ 1471 !> Enter memory for upward and downward-facing horizontal surface types, 1472 !> except for top fluxes. 1473 !------------------------------------------------------------------------------! 1474 SUBROUTINE enter_surface_attributes_h( surfaces ) 1475 1476 IMPLICIT NONE 1477 1478 TYPE(surf_type) :: surfaces !< respective surface type 1479 1480 !$ACC ENTER DATA & 1481 !$ACC COPYIN(surfaces%start_index(nys:nyn,nxl:nxr)) & 1482 !$ACC COPYIN(surfaces%end_index(nys:nyn,nxl:nxr)) & 1483 !$ACC COPYIN(surfaces%i(1:surfaces%ns)) & 1484 !$ACC COPYIN(surfaces%j(1:surfaces%ns)) & 1485 !$ACC COPYIN(surfaces%k(1:surfaces%ns)) & 1486 !$ACC COPYIN(surfaces%z_mo(1:surfaces%ns)) & 1487 !$ACC COPYIN(surfaces%uvw_abs(1:surfaces%ns)) & 1488 !$ACC COPYIN(surfaces%z0(1:surfaces%ns)) & 1489 !$ACC COPYIN(surfaces%us(1:surfaces%ns)) & 1490 !$ACC COPYIN(surfaces%ol(1:surfaces%ns)) & 1491 !$ACC COPYIN(surfaces%rib(1:surfaces%ns)) & 1492 !$ACC COPYIN(surfaces%usws(1:surfaces%ns)) & 1493 !$ACC COPYIN(surfaces%vsws(1:surfaces%ns)) & 1494 !$ACC COPYIN(surfaces%ts(1:surfaces%ns)) & 1495 !$ACC COPYIN(surfaces%shf(1:surfaces%ns)) & 1496 !$ACC COPYIN(surfaces%pt1(1:surfaces%ns)) & 1497 !$ACC COPYIN(surfaces%qv1(1:surfaces%ns)) & 1498 !$ACC COPYIN(surfaces%pt_surface(1:surfaces%ns)) 1499 1500 IF ( .NOT. constant_diffusion ) THEN 1501 !$ACC ENTER DATA & 1502 !$ACC COPYIN(surfaces%u_0(1:surfaces%ns)) & 1503 !$ACC COPYIN(surfaces%v_0(1:surfaces%ns)) 1504 ENDIF 1505 1506 END SUBROUTINE enter_surface_attributes_h 1507 1508 1509 !------------------------------------------------------------------------------! 1510 ! Description: 1511 ! ------------ 1330 1512 !> Deallocating memory for model-top fluxes 1331 1513 !------------------------------------------------------------------------------! … … 1460 1642 1461 1643 END SUBROUTINE allocate_surface_attributes_h_top 1644 1645 1646 !------------------------------------------------------------------------------! 1647 ! Description: 1648 ! ------------ 1649 !> Exit memory for model-top fluxes. 1650 !------------------------------------------------------------------------------! 1651 SUBROUTINE exit_surface_attributes_h_top( surfaces ) 1652 1653 IMPLICIT NONE 1654 1655 TYPE(surf_type) :: surfaces !< respective surface type 1656 1657 !$ACC EXIT DATA & 1658 !$ACC DELETE(surfaces%start_index(nys:nyn,nxl:nxr)) & 1659 !$ACC DELETE(surfaces%end_index(nys:nyn,nxl:nxr)) & 1660 !$ACC DELETE(surfaces%i(1:surfaces%ns)) & 1661 !$ACC DELETE(surfaces%j(1:surfaces%ns)) & 1662 !$ACC DELETE(surfaces%k(1:surfaces%ns)) & 1663 !$ACC DELETE(surfaces%usws(1:surfaces%ns)) & 1664 !$ACC DELETE(surfaces%vsws(1:surfaces%ns)) & 1665 !$ACC DELETE(surfaces%shf(1:surfaces%ns)) 1666 1667 IF ( .NOT. constant_diffusion ) THEN 1668 !$ACC EXIT DATA & 1669 !$ACC DELETE(surfaces%u_0(1:surfaces%ns)) & 1670 !$ACC DELETE(surfaces%v_0(1:surfaces%ns)) 1671 ENDIF 1672 1673 END SUBROUTINE exit_surface_attributes_h_top 1674 1675 1676 !------------------------------------------------------------------------------! 1677 ! Description: 1678 ! ------------ 1679 !> Enter memory for model-top fluxes. 1680 !------------------------------------------------------------------------------! 1681 SUBROUTINE enter_surface_attributes_h_top( surfaces ) 1682 1683 IMPLICIT NONE 1684 1685 TYPE(surf_type) :: surfaces !< respective surface type 1686 1687 !$ACC ENTER DATA & 1688 !$ACC COPYIN(surfaces%start_index(nys:nyn,nxl:nxr)) & 1689 !$ACC COPYIN(surfaces%end_index(nys:nyn,nxl:nxr)) & 1690 !$ACC COPYIN(surfaces%i(1:surfaces%ns)) & 1691 !$ACC COPYIN(surfaces%j(1:surfaces%ns)) & 1692 !$ACC COPYIN(surfaces%k(1:surfaces%ns)) & 1693 !$ACC COPYIN(surfaces%usws(1:surfaces%ns)) & 1694 !$ACC COPYIN(surfaces%vsws(1:surfaces%ns)) & 1695 !$ACC COPYIN(surfaces%shf(1:surfaces%ns)) 1696 1697 IF ( .NOT. constant_diffusion ) THEN 1698 !$ACC ENTER DATA & 1699 !$ACC COPYIN(surfaces%u_0(1:surfaces%ns)) & 1700 !$ACC COPYIN(surfaces%v_0(1:surfaces%ns)) 1701 ENDIF 1702 1703 END SUBROUTINE enter_surface_attributes_h_top 1462 1704 1463 1705 … … 1703 1945 1704 1946 END SUBROUTINE allocate_surface_attributes_v 1947 1948 1949 !------------------------------------------------------------------------------! 1950 ! Description: 1951 ! ------------ 1952 !> Exit memory for vertical surface types. 1953 !------------------------------------------------------------------------------! 1954 SUBROUTINE exit_surface_attributes_v( surfaces ) 1955 1956 IMPLICIT NONE 1957 1958 TYPE(surf_type) :: surfaces !< respective surface type 1959 1960 !$ACC EXIT DATA & 1961 !$ACC DELETE(surfaces%start_index(nys:nyn,nxl:nxr)) & 1962 !$ACC DELETE(surfaces%end_index(nys:nyn,nxl:nxr)) & 1963 !$ACC DELETE(surfaces%i(1:surfaces%ns)) & 1964 !$ACC DELETE(surfaces%j(1:surfaces%ns)) & 1965 !$ACC DELETE(surfaces%k(1:surfaces%ns)) & 1966 !$ACC DELETE(surfaces%uvw_abs(1:surfaces%ns)) & 1967 !$ACC DELETE(surfaces%z0(1:surfaces%ns)) & 1968 !$ACC DELETE(surfaces%rib(1:surfaces%ns)) & 1969 !$ACC DELETE(surfaces%mom_flux_uv(1:surfaces%ns)) & 1970 !$ACC DELETE(surfaces%mom_flux_w(1:surfaces%ns)) & 1971 !$ACC DELETE(surfaces%mom_flux_tke(0:1,1:surfaces%ns)) & 1972 !$ACC DELETE(surfaces%ts(1:surfaces%ns)) & 1973 !$ACC DELETE(surfaces%shf(1:surfaces%ns)) & 1974 !$ACC DELETE(surfaces%pt1(1:surfaces%ns)) & 1975 !$ACC DELETE(surfaces%qv1(1:surfaces%ns)) 1976 1977 END SUBROUTINE exit_surface_attributes_v 1978 1979 1980 !------------------------------------------------------------------------------! 1981 ! Description: 1982 ! ------------ 1983 !> Enter memory for vertical surface types. 1984 !------------------------------------------------------------------------------! 1985 SUBROUTINE enter_surface_attributes_v( surfaces ) 1986 1987 IMPLICIT NONE 1988 1989 TYPE(surf_type) :: surfaces !< respective surface type 1990 1991 !$ACC ENTER DATA & 1992 !$ACC COPYIN(surfaces%start_index(nys:nyn,nxl:nxr)) & 1993 !$ACC COPYIN(surfaces%end_index(nys:nyn,nxl:nxr)) & 1994 !$ACC COPYIN(surfaces%i(1:surfaces%ns)) & 1995 !$ACC COPYIN(surfaces%j(1:surfaces%ns)) & 1996 !$ACC COPYIN(surfaces%k(1:surfaces%ns)) & 1997 !$ACC COPYIN(surfaces%uvw_abs(1:surfaces%ns)) & 1998 !$ACC COPYIN(surfaces%z0(1:surfaces%ns)) & 1999 !$ACC COPYIN(surfaces%rib(1:surfaces%ns)) & 2000 !$ACC COPYIN(surfaces%mom_flux_uv(1:surfaces%ns)) & 2001 !$ACC COPYIN(surfaces%mom_flux_w(1:surfaces%ns)) & 2002 !$ACC COPYIN(surfaces%mom_flux_tke(0:1,1:surfaces%ns)) & 2003 !$ACC COPYIN(surfaces%ts(1:surfaces%ns)) & 2004 !$ACC COPYIN(surfaces%shf(1:surfaces%ns)) & 2005 !$ACC COPYIN(surfaces%pt1(1:surfaces%ns)) & 2006 !$ACC COPYIN(surfaces%qv1(1:surfaces%ns)) 2007 2008 END SUBROUTINE enter_surface_attributes_v 1705 2009 1706 2010
Note: See TracChangeset
for help on using the changeset viewer.
