Ignore:
Timestamp:
Dec 18, 2018 12:31:28 PM (3 years ago)
Author:
knoop
Message:

OpenACC port for SPEC

File:
1 edited

Legend:

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

    r3597 r3634  
    2626! -----------------
    2727! $Id$
     28! OpenACC port for SPEC
     29!
     30! 3597 2018-12-04 08:40:18Z maronga
    2831! Added pt_2m and renamed t_surf_10cm to pt_10cm. Removed some _eb variables as
    2932! they are no longer used.
     
    608611    END INTERFACE init_surface_arrays
    609612
     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
    610621    INTERFACE surface_rrd_local
    611622       MODULE PROCEDURE surface_rrd_local
     
    634645!-- Public subroutines and functions
    635646    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
    638650
    639651
     
    10841096
    10851097    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
    10861186
    10871187
     
    13281428! Description:
    13291429! ------------
     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! ------------
    13301512!> Deallocating memory for model-top fluxes 
    13311513!------------------------------------------------------------------------------!
     
    14601642
    14611643    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
    14621704
    14631705
     
    17031945
    17041946    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
    17052009
    17062010
Note: See TracChangeset for help on using the changeset viewer.