diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 4cc0f22f2..7979fbf64 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -19,7 +19,7 @@ on: env: ECWAM_TOOLS: ${{ github.workspace }}/.github/tools CTEST_PARALLEL_LEVEL: 1 - CACHE_SUFFIX: v0 # Increase to force new cache to be created + CACHE_SUFFIX: v1 # Increase to force new cache to be created jobs: ci: @@ -31,12 +31,13 @@ jobs: matrix: #build_type: [Release,Debug] # Debug tests takes too long build_type: [Release] + prec: ['DP', 'SP'] name: - linux gnu-10 - - linux clang-12 + - linux gnu-14 + - linux nvhpc-23.5 - linux intel-classic - macos - # - linux nvhpc-21.9 include: @@ -46,41 +47,35 @@ jobs: compiler_cc: gcc-10 compiler_cxx: g++-10 compiler_fc: gfortran-10 + python-version: '3.8' caching: true - - name: linux clang-12 - os: ubuntu-20.04 - compiler: clang-12 - compiler_cc: clang-12 - compiler_cxx: clang++-12 - compiler_fc: gfortran-10 + - name: linux gnu-14 + os: ubuntu-24.04 + compiler: gnu-14 + compiler_cc: gcc-14 + compiler_cxx: g++-14 + compiler_fc: gfortran-14 + python-version: '3.11' caching: true - - name: linux clang-12 - build_type: Release + - name: linux nvhpc-23.5 os: ubuntu-20.04 - compiler: clang-12 - compiler_cc: clang-12 - compiler_cxx: clang++-12 - compiler_fc: gfortran-10 + compiler: nvhpc-23.5 + compiler_cc: nvc + compiler_cxx: nvc++ + compiler_fc: nvfortran + cmake_options: -DCMAKE_CXX_FLAGS=--diag_suppress177 + python-version: '3.8' caching: true -# Disable due to problematic environment -# - name: linux nvhpc-21.9 -# os: ubuntu-20.04 -# compiler: nvhpc-21.9 -# compiler_cc: nvc -# compiler_cxx: nvc++ -# compiler_fc: nvfortran -# cmake_options: -DCMAKE_CXX_FLAGS=--diag_suppress177 -# caching: true - - name : linux intel-classic os: ubuntu-20.04 compiler: intel-classic compiler_cc: icc compiler_cxx: icpc compiler_fc: ifort + python-version: '3.8' caching: true - name: macos @@ -90,10 +85,16 @@ jobs: compiler_cc: ~ compiler_cxx: ~ compiler_fc: gfortran-13 + python-version: '3.11' caching: true runs-on: ${{ matrix.os }} steps: + - name: Set up Python ${{ matrix.python-version }} + uses: actions/setup-python@v5 + with: + python-version: ${{ matrix.python-version }} + - name: Checkout Repository uses: actions/checkout@v2 @@ -108,19 +109,15 @@ jobs: export HOMEBREW_NO_INSTALLED_DEPENDENTS_CHECK=1 export HOMEBREW_NO_AUTO_UPDATE=1 export HOMEBREW_NO_INSTALL_CLEANUP=1 + export SDKROOT=$(xcrun --show-sdk-path) echo "HOMEBREW_NO_INSTALLED_DEPENDENTS_CHECK=1" >> $GITHUB_ENV echo "HOMEBREW_NO_AUTO_UPDATE=1" >> $GITHUB_ENV echo "HOMEBREW_NO_INSTALL_CLEANUP=1" >> $GITHUB_ENV + echo "SDKROOT=$(xcrun --show-sdk-path)" >> $GITHUB_ENV brew install ninja brew install libomp brew install libaec brew install coreutils - brew install pyenv - - pyenv install 3.11.4 - pyenv global 3.11.4 - - echo "LOKI_PYTHON_ROOT_DIR=$HOME/.pyenv/versions/3.11.4/bin" >> $GITHUB_ENV else sudo apt-get update sudo apt-get install libaec-dev @@ -141,11 +138,30 @@ jobs: path: ${{ env.DEPS_DIR }} key: deps-${{ matrix.os }}-${{ matrix.compiler }}-${{ matrix.build_type }}-${{ env.CACHE_SUFFIX }} + # Free up disk space for nvhpc + - name: Free Disk Space (Ubuntu) + uses: jlumbroso/free-disk-space@main + if: contains( matrix.compiler, 'nvhpc' ) + continue-on-error: true + with: + # this might remove tools that are actually needed, + # if set to "true" but frees about 6 GB + tool-cache: false + + # all of these default to true, but feel free to set to + # "false" if necessary for your workflow + android: true + dotnet: true + haskell: true + large-packages: true + docker-images: true + swap-storage: true + - name: Install NVHPC compiler if: contains( matrix.compiler, 'nvhpc' ) shell: bash -eux {0} run: | - ${ECWAM_TOOLS}/install-nvhpc.sh --prefix /opt/nvhpc + ${ECWAM_TOOLS}/install-nvhpc.sh --prefix /opt/nvhpc --version 23.5 source /opt/nvhpc/env.sh echo "${NVHPC_DIR}/compilers/bin" >> $GITHUB_PATH [ -z ${MPI_HOME+x} ] || echo "MPI_HOME=${MPI_HOME}" >> $GITHUB_ENV @@ -181,22 +197,22 @@ jobs: self_coverage: false force_build: true cache_suffix: "${{ matrix.build_type }}-${{ env.CACHE_SUFFIX }}" - recreate_cache: true + recreate_cache: ${{ matrix.caching == false }} dependencies: | ecmwf/ecbuild ecmwf/eccodes ecmwf/fckit@refs/tags/0.13.0 ecmwf-ifs/fiat@refs/tags/1.4.1 ecmwf-ifs/field_api@refs/tags/v0.3.1 - ecmwf-ifs/loki@refs/tags/v0.2.4 + ecmwf-ifs/loki@refs/tags/v0.2.9 dependency_branch: develop dependency_cmake_options: | ecmwf/fckit: "-G Ninja -DCMAKE_BUILD_TYPE=${{ matrix.build_type }} -DENABLE_TESTS=OFF -DENABLE_FCKIT_VENV=ON" - ecmwf-ifs/fiat: "-G Ninja -DCMAKE_BUILD_TYPE=${{ matrix.build_type }} -DENABLE_TESTS=OFF" - ecmwf/eccodes: "-G Ninja -DCMAKE_BUILD_TYPE=${{ matrix.build_type }} -DENABLE_MEMFS=ON -DENABLE_JPG=OFF" - ecmwf-ifs/field_api: "-G Ninja -DCMAKE_BUILD_TYPE=${{ matrix.build_type }} -DENABLE_TESTS=OFF -DENABLE_ACC=OFF -DENABLE_SINGLE_PRECISION=OFF" - ecmwf-ifs/loki: "-G Ninja -DENABLE_TESTS=OFF -DENABLE_EDITABLE=ON -DPython3_ROOT_DIR=${{ env.LOKI_PYTHON_ROOT_DIR }} - cmake_options: "-G Ninja -DCMAKE_BUILD_TYPE=${{ matrix.build_type }} ${{ matrix.cmake_options }} -DENABLE_MPI=ON -DENABLE_LOKI=ON -DLOKI_MODE=idem-stack" + ecmwf-ifs/fiat: "-G Ninja -DCMAKE_BUILD_TYPE=${{ matrix.build_type }} -DENABLE_TESTS=OFF -DENABLE_SINGLE_PRECISION=${{ matrix.prec == 'SP' }} -DENABLE_DOUBLE_PRECISION=${{ matrix.prec == 'DP' }}" + ecmwf/eccodes: "-G Ninja -DCMAKE_BUILD_TYPE=${{ matrix.build_type }} -DENABLE_MEMFS=ON -DENABLE_JPG=OFF -DENABLE_PNG=OFF" + ecmwf-ifs/field_api: "-G Ninja -DCMAKE_BUILD_TYPE=${{ matrix.build_type }} -DENABLE_TESTS=OFF -DENABLE_ACC=OFF -DENABLE_SINGLE_PRECISION=${{ matrix.prec == 'SP' }} -DENABLE_DOUBLE_PRECISION=${{ matrix.prec == 'DP' }}" + ecmwf-ifs/loki: "-G Ninja -DCMAKE_BUILD_TYPE=${{ matrix.build_type }} -DENABLE_TESTS=OFF" + cmake_options: "-G Ninja -DCMAKE_BUILD_TYPE=${{ matrix.build_type }} ${{ matrix.cmake_options }} -DENABLE_MPI=ON -DENABLE_LOKI=ON -DLOKI_MODE=idem-stack -DENABLE_SINGLE_PRECISION=${{ matrix.prec == 'SP' }}" ctest_options: "${{ matrix.ctest_options }}" - name: Verify tools diff --git a/CMakeLists.txt b/CMakeLists.txt index d13953ca0..f38232bfa 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -44,7 +44,7 @@ ecbuild_add_option( FEATURE MPI ecbuild_add_option( FEATURE MULTIO DESCRIPTION "Support for IO to the FDB" - REQUIRED_PACKAGES "multio" ) + REQUIRED_PACKAGES "multio VERSION 2.1" ) ecbuild_add_option( FEATURE SINGLE_PRECISION DEFAULT OFF @@ -64,7 +64,7 @@ if( NOT DEFINED OCEAN_PREC ) endif() string( TOLOWER "${OCEAN_PREC}" ocean_prec ) -ecbuild_add_option( FEATURE OCEAN_COUPLING +ecbuild_add_option( FEATURE OCEAN_COUPLING DEFAULT ON DESCRIPTION "Support ocean coupling" REQUIRED_PACKAGES "nemo_${ocean_prec}" ) @@ -110,10 +110,11 @@ ecbuild_add_option( FEATURE LOKI REQUIRED_PACKAGES "loki" ) # Set default Loki transformation mode -set( LOKI_MODE "scc-hoist" CACHE STRING "Transformation mode for Loki source transformations" ) +set( LOKI_MODE "scc-stack" CACHE STRING "Transformation mode for Loki source transformations" ) ### OpenACC -if( ${CMAKE_VERSION} VERSION_LESS "3.25" AND (NOT DEFINED ENABLE_ACC OR ENABLE_ACC ) ) +if( ${CMAKE_VERSION} VERSION_LESS "3.25" AND HAVE_LOKI AND NOT LOKI_MODE MATCHES "idem|idem-stack" ) + if ( ${PNAME}_ENABLE_ACC OR (NOT DEFINED ${PNAME}_ENABLE_ACC AND ENABLE_ACC) ) # Incredibly inconvenient: FindOpenACC does _not_ set OpenACC_FOUND, only # the language-specific components OpenACC_Fortran_FOUND and OpenACC_C_FOUND. # This means, even internally CMake considers OpenACC as not found. @@ -124,19 +125,30 @@ if( ${CMAKE_VERSION} VERSION_LESS "3.25" AND (NOT DEFINED ENABLE_ACC OR ENABLE_A # and rectifies CMake's internal bookkeeping in the process. # This has been fixed in CMake 3.25 find_package( OpenACC ) - if( OpenACC_Fortran_FOUND AND OpenACC_C_FOUND ) + if( OpenACC_Fortran_FOUND ) set( OpenACC_FOUND ON ) endif() + endif() endif() ecbuild_add_option( FEATURE ACC DESCRIPTION "OpenACC" DEFAULT OFF - REQUIRED_PACKAGES "OpenACC" + REQUIRED_PACKAGES "OpenACC COMPONENTS Fortran" CONDITION HAVE_LOKI AND NOT LOKI_MODE MATCHES "idem|idem-stack" ) -### CUDA-aware MPI +### CUDA +include(CheckLanguage) +check_language(CUDA) +ecbuild_add_option( FEATURE CUDA + DESCRIPTION "CUDA" DEFAULT OFF + CONDITION CMAKE_CUDA_COMPILER AND HAVE_ACC ) +if( HAVE_CUDA ) + enable_language( CUDA ) +endif() + +### GPU-aware MPI ecbuild_add_option( FEATURE GPU_AWARE_MPI DEFAULT OFF - DESCRIPTION "Enable GPU-aware MPI" + DESCRIPTION "Enable GPU-aware MPI" CONDITION HAVE_ACC AND MPI_Fortran_HAVE_F08_MODULE ) ### Sources @@ -161,4 +173,3 @@ add_subdirectory(doc) ecbuild_install_project( NAME ${PROJECT_NAME} ) ecbuild_print_summary() - diff --git a/README.md b/README.md index e129f2a1e..7c18ce2b7 100644 --- a/README.md +++ b/README.md @@ -234,7 +234,8 @@ Building The recommended option for building the GPU enabled ecWAM is to use the provided bundle, and pass the `--with-loki --with-acc` options. Different Loki transformations can also be chosen at build-time via the following bundle option: `--loki-mode=`. Direct GPU-to-GPU MPI communications can be enabled by passing the -`--with-gpu-aware-mpi` option. +`--with-gpu-aware-mpi` option. CPU to GPU data transfers can be accelerated (via pinning of host-side allocations) +by building with the `--with-cuda` option. The ecwam-bundle also provides appropriate arch files for the nvhpc suite on the ECMWF ATOS system. @@ -242,8 +243,6 @@ Running ------- No extra run-time options are needed to run the GPU enabled ecWam. Please note that this means that if ecWam is built using the `--with-loki` and `--with-acc` bundle arguments, it will necessarily be offloaded for GPU execution. -For multi-GPU runs, the number of GPUs maps to the number of MPI ranks. Thus multiple GPUs can be requested by -launching with multiple MPI ranks. The mapping of MPI ranks to GPUs assumes at most 4 GPUs per host node. Environment variables --------------------- diff --git a/cmake/ecwam_expand_drv_types.cmake b/cmake/ecwam_expand_drv_types.cmake new file mode 100644 index 000000000..6006c4d6c --- /dev/null +++ b/cmake/ecwam_expand_drv_types.cmake @@ -0,0 +1,61 @@ +# (C) Copyright 2024- ECMWF. +# +# This software is licensed under the terms of the Apache Licence Version 2.0 +# which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +# In applying this licence, ECMWF does not waive the privileges and immunities +# granted to it by virtue of its status as an intergovernmental organisation +# nor does it submit to any jurisdiction. + + +# Read src/ecwam/yowdrvtype_config.yml and expand the derived-types accordingly. +# We create one sourcefile per derived-type because of *very* slow compilation times +# with nvfortran if they are all placed in the same module. Unfortunately the problem +# still persists even if compiler optimisations are disabled. + +macro( ecwam_expand_drv_types ) + + if( ${OCEAN_PREC} STREQUAL SP ) + list(APPEND FYPP_ARGS -DPARKIND1_SINGLE_NEMO) + endif() + + if( HAVE_LOKI AND NOT LOKI_MODE MATCHES "idem|idem-stack" ) + list(APPEND FYPP_ARGS -DWAM_GPU) + endif() + + execute_process( + COMMAND ${ECWAM_PYTHON_INTERP} -c + "import sys; sys.path.append('${CMAKE_CURRENT_SOURCE_DIR}/../../share/ecwam/scripts'); \ + from ecwam_yaml_reader import yaml; f = open('${CMAKE_CURRENT_SOURCE_DIR}/yowdrvtype_config.yml'); \ + yml = f.read(); f.close(); objtypes = yaml.safe_load(yml)['objtypes']; print(list(objtypes))" + RESULT_VARIABLE EXIT_CODE + OUTPUT_VARIABLE TYPE_NAMES + ERROR_QUIET + ) + + if( NOT EXIT_CODE EQUAL 0 ) + ecbuild_critical("${ECWAM_PROJECT_NAME} FAILED TO READ yowdrvtype_config.yml") + endif() + + string(REGEX MATCHALL "\'[A-Za-z0-9_]+\'" type_names "${TYPE_NAMES}") + + foreach(type IN LISTS type_names) + string(REPLACE "'" "" _type ${type}) + add_custom_command( + OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/${_type}_type_mod.F90 + COMMAND ${FYPP} ${FYPP_ARGS} -m io -m os -DTYPE_NAME='${_type}' + -M ${CMAKE_CURRENT_SOURCE_DIR}/../../share/ecwam/scripts -m ecwam_yaml_reader + ${CMAKE_CURRENT_SOURCE_DIR}/drvtype_mod.fypp > ${_type}_type_mod.F90 + DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/drvtype_mod.fypp + VERBATIM) + list( APPEND ecwam_srcs ${CMAKE_CURRENT_BINARY_DIR}/${_type}_type_mod.F90) + endforeach() + + add_custom_command( + OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/yowdrvtype.F90 + COMMAND ${FYPP} -m io -m os -M ${CMAKE_CURRENT_SOURCE_DIR}/../../share/ecwam/scripts -m ecwam_yaml_reader + ${CMAKE_CURRENT_SOURCE_DIR}/yowdrvtype.fypp > yowdrvtype.F90 + DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/yowdrvtype.fypp + VERBATIM) + list( APPEND ecwam_srcs ${CMAKE_CURRENT_BINARY_DIR}/yowdrvtype.F90) + +endmacro() diff --git a/cmake/ecwam_macros.cmake b/cmake/ecwam_macros.cmake index f2e17a278..3b73bec4f 100644 --- a/cmake/ecwam_macros.cmake +++ b/cmake/ecwam_macros.cmake @@ -42,3 +42,4 @@ include( ecwam_target_compile_definitions_FILENAME ) include( ecwam_add_test ) include( ecwam_cache_bathymetry ) include( ecwam_find_python_mods ) +include( ecwam_expand_drv_types ) diff --git a/package/bundle/bundle.yml b/package/bundle/bundle.yml index 7133ee706..fa5a19aee 100644 --- a/package/bundle/bundle.yml +++ b/package/bundle/bundle.yml @@ -39,7 +39,7 @@ projects : - loki : git : https://github.com/ecmwf-ifs/loki - version : v0.2.4 + version : v0.2.9 optional: true require : ecbuild cmake : > @@ -75,6 +75,11 @@ options : cmake : > ENABLE_ACC=ON + - with-cuda : + help : Enable FIELD_API CUDA backend + cmake : > + ENABLE_CUDA=ON + - without-loki-install : help : Skip installation of Loki (Requires Loki to be on the PATH) cmake : > diff --git a/requirements.txt b/requirements.txt new file mode 100644 index 000000000..945c9b46d --- /dev/null +++ b/requirements.txt @@ -0,0 +1 @@ +. \ No newline at end of file diff --git a/src/ecwam/CMakeLists.txt b/src/ecwam/CMakeLists.txt index fe1677104..5a5f34d31 100644 --- a/src/ecwam/CMakeLists.txt +++ b/src/ecwam/CMakeLists.txt @@ -272,7 +272,6 @@ list( APPEND ecwam_srcs w_mode_st.F90 w_pdf.F90 w_pmax.F90 - wam_init_gpu_mod.F90 wam_multio_mod.F90 wam_nproma.F90 wam_sorti.F90 @@ -324,7 +323,6 @@ list( APPEND ecwam_srcs yowcurg.F90 yowcurr.F90 yowdes.F90 - yowdrvtype.F90 yowfpbo.F90 yowfred.F90 yowgrib.F90 @@ -370,15 +368,12 @@ list( APPEND ecwam_srcs if(HAVE_LOKI AND NOT LOKI_MODE MATCHES "idem|idem-stack") list(APPEND ecwam_srcs wamintgr_loki_gpu.F90) list(REMOVE_ITEM ecwam_srcs wamintgr.F90) + list(APPEND ecwam_srcs cireduce_loki_gpu.F90) + list(APPEND ecwam_srcs outbs_loki_gpu.F90) endif() -list( APPEND ecwam_srcs ${CMAKE_CURRENT_BINARY_DIR}/yowfield_mod.F90) -add_custom_command( - OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/yowfield_mod.F90 - COMMAND ${FYPP} -m io -M ${CMAKE_CURRENT_SOURCE_DIR}/../../share/ecwam/scripts -m ecwam_yaml_reader -m os - ${CMAKE_CURRENT_SOURCE_DIR}/yowfield_mod.fypp > yowfield_mod.F90 - DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/yowfield_mod.fypp - VERBATIM) +# expand derived-types using src/ecwam/yowdrvtype_config.yml +ecwam_expand_drv_types() unset( MPI_Fortran_LIBRARIES ) if( HAVE_GPU_AWARE_MPI ) @@ -410,25 +405,18 @@ endif() set(MULTIO_LIBRARIES) if( HAVE_MULTIO ) - if( multio_HAVE_FDB5 ) - # Force the linkage of multio-fdb5 for static builds - if( NOT BUILD_SHARED_LIBS ) - list(APPEND MULTIO_LIBRARIES -Wl,--push-state,--no-as-needed multio-fdb5 -Wl,--pop-state) - else() - list(APPEND MULTIO_LIBRARIES multio-fdb5) - endif() - endif() + list(APPEND MULTIO_LIBRARIES multio-fapi) list(APPEND ECWAM_DEFINITIONS WAM_HAVE_MULTIO) endif() set( ${PNAME}_OCEANMODEL_LIBRARIES "" ) if( HAVE_OCEAN_COUPLING ) list(APPEND ECWAM_DEFINITIONS WITH_NEMO ) - if( ${OCEAN_PREC} STREQUAL SP ) - list(APPEND ECWAM_DEFINITIONS PARKIND1_SINGLE_NEMO ) - endif() set( ${PNAME}_OCEANMODEL_LIBRARIES nemogcmcoup.${OCEAN_PREC} ) endif() +if( ${OCEAN_PREC} STREQUAL SP ) + list(APPEND ECWAM_DEFINITIONS PARKIND1_SINGLE_NEMO ) +endif() if( HAVE_ECFLOW ) list(APPEND ECWAM_PRIVATE_DEFINITIONS WAM_HAVE_ECFLOW) @@ -456,15 +444,15 @@ ecbuild_add_library( PUBLIC_LIBS fiat parkind_${prec} ${ecwam}_intfb ${MPI_Fortran_LIBRARIES} ${${PNAME}_OCEANMODEL_LIBRARIES} + field_api_${prec} PRIVATE_LIBS eccodes_f90 ${MULTIO_LIBRARIES} ${OpenMP_Fortran_LIBRARIES} - field_api_${prec} $<${HAVE_ECFLOW}:ecflow_lightf> $<${HAVE_ACC}:OpenACC::OpenACC_Fortran> PUBLIC_INCLUDES $ PRIVATE_INCLUDES ${CMAKE_CURRENT_SOURCE_DIR} - PRIVATE_DEFINITIONS ${ECWAM_PRIVATE_DEFINITIONS} + PRIVATE_DEFINITIONS ${ECWAM_PRIVATE_DEFINITIONS} $<${HAVE_CUDA}:WAM_HAVE_CUDA> PUBLIC_DEFINITIONS ${ECWAM_DEFINITIONS} ) @@ -474,8 +462,13 @@ ecwam_target_fortran_module_directory( INSTALL_DIRECTORY module/${ecwam} ) -if( HAVE_ACC ) - target_compile_options( ${ecwam} PRIVATE "-gpu=maxregcount:128" ) +if( HAVE_ACC AND CMAKE_Fortran_COMPILER_ID MATCHES "PGI|NVHPC") + target_link_options( ${ecwam} INTERFACE SHELL:${OpenACC_Fortran_FLAGS} ) + target_compile_options( ${ecwam} PRIVATE "-gpu=maxregcount:168,fastmath" ) +endif() + +if( HAVE_CUDA ) + target_link_options( ${ecwam} PUBLIC "-cuda;-gpu=pinned" ) endif() ecwam_target_compile_definitions_FILENAME( ${ecwam} ) @@ -495,6 +488,12 @@ elseif(CMAKE_Fortran_COMPILER_ID MATCHES "PGI|NVHPC" AND CMAKE_BUILD_TYPE MATCHE sbottom.F90 PROPERTIES COMPILE_FLAGS " -g -O1 -Mflushz -Mno-signed-zeros " ) set_source_files_properties( mubuf.F90 PROPERTIES COMPILE_OPTIONS "-Mnofma" ) + if( HAVE_SINGLE_PRECISION ) + set_source_files_properties( aki.F90 PROPERTIES COMPILE_FLAGS " -g -O1 -Mflushz -Mno-signed-zeros " ) + set_source_files_properties( kurtosis.F90 PROPERTIES COMPILE_FLAGS " -g -O1 -Mflushz -Mno-signed-zeros " ) + set_source_files_properties( stat_nl.F90 PROPERTIES COMPILE_FLAGS " -g -O1 -Mflushz -Mno-signed-zeros " ) + set_source_files_properties( transf_bfi.F90 PROPERTIES COMPILE_FLAGS " -g -O1 -Mflushz -Mno-signed-zeros " ) + endif() elseif(CMAKE_Fortran_COMPILER_ID MATCHES "PGI|NVHPC" AND CMAKE_BUILD_TYPE MATCHES "Debug") string(REPLACE "-Ktrap=fp" "" ${PNAME}_Fortran_FLAGS_DEBUG ${${PNAME}_Fortran_FLAGS_DEBUG}) set_source_files_properties( outbeta.F90 PROPERTIES COMPILE_OPTIONS "${${PNAME}_Fortran_FLAGS_DEBUG} -Ktrap=divz") @@ -512,14 +511,12 @@ endif() if( HAVE_LOKI ) set( LOKI_FRONTEND "fp" CACHE STRING "Frontend parser for Loki source transformations" ) - set( SCC_ARGS "") if( LOKI_MODE MATCHES "idem|idem-stack" ) set( LOKI_CONFIG_FILE ${CMAKE_CURRENT_SOURCE_DIR}/ecwam_loki.config ) else() set( LOKI_CONFIG_FILE ${CMAKE_CURRENT_SOURCE_DIR}/ecwam_loki_gpu.config ) target_compile_definitions( ${ecwam} PRIVATE WAM_GPU ) - set( SCC_ARGS "TRIM_VECTOR_SECTIONS;GLOBAL_VAR_OFFLOAD") endif() # Apply Loki source file transformation to lib target @@ -529,7 +526,6 @@ if( HAVE_LOKI ) FRONTEND ${LOKI_FRONTEND} CONFIG ${LOKI_CONFIG_FILE} PLAN ${CMAKE_CURRENT_BINARY_DIR}/loki_plan_ecwam.cmake - ${SCC_ARGS} CPP DEFINITIONS WAM_GPU INCLUDES ${ecwam_intfb_includes} diff --git a/src/ecwam/airsea.F90 b/src/ecwam/airsea.F90 index d5e115074..515aaf094 100644 --- a/src/ecwam/airsea.F90 +++ b/src/ecwam/airsea.F90 @@ -58,7 +58,6 @@ SUBROUTINE AIRSEA (KIJS, KIJL, & USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU - USE YOWFRED , ONLY : NWAV_GC ! needed for Loki USE YOWPARAM, ONLY : NANG ,NFRE USE YOWPHYS, ONLY : XKAPPA, XNLEV USE YOWTEST, ONLY : IU06 @@ -93,6 +92,7 @@ SUBROUTINE AIRSEA (KIJS, KIJL, & IF (ICODE_WND == 3) THEN + !$loki inline CALL TAUT_Z0 (KIJS, KIJL, IUSFG, & & HALP, U10, U10DIR, TAUW, TAUWDIR, RNFAC, & & US, Z0, Z0B, CHRNCK) @@ -102,6 +102,7 @@ SUBROUTINE AIRSEA (KIJS, KIJL, & !* 3. DETERMINE ROUGHNESS LENGTH (if needed). ! --------------------------- + !$loki inline CALL Z0WAVE (KIJS, KIJL, US, TAUW, U10, Z0, Z0B, CHRNCK) !* 3. DETERMINE U10 (if needed). diff --git a/src/ecwam/aki.F90 b/src/ecwam/aki.F90 index f84058bbf..b75214dc3 100644 --- a/src/ecwam/aki.F90 +++ b/src/ecwam/aki.F90 @@ -52,6 +52,7 @@ REAL(KIND=JWRB) FUNCTION AKI(OM,BETA) ! ---------------------------------------------------------------------- IMPLICIT NONE +!$loki routine seq REAL(KIND=JWRB), INTENT(IN) :: OM, BETA diff --git a/src/ecwam/buildstress.F90 b/src/ecwam/buildstress.F90 index 468ac72bf..3333a09c9 100644 --- a/src/ecwam/buildstress.F90 +++ b/src/ecwam/buildstress.F90 @@ -110,7 +110,7 @@ SUBROUTINE BUILDSTRESS(BLK2LOC, WVENVI, FF_NOW, NEMO2WAM, IREAD) ENDIF - CALL FIELDG%ALLOC(NXS, NYS, UBND0=NXE, UBND1=NYE) + IF(.NOT. FIELDG%LALLOC) CALL FIELDG%ALLOC(LBOUNDS=[NXS, NYS], UBOUNDS=[NXE, NYE]) CDATEWO = ' ' CDAWIFL = ' ' diff --git a/src/ecwam/cal_second_order_spec.F90 b/src/ecwam/cal_second_order_spec.F90 index d6fc02e15..6e18c3246 100644 --- a/src/ecwam/cal_second_order_spec.F90 +++ b/src/ecwam/cal_second_order_spec.F90 @@ -52,8 +52,8 @@ SUBROUTINE CAL_SECOND_ORDER_SPEC(KIJS, KIJL, F1, WAVNUM, DEPTH, SIG) USE YOWPARAM, ONLY : NANG, NFRE USE YOWPCONS, ONLY : G, PI, ZPI USE YOWSHAL , ONLY : NDEPTH, DEPTHA, DEPTHD - USE YOWTABL , ONLY : MR, XMR, MA, XMA, NFREH, NANGH, NMAX, & - & OMEGA, DFDTH, THH, DELTHH, IM_P, IM_M, & + USE YOWTABL , ONLY : MR, XMR, MA, XMA, NFREH, NANGH, & + & OMEGA, DFDTH, THH, DELTHH, IM_P, IM_M, & & TA, TB, TC_QL, TT_4M, TT_4P USE YOWTEST , ONLY : IU06 @@ -66,9 +66,9 @@ SUBROUTINE CAL_SECOND_ORDER_SPEC(KIJS, KIJL, F1, WAVNUM, DEPTH, SIG) #include "secspom.intfb.h" INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE), INTENT(INOUT) :: F1 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NFRE), INTENT(IN) :: WAVNUM - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: DEPTH + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE), INTENT(INOUT) :: F1 + REAL(KIND=JWRB), DIMENSION(KIJL,NFRE), INTENT(IN) :: WAVNUM + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: DEPTH REAL(KIND=JWRB), INTENT(IN) :: SIG INTEGER(KIND=JWIM) :: IJ,M,K,K0,M0,MP,KP,MM,KM,KL,KLL,ML @@ -76,10 +76,10 @@ SUBROUTINE CAL_SECOND_ORDER_SPEC(KIJS, KIJL, F1, WAVNUM, DEPTH, SIG) REAL(KIND=JWRB) :: FRAC,CO1,DEL,DELF,D1,D2,D3,D4,C1 REAL(KIND=JWRB) :: C2,XM,XK,OMSTART,AREA,SUM,SUM1,SUM3,GAM_B_J,ZFAC REAL(KIND=JPHOOK) :: ZHOOK_HANDLE - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: EMEAN, FMEAN - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: F1MEAN, AKMEAN, XKMEAN, EMAXL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE) :: F3 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANGH,NFREH) :: PF1, PF3 + REAL(KIND=JWRB), DIMENSION(KIJL) :: EMEAN, FMEAN + REAL(KIND=JWRB), DIMENSION(KIJL) :: F1MEAN, AKMEAN, XKMEAN, EMAXL + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE) :: F3 + REAL(KIND=JWRB), DIMENSION(KIJL,NANGH,NFREH) :: PF1, PF3 !----------------------------------------------------------------------- @@ -104,8 +104,8 @@ SUBROUTINE CAL_SECOND_ORDER_SPEC(KIJS, KIJL, F1, WAVNUM, DEPTH, SIG) !*** 1.11 NO INTERPOLATION. ! ---------------------- - CALL SECSPOM(F1,F3,KIJS,KIJL,NFRE,NANG,NMAX,NDEPTH,DEPTHA, & - & DEPTHD,OMSTART,FRAC,MR,DFDTH,OMEGA,DEPTH, & + CALL SECSPOM(F1,F3,KIJS,KIJL,NFRE,NANG,NDEPTH,DEPTHA, & + & DEPTHD,OMSTART,FRAC,MR,DFDTH,OMEGA,DEPTH, & & AKMEAN,TA,TB,TC_QL,TT_4M,TT_4P,IM_P,IM_M) DO M=1,NFRE DO K=1,NANG @@ -138,8 +138,8 @@ SUBROUTINE CAL_SECOND_ORDER_SPEC(KIJS, KIJL, F1, WAVNUM, DEPTH, SIG) !*** 1.13 DETERMINE SECOND-ORDER SPEC ! -------------------------------- - CALL SECSPOM(PF1,PF3,KIJS,KIJL,NFREH,NANGH,NMAX,NDEPTH,DEPTHA, & - & DEPTHD,OMSTART,FRAC,MR,DFDTH,OMEGA,DEPTH, & + CALL SECSPOM(PF1,PF3,KIJS,KIJL,NFREH,NANGH,NDEPTH,DEPTHA, & + & DEPTHD,OMSTART,FRAC,MR,DFDTH,OMEGA,DEPTH, & & AKMEAN,TA,TB,TC_QL,TT_4M,TT_4P,IM_P,IM_M) !*** 2.24 INTERPOLATE TOWARDS HIGH-RES GRID diff --git a/src/ecwam/cdm.func.h b/src/ecwam/cdm.func.h new file mode 100644 index 000000000..c8446eeec --- /dev/null +++ b/src/ecwam/cdm.func.h @@ -0,0 +1,16 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + +! INLINE FUNCTION. +! ---------------- + +! Simple empirical fit to model drag coefficient + REAL(KIND=JWRB) :: CDM, U + + CDM(U) = MAX(MIN(0.0006_JWRB+0.00008_JWRB*U, 0.001_JWRB+0.0018_JWRB*EXP(-0.05_JWRB*(U-33._JWRB))),0.001_JWRB) \ No newline at end of file diff --git a/src/ecwam/cireduce_loki_gpu.F90 b/src/ecwam/cireduce_loki_gpu.F90 new file mode 100644 index 000000000..755588a3b --- /dev/null +++ b/src/ecwam/cireduce_loki_gpu.F90 @@ -0,0 +1,115 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + +SUBROUTINE CIREDUCE_LOKI_GPU (WVPRPT, FF_NOW) + +! ---------------------------------------------------------------------- + +!**** *CIREDUCE* - COMPUTE SEA ICE REDUCTION FACTOR FOR SOURCE TERMS +! AND THE SEA ICE WAVE ATTENUATION FACTORS + +! IF THERE IS NO SEA ICE INFORMATION OR +! ALL SEA ICE COVER POINTS WILL BE MASKED +! THEN CIWA WILL BE SET ON THE FIRST CALL. NOTHING WILL BE DONE +! IN ALL FOLLOWING CALLS + +!!!! currently also setting parametric sea ice thickness !!!! + +!* PURPOSE. +! -------- + +! CIREDUCE COMPUTES SEA ICE SOURCE TERM REDUCTION FACTOR. + +!** INTERFACE. +! ---------- + +! *CALL* *CIREDUCE (CGROUP, CICOVER, CITHICK, CIWA) + +! *CGROUP* - GROUP SPEED. +! *CICOVER* - SEA ICE COVER. +! *CITHICK* - SEA ICE THICKNESS. +! *CIWA*- SEA ICE WAVE ATTENUATION FACTOR. + +! METHOD. +! ------- + +! EXTERNALS. +! ---------- + + +! ---------------------------------------------------------------------- + + USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU + + USE YOWGRID , ONLY : NPROMA_WAM, NCHNK + USE YOWICE , ONLY : LICERUN ,LMASKICE + USE YOWPARAM , ONLY : NFRE + + USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK + USE YOWDRVTYPE ,ONLY: FREQUENCY, FORCING_FIELDS + USE YOWSTAT, ONLY: LUPDATE_GPU_GLOBALS + +! ---------------------------------------------------------------------- + IMPLICIT NONE + +#include "ciwaf.intfb.h" + + TYPE(FREQUENCY), INTENT(INOUT) :: WVPRPT + TYPE(FORCING_FIELDS), INTENT(IN) :: FF_NOW + + + INTEGER(KIND=JWIM) :: IJ, M + INTEGER(KIND=JWIM) :: ICHNK + + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + + LOGICAL, SAVE :: LLFRST + + DATA LLFRST / .TRUE. / + +! ---------------------------------------------------------------------- + +IF (LHOOK) CALL DR_HOOK('CIREDUCE',0,ZHOOK_HANDLE) + + IF( .NOT. LICERUN .OR. LMASKICE ) THEN + + IF (LLFRST) THEN + LLFRST=.FALSE. +! NO REDUCTION, EITHER THERE IS NO SEA ICE INFORMATION OR +! ALL SEA ICE COVER POINTS WILL BE MASKED + CALL GSTATS(1493,0) +!$acc kernels present(WVPRPT) + DO ICHNK = 1, NCHNK + WVPRPT%CIWA(:,:,ICHNK) = 1.0_JWRB + ENDDO +!$acc end kernels + CALL GSTATS(1493,1) + ENDIF + + ELSE + +IF(LUPDATE_GPU_GLOBALS)THEN +!$loki update_device +ENDIF + CALL GSTATS(1493,0) +! DETERMINE THE WAVE ATTENUATION FACTOR +!$acc data present(FF_NOW, WVPRPT) + + DO ICHNK = 1, NCHNK + CALL CIWAF(1, NPROMA_WAM, WVPRPT%CGROUP(:,:,ICHNK), FF_NOW%CICOVER(:,ICHNK), & +& FF_NOW%CITHICK(:,ICHNK), WVPRPT%CIWA(:,:,ICHNK)) + ENDDO + +!$acc end data + CALL GSTATS(1493,1) + ENDIF + +IF (LHOOK) CALL DR_HOOK('CIREDUCE',1,ZHOOK_HANDLE) + +END SUBROUTINE CIREDUCE_LOKI_GPU diff --git a/src/ecwam/ciwaf.F90 b/src/ecwam/ciwaf.F90 index 8db98e92b..00c1ad29d 100644 --- a/src/ecwam/ciwaf.F90 +++ b/src/ecwam/ciwaf.F90 @@ -60,10 +60,10 @@ SUBROUTINE CIWAF (KIJS, KIJL, CGROUP, CICOVER, CITHICK, CIWA) IMPLICIT NONE INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB),DIMENSION(KIJS:KIJL,NFRE), INTENT(IN) :: CGROUP - REAL(KIND=JWRB),DIMENSION(KIJS:KIJL), INTENT(IN) :: CICOVER - REAL(KIND=JWRB),DIMENSION(KIJS:KIJL), INTENT(IN) :: CITHICK - REAL(KIND=JWRB),DIMENSION(KIJS:KIJL,NFRE), INTENT(OUT) :: CIWA + REAL(KIND=JWRB),DIMENSION(KIJL,NFRE), INTENT(IN) :: CGROUP + REAL(KIND=JWRB),DIMENSION(KIJL), INTENT(IN) :: CICOVER + REAL(KIND=JWRB),DIMENSION(KIJL), INTENT(IN) :: CITHICK + REAL(KIND=JWRB),DIMENSION(KIJL,NFRE), INTENT(OUT) :: CIWA INTEGER(KIND=JWIM) :: ICM, I, MAXICM @@ -76,8 +76,8 @@ SUBROUTINE CIWAF (KIJS, KIJL, CGROUP, CICOVER, CITHICK, CIWA) REAL(KIND=JWRB) :: A, B, C REAL(KIND=JWRB) :: CIDEAC_INT, WT, WT1, WH, WH1 REAL(KIND=JPHOOK) :: ZHOOK_HANDLE - REAL(KIND=JWRB),DIMENSION(KIJS:KIJL) :: DINV - REAL(KIND=JWRB),DIMENSION(KIJS:KIJL,NFRE) :: ALP + REAL(KIND=JWRB),DIMENSION(KIJL) :: DINV + REAL(KIND=JWRB),DIMENSION(KIJL) :: ALP ! ---------------------------------------------------------------------- @@ -137,16 +137,14 @@ SUBROUTINE CIWAF (KIJS, KIJL, CGROUP, CICOVER, CITHICK, CIWA) CIDEAC_INT=WT*(WH*CIDEAC(IT,IH)+ WH1*CIDEAC(IT,IH1)) + & & WT1*(WH*CIDEAC(IT1,IH)+WH1*CIDEAC(IT1,IH1)) !!! ALP(IJ,M)=CICOVER(IJ)*CIDEAC_INT*DINV(IJ) - ALP(IJ,M)=CICOVER(IJ)*EXP(CIDEAC_INT)*DINV(IJ) + ALP(IJ)=CICOVER(IJ)*EXP(CIDEAC_INT)*DINV(IJ) ELSE - ALP(IJ,M)=0.0_JWRB + ALP(IJ)=0.0_JWRB ENDIF ENDDO - ENDDO - DO M=1,NFRE DO IJ=KIJS,KIJL - X=ALP(IJ,M)*CGROUP(IJ,M)*IDELT + X=ALP(IJ)*CGROUP(IJ,M)*IDELT IF(X.LT.EPSMIN) THEN CIWA(IJ,M)=1.0_JWRB ELSE IF(CICOVER(IJ) > CIBLOCK) THEN diff --git a/src/ecwam/ctcor.F90 b/src/ecwam/ctcor.F90 index c840ee7fb..69c144ab8 100644 --- a/src/ecwam/ctcor.F90 +++ b/src/ecwam/ctcor.F90 @@ -49,16 +49,16 @@ SUBROUTINE CTCOR (KIJS, KIJL, F, CTR) IMPLICIT NONE INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB), INTENT(IN) :: F(KIJS:KIJL,NANG,NFRE) - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: CTR + REAL(KIND=JWRB), INTENT(IN) :: F(KIJL,NANG,NFRE) + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: CTR INTEGER(KIND=JWIM) :: IJ, K, M REAL(KIND=JWRB) :: FR1M1, ZARG, ZAMP REAL(KIND=JPHOOK) :: ZHOOK_HANDLE - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: EM, ZT1 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: ZRHO, ZLAM - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL, NFRE) :: TEMP + REAL(KIND=JWRB), DIMENSION(KIJL) :: EM, ZT1 + REAL(KIND=JWRB), DIMENSION(KIJL) :: ZRHO, ZLAM + REAL(KIND=JWRB), DIMENSION(KIJL, NFRE) :: TEMP ! ---------------------------------------------------------------------- diff --git a/src/ecwam/ctuwupdt.F90 b/src/ecwam/ctuwupdt.F90 index 5a5e1006d..af657d692 100644 --- a/src/ecwam/ctuwupdt.F90 +++ b/src/ecwam/ctuwupdt.F90 @@ -87,8 +87,6 @@ SUBROUTINE CTUWUPDT (IJS, IJL, NINF, NSUP, & IF (LHOOK) CALL DR_HOOK('CTUWUPDT',0,ZHOOK_HANDLE) -!$acc update device(sinth,costh) -!$acc update device(COSPH, nang, nfre_red) ! DEFINE JXO, JYO, KCR IF (LFRSTCTU) THEN @@ -106,7 +104,7 @@ SUBROUTINE CTUWUPDT (IJS, IJL, NINF, NSUP, & IF (.NOT. ALLOCATED(JYO)) ALLOCATE(JYO(NANG,2)) IF (.NOT. ALLOCATED(KCR)) ALLOCATE(KCR(NANG,4)) -!$acc update device(KLON, KLAT, KCOR, JXO, JYO, KCR, KPM) +!$acc update device(JXO, JYO, KCR, KPM) !$acc kernels DO K=1,NANG @@ -195,8 +193,6 @@ SUBROUTINE CTUWUPDT (IJS, IJL, NINF, NSUP, & NPROMA=(IJL-IJS+1)/MTHREADS + 1 #ifdef _OPENACC -!$acc update device(WLAT,WCOR) -!$acc update device(NFRE_RED,ZPI,FR,DELTH,NANG) !$acc data present(KLAT,WLAT,KCOR,WCOR,WLATN,WLONN,WCORN) #else !$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JKGLO, KIJS, KIJL) @@ -352,8 +348,6 @@ SUBROUTINE CTUWUPDT (IJS, IJL, NINF, NSUP, & ENDIF -!$acc exit data delete(BLK2GLO) - IF (ALLOCATED(THDD)) DEALLOCATE(THDD) IF (ALLOCATED(THDC)) DEALLOCATE(THDC) IF (ALLOCATED(SDOT)) DEALLOCATE(SDOT) diff --git a/src/ecwam/dominant_period.F90 b/src/ecwam/dominant_period.F90 index 6f25aa588..8f1828477 100644 --- a/src/ecwam/dominant_period.F90 +++ b/src/ecwam/dominant_period.F90 @@ -57,14 +57,14 @@ SUBROUTINE DOMINANT_PERIOD (KIJS, KIJL, FL1, DP) INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE), INTENT(IN) :: FL1 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: DP + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE), INTENT(IN) :: FL1 + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: DP REAL(KIND=JWRB), PARAMETER :: FLTHRS = 0.1_JWRB INTEGER(KIND=JWIM) :: IJ, K, M - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: TEMP, EM, FCROP - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NFRE) :: F1D4 + REAL(KIND=JWRB), DIMENSION(KIJL) :: TEMP, EM, FCROP + REAL(KIND=JWRB), DIMENSION(KIJL,NFRE) :: F1D4 REAL(KIND=JPHOOK) :: ZHOOK_HANDLE diff --git a/src/ecwam/drvtype_mod.fypp b/src/ecwam/drvtype_mod.fypp new file mode 100644 index 000000000..2b25b4e47 --- /dev/null +++ b/src/ecwam/drvtype_mod.fypp @@ -0,0 +1,435 @@ +#! (C) Copyright 2022- ECMWF. +#! +#! This software is licensed under the terms of the Apache Licence Version 2.0 +#! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +#! In applying this licence, ECMWF does not waive the privileges and immunities +#! granted to it by virtue of its status as an intergovernmental organisation +#! nor does it submit to any jurisdiction. +#! +#! +#:mute +#:set f = io.open(os.path.dirname(_THIS_FILE_)+'/yowdrvtype_config.yml') +#:set ymlstring = f.read() +#:set input = ecwam_yaml_reader.yaml.safe_load(ymlstring) +#:set objtypes = input['objtypes'] +#:if defined('PARKIND1_SINGLE_NEMO') +#:set type2field = {'real': 'RB', 'int': 'IM', 'ocean': 'RM'} +#:else +#:set type2field = {'real': 'RB', 'int': 'IM', 'ocean': 'RD'} +#:endif +#:set type2dtype = {'real': 'REAL(KIND=JWRB)', 'int': 'INTEGER(KIND=JWIM)', 'ocean': 'REAL(KIND=JWRO)'} +$:f.close() +#:endmute +#! +#! +#:set obj = str(TYPE_NAME) +#:set _def = objtypes[obj] +MODULE ${obj.upper()}$_TYPE_MOD + + USE PARKIND_WAVE, ONLY : JWRB, JWIM, JWRO + USE FIELD_MODULE, ONLY : FIELD_3RB, FIELD_2IM, FIELD_2RB, FIELD_3IM, FIELD_4RB, FIELD_4IM, FIELD_2RD, & + & FIELD_2RM, FIELD_1IM, FIELD_1RB + USE FIELD_FACTORY_MODULE, ONLY : FIELD_NEW, FIELD_DELETE + IMPLICIT NONE + + PRIVATE + + TYPE ${obj.upper()}$ + #:set rank = _def['rank'] + #:for type, vars in zip(_def['types'], _def['vars']) + #:for var in vars + #:set field = ' CLASS(FIELD_' + str(rank) + type2field[type] + '), POINTER :: F_' + var.upper() + ' => NULL()' + #:set ptr = f' {type2dtype[type]}, POINTER, CONTIGUOUS :: ' + var.upper() + '(' + ','.join(':' * rank) + ') => NULL()' + $:field + $:ptr + #:endfor + #:endfor + LOGICAL :: LALLOC = .FALSE. + CONTAINS + PROCEDURE :: ALLOC => ${obj.upper()}$_ALLOC + PROCEDURE :: DEALLOC => ${obj.upper()}$_DEALLOC +#:if defined('WAM_GPU') + PROCEDURE :: SYNC_DEVICE_RDWR => ${obj.upper()}$_SYNC_DEVICE_RDWR + PROCEDURE :: SYNC_DEVICE_RDONLY => ${obj.upper()}$_SYNC_DEVICE_RDONLY + PROCEDURE :: SYNC_HOST_RDWR => ${obj.upper()}$_SYNC_HOST_RDWR + PROCEDURE :: SYNC_HOST_RDONLY => ${obj.upper()}$_SYNC_HOST_RDONLY + PROCEDURE :: GET_DEVICE_DATA_RDWR => ${obj.upper()}$_GET_DEVICE_DATA_RDWR + PROCEDURE :: GET_DEVICE_DATA_RDONLY => ${obj.upper()}$_GET_DEVICE_DATA_RDONLY + PROCEDURE :: GET_HOST_DATA_RDWR => ${obj.upper()}$_GET_HOST_DATA_RDWR + PROCEDURE :: GET_HOST_DATA_RDONLY => ${obj.upper()}$_GET_HOST_DATA_RDONLY + PROCEDURE :: DELETE_DEVICE_DATA => ${obj.upper()}$_DELETE_DEVICE_DATA +#:endif + END TYPE ${obj.upper()}$ + + PUBLIC :: ${obj.upper()}$ + + CONTAINS + + SUBROUTINE ${obj.upper()}$_ALLOC(SELF, UBOUNDS, LBOUNDS) + #:set rank = _def['rank'] + CLASS(${obj.upper()}$) :: SELF + INTEGER(KIND=JWIM), INTENT(IN) :: UBOUNDS(${rank}$) + INTEGER(KIND=JWIM), INTENT(IN), OPTIONAL :: LBOUNDS(${rank}$) + INTEGER(KIND=JWIM) :: LLBOUNDS(${rank}$) + + LLBOUNDS(:) = 1 + IF(PRESENT(LBOUNDS)) LLBOUNDS = LBOUNDS + + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + CALL FIELD_NEW(SELF%F_${var.upper()}$, LBOUNDS=LLBOUNDS, UBOUNDS=UBOUNDS, PERSISTENT=.TRUE.) + CALL SELF%F_${var.upper()}$%GET_HOST_DATA_RDWR(SELF%${var.upper()}$) + #:endfor + #:endfor + + SELF%LALLOC = .TRUE. + !$acc enter data copyin(SELF) + + END SUBROUTINE ${obj.upper()}$_ALLOC + + SUBROUTINE ${obj.upper()}$_DEALLOC(SELF) + CLASS(${obj.upper()}$) :: SELF + + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + NULLIFY(SELF%${var.upper()}$) + !$acc exit data detach(SELF%${var.upper()}$) + CALL FIELD_DELETE(SELF%F_${var.upper()}$) + NULLIFY(SELF%F_${var.upper()}$) + #:endfor + #:endfor + + SELF%LALLOC = .FALSE. + !$acc exit data delete(SELF) + + END SUBROUTINE ${obj.upper()}$_DEALLOC + +#:if defined('WAM_GPU') + SUBROUTINE ${obj.upper()}$_GET_DEVICE_DATA_RDWR(SELF, ${', '.join(var.upper() for _, vars in zip(_def['types'], _def['vars']) for var in vars)}$) + CLASS(${obj.upper()}$) :: SELF + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + #:set flag = ' LOGICAL, INTENT(IN), OPTIONAL :: ' + var.upper() + $:flag + #:set flag = ' LOGICAL :: ' + f'L_{var.upper()} = .FALSE.' + $:flag + #:endfor + #:endfor + + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + IF(PRESENT(${var.upper()}$)) L_${var.upper()}$ = ${var.upper()}$ + #:endfor + #:endfor + + + IF(${'.OR.'.join(f'L_{var.upper()}' for _, vars in zip(_def['types'], _def['vars']) for var in vars)}$)THEN + !... copy only selected members + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + IF(${f'L_{var.upper()}'}$)THEN + CALL SELF%F_${var.upper()}$%GET_DEVICE_DATA_RDWR(SELF%${var.upper()}$) + !$acc enter data attach(SELF%${var.upper()}$) + ENDIF + #:endfor + #:endfor + ELSE + !... copy entire struct + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + CALL SELF%F_${var.upper()}$%GET_DEVICE_DATA_RDWR(SELF%${var.upper()}$) + !$acc enter data attach(SELF%${var.upper()}$) + #:endfor + #:endfor + ENDIF + + END SUBROUTINE ${obj.upper()}$_GET_DEVICE_DATA_RDWR + + SUBROUTINE ${obj.upper()}$_GET_DEVICE_DATA_RDONLY(SELF, ${', '.join(var.upper() for _, vars in zip(_def['types'], _def['vars']) for var in vars)}$) + CLASS(${obj.upper()}$) :: SELF + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + #:set flag = ' LOGICAL, INTENT(IN), OPTIONAL :: ' + var.upper() + $:flag + #:set flag = ' LOGICAL :: ' + f'L_{var.upper()} = .FALSE.' + $:flag + #:endfor + #:endfor + + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + IF(PRESENT(${var.upper()}$)) L_${var.upper()}$ = ${var.upper()}$ + #:endfor + #:endfor + + + IF(${'.OR.'.join(f'L_{var.upper()}' for _, vars in zip(_def['types'], _def['vars']) for var in vars)}$)THEN + !... copy only selected members + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + IF(${f'L_{var.upper()}'}$)THEN + CALL SELF%F_${var.upper()}$%GET_DEVICE_DATA_RDONLY(SELF%${var.upper()}$) + !$acc enter data attach(SELF%${var.upper()}$) + ENDIF + #:endfor + #:endfor + ELSE + !... copy entire struct + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + CALL SELF%F_${var.upper()}$%GET_DEVICE_DATA_RDONLY(SELF%${var.upper()}$) + !$acc enter data attach(SELF%${var.upper()}$) + #:endfor + #:endfor + ENDIF + + END SUBROUTINE ${obj.upper()}$_GET_DEVICE_DATA_RDONLY + + SUBROUTINE ${obj.upper()}$_SYNC_DEVICE_RDWR(SELF, ${', '.join(var.upper() for _, vars in zip(_def['types'], _def['vars']) for var in vars)}$, QUEUE) + CLASS(${obj.upper()}$) :: SELF + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + #:set flag = ' LOGICAL, INTENT(IN), OPTIONAL :: ' + var.upper() + $:flag + #:set flag = ' LOGICAL :: ' + f'L_{var.upper()} = .FALSE.' + $:flag + #:endfor + #:endfor + INTEGER(KIND=JWIM), INTENT(IN), OPTIONAL :: QUEUE + + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + IF(PRESENT(${var.upper()}$)) L_${var.upper()}$ = ${var.upper()}$ + #:endfor + #:endfor + + + IF(${'.OR.'.join(f'L_{var.upper()}' for _, vars in zip(_def['types'], _def['vars']) for var in vars)}$)THEN + !... copy only selected members + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + IF(${f'L_{var.upper()}'}$)THEN + CALL SELF%F_${var.upper()}$%SYNC_DEVICE_RDWR(QUEUE=QUEUE) + ENDIF + #:endfor + #:endfor + ELSE + !... copy entire struct + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + CALL SELF%F_${var.upper()}$%SYNC_DEVICE_RDWR(QUEUE=QUEUE) + #:endfor + #:endfor + ENDIF + + END SUBROUTINE ${obj.upper()}$_SYNC_DEVICE_RDWR + + SUBROUTINE ${obj.upper()}$_SYNC_DEVICE_RDONLY(SELF, ${', '.join(var.upper() for _, vars in zip(_def['types'], _def['vars']) for var in vars)}$, QUEUE) + CLASS(${obj.upper()}$) :: SELF + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + #:set flag = ' LOGICAL, INTENT(IN), OPTIONAL :: ' + var.upper() + $:flag + #:set flag = ' LOGICAL :: ' + f'L_{var.upper()} = .FALSE.' + $:flag + #:endfor + #:endfor + INTEGER(KIND=JWIM), INTENT(IN), OPTIONAL :: QUEUE + + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + IF(PRESENT(${var.upper()}$)) L_${var.upper()}$ = ${var.upper()}$ + #:endfor + #:endfor + + + IF(${'.OR.'.join(f'L_{var.upper()}' for _, vars in zip(_def['types'], _def['vars']) for var in vars)}$)THEN + !... copy only selected members + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + IF(${f'L_{var.upper()}'}$)THEN + CALL SELF%F_${var.upper()}$%SYNC_DEVICE_RDONLY(QUEUE=QUEUE) + ENDIF + #:endfor + #:endfor + ELSE + !... copy entire struct + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + CALL SELF%F_${var.upper()}$%SYNC_DEVICE_RDONLY(QUEUE=QUEUE) + #:endfor + #:endfor + ENDIF + + END SUBROUTINE ${obj.upper()}$_SYNC_DEVICE_RDONLY + + SUBROUTINE ${obj.upper()}$_GET_HOST_DATA_RDONLY(SELF, ${', '.join(var.upper() for _, vars in zip(_def['types'], _def['vars']) for var in vars)}$) + CLASS(${obj.upper()}$) :: SELF + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + #:set flag = ' LOGICAL, INTENT(IN), OPTIONAL :: ' + var.upper() + $:flag + #:set flag = ' LOGICAL :: ' + f'L_{var.upper()} = .FALSE.' + $:flag + #:endfor + #:endfor + + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + IF(PRESENT(${var.upper()}$)) L_${var.upper()}$ = ${var.upper()}$ + #:endfor + #:endfor + + + IF(${'.OR.'.join(f'L_{var.upper()}' for _, vars in zip(_def['types'], _def['vars']) for var in vars)}$)THEN + !... copy only selected members + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + IF(${f'L_{var.upper()}'}$)THEN + !$acc exit data detach(SELF%${var.upper()}$) + CALL SELF%F_${var.upper()}$%GET_HOST_DATA_RDONLY(SELF%${var.upper()}$) + ENDIF + #:endfor + #:endfor + ELSE + !... copy entire struct + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + !$acc exit data detach(SELF%${var.upper()}$) + CALL SELF%F_${var.upper()}$%GET_HOST_DATA_RDONLY(SELF%${var.upper()}$) + #:endfor + #:endfor + ENDIF + + END SUBROUTINE ${obj.upper()}$_GET_HOST_DATA_RDONLY + + SUBROUTINE ${obj.upper()}$_GET_HOST_DATA_RDWR(SELF, ${', '.join(var.upper() for _, vars in zip(_def['types'], _def['vars']) for var in vars)}$) + CLASS(${obj.upper()}$) :: SELF + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + #:set flag = ' LOGICAL, INTENT(IN), OPTIONAL :: ' + var.upper() + $:flag + #:set flag = ' LOGICAL :: ' + f'L_{var.upper()} = .FALSE.' + $:flag + #:endfor + #:endfor + + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + IF(PRESENT(${var.upper()}$)) L_${var.upper()}$ = ${var.upper()}$ + #:endfor + #:endfor + + IF(${'.OR.'.join(f'L_{var.upper()}' for _, vars in zip(_def['types'], _def['vars']) for var in vars)}$)THEN + !... copy only selected members + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + IF(${f'L_{var.upper()}'}$)THEN + !$acc exit data detach(SELF%${var.upper()}$) + CALL SELF%F_${var.upper()}$%GET_HOST_DATA_RDWR(SELF%${var.upper()}$) + ENDIF + #:endfor + #:endfor + ELSE + !... copy entire struct + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + !$acc exit data detach(SELF%${var.upper()}$) + CALL SELF%F_${var.upper()}$%GET_HOST_DATA_RDWR(SELF%${var.upper()}$) + #:endfor + #:endfor + ENDIF + + END SUBROUTINE ${obj.upper()}$_GET_HOST_DATA_RDWR + + SUBROUTINE ${obj.upper()}$_SYNC_HOST_RDONLY(SELF, ${', '.join(var.upper() for _, vars in zip(_def['types'], _def['vars']) for var in vars)}$, QUEUE) + CLASS(${obj.upper()}$) :: SELF + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + #:set flag = ' LOGICAL, INTENT(IN), OPTIONAL :: ' + var.upper() + $:flag + #:set flag = ' LOGICAL :: ' + f'L_{var.upper()} = .FALSE.' + $:flag + #:endfor + #:endfor + INTEGER(KIND=JWIM), INTENT(IN), OPTIONAL :: QUEUE + + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + IF(PRESENT(${var.upper()}$)) L_${var.upper()}$ = ${var.upper()}$ + #:endfor + #:endfor + + + IF(${'.OR.'.join(f'L_{var.upper()}' for _, vars in zip(_def['types'], _def['vars']) for var in vars)}$)THEN + !... copy only selected members + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + IF(${f'L_{var.upper()}'}$)THEN + CALL SELF%F_${var.upper()}$%SYNC_HOST_RDONLY(QUEUE=QUEUE) + ENDIF + #:endfor + #:endfor + ELSE + !... copy entire struct + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + CALL SELF%F_${var.upper()}$%SYNC_HOST_RDONLY(QUEUE=QUEUE) + #:endfor + #:endfor + ENDIF + + END SUBROUTINE ${obj.upper()}$_SYNC_HOST_RDONLY + + SUBROUTINE ${obj.upper()}$_SYNC_HOST_RDWR(SELF, ${', '.join(var.upper() for _, vars in zip(_def['types'], _def['vars']) for var in vars)}$, QUEUE) + CLASS(${obj.upper()}$) :: SELF + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + #:set flag = ' LOGICAL, INTENT(IN), OPTIONAL :: ' + var.upper() + $:flag + #:set flag = ' LOGICAL :: ' + f'L_{var.upper()} = .FALSE.' + $:flag + #:endfor + #:endfor + INTEGER(KIND=JWIM), INTENT(IN), OPTIONAL :: QUEUE + + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + IF(PRESENT(${var.upper()}$)) L_${var.upper()}$ = ${var.upper()}$ + #:endfor + #:endfor + + + IF(${'.OR.'.join(f'L_{var.upper()}' for _, vars in zip(_def['types'], _def['vars']) for var in vars)}$)THEN + !... copy only selected members + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + IF(${f'L_{var.upper()}'}$)THEN + CALL SELF%F_${var.upper()}$%SYNC_HOST_RDWR(QUEUE=QUEUE) + ENDIF + #:endfor + #:endfor + ELSE + !... copy entire struct + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + CALL SELF%F_${var.upper()}$%SYNC_HOST_RDWR(QUEUE=QUEUE) + #:endfor + #:endfor + ENDIF + + END SUBROUTINE ${obj.upper()}$_SYNC_HOST_RDWR + + SUBROUTINE ${obj.upper()}$_DELETE_DEVICE_DATA(SELF) + CLASS(${obj.upper()}$) :: SELF + + #:for _, vars in zip(_def['types'], _def['vars']) + #:for var in vars + CALL SELF%F_${var.upper()}$%DELETE_DEVICE_DATA() + #:endfor + #:endfor + + END SUBROUTINE ${obj.upper()}$_DELETE_DEVICE_DATA +#:endif + +END MODULE ${obj.upper()}$_TYPE_MOD diff --git a/src/ecwam/ecwam_loki.config b/src/ecwam/ecwam_loki.config index 9224579c3..8e9812b8d 100644 --- a/src/ecwam/ecwam_loki.config +++ b/src/ecwam/ecwam_loki.config @@ -13,7 +13,6 @@ disable = [ 'ieee_arithmetic', # intrinsic modules (should have INTRINSIC in their USE statement) 'mfeb_length', 'cdm', # internal functions 'outwspec_io_serv_handler', 'outint_io_serv_handler', 'ifstowam_handler', # procedure pointers - '*%init', '*%update_view', '*%final' ] # modules to be parsed but not transformed @@ -32,6 +31,64 @@ block = ['ec_parkind', 'parkind_wave'] intrinsic_names = ['write(iu06'] kernel_only = true +# Inline transformation +[transformations.InlineTransformation] + module = "loki.transformations" +[transformations.InlineTransformation.options] + allowed_aliases = "IJ" + inline_elementals = false + +# Loop transformations +[transformations.TransformLoopsTransformation] + module = "loki.transformations" +[transformations.TransformLoopsTransformation.options] + loop_interchange = true + +# Split-read-write transformation +[transformations.SplitReadWriteTransformation] + module = "loki.transformations" +[transformations.SplitReadWriteTransformation.options] + dimensions = "%dimensions.horizontal%" + +# TemporariesPoolAllocatorTransformation +[transformations.TemporariesPoolAllocatorTransformation] + module = "loki.transformations" +[transformations.TemporariesPoolAllocatorTransformation.options] + horizontal = "%dimensions.horizontal%" + directive = "openmp" + block_dim = "%dimensions.block_dim%" + check_bounds = true + +# ModuleWrap transformation +[transformations.ModuleWrapTransformation] + module = "loki.transformations" +[transformations.ModuleWrapTransformation.options] + module_suffix = "_MOD" + +# Dependency transformation +[transformations.DependencyTransformation] + module = "loki.transformations" +[transformations.DependencyTransformation.options] + module_suffix = "_MOD" + suffix = "_LOKI" + +# Idem transformation +[transformations.IdemTransformation] + module = "loki.transformations" + +# loki pipelines +[pipelines.idem] + transformations = [ + 'RemoveCodeTransformation', 'TransformLoopsTransformation', 'SplitReadWriteTransformation', + 'InlineTransformation', 'IdemTransformation', 'ModuleWrapTransformation', 'DependencyTransformation' +] + +[pipelines.idem-stack] + transformations = [ + 'RemoveCodeTransformation', 'TransformLoopsTransformation', 'SplitReadWriteTransformation', 'InlineTransformation', + 'IdemTransformation', 'TemporariesPoolAllocatorTransformation', 'ModuleWrapTransformation', 'DependencyTransformation' +] + # Define entry point for call-tree transformation [routines.wamintgr] role = "driver" @@ -47,6 +104,40 @@ block = ['ec_parkind', 'parkind_wave'] [routines.transf] [routines.aki_ice] +# we add loki inlined routines here to force them to be created +[routines.femeanws] +[routines.frcutindex] +[routines.omegagc] +[routines.tau_phi_hf] +[routines.stresso] +[routines.wsigstar] +[routines.sinput] +[routines.sinput_ard] +[routines.sinput_jan] +[routines.taut_z0] +[routines.z0wave] +[routines.airsea] +[routines.femean] +[routines.meansqs_lf] +[routines.halphap] +[routines.wnfluxes] +[routines.sdiwbk] +[routines.sbottom] +[routines.fkmean] +[routines.imphftail] +[routines.setice] +[routines.stokestrn] +[routines.stokesdrift] +[routines.cimsstrn] +[routines.semean] +[routines.sdepthlim] +[routines.ciwabr] +[routines.sinflx] +[routines.sdissip_ard] +[routines.sdissip_jan] +[routines.sdissip] +[routines.peak_ang] + # Define indices and bounds for array dimensions [dimensions.horizontal] size = "KIJL" diff --git a/src/ecwam/ecwam_loki_gpu.config b/src/ecwam/ecwam_loki_gpu.config index aeb53372f..e6378adba 100644 --- a/src/ecwam/ecwam_loki_gpu.config +++ b/src/ecwam/ecwam_loki_gpu.config @@ -10,18 +10,20 @@ enable_imports = true # do not attempt to look up the source files for these. disable = [ 'yomhook', 'abor1', 'abort1', 'gstats', 'yowgstats', 'wam_user_clock', - 'parkind1', 'propag_wam', 'newwind', 'oml_mod', 'field_module', 'incdate', 'yowfield_mod', - 'ieee_arithmetic', # intrinsic modules (should have INTRINSIC in their USE statement) + 'parkind1', 'propag_wam', 'newwind', 'oml_mod', 'field_module', 'incdate', + 'ieee_arithmetic', 'ieee_exceptions', # intrinsic modules (should have INTRINSIC in their USE statement) + 'ieee_set_halting_mode', 'ieee_get_halting_mode', # intrinsic subroutines 'mfeb_length', 'cdm', # internal functions 'outwspec_io_serv_handler', 'outint_io_serv_handler', 'ifstowam_handler', # procedure pointers - '*%init', '*%update_view', '*%final', '*%sync_host', '*%update_device' + '*%sync_host*', '*%sync_device*', 'wait_for_async_queue', 'field_async_module', '*%get_device_data*', '*%get_host_data*', + 'df', 'f' # statement functions ] # modules to be parsed but not transformed -ignore = ['yowgrid', 'yowtest', 'yowshal', 'yowdrvtype'] +ignore = ['yowgrid', 'yowtest'] # Prune the tree for these to ensure they are not processed by transformations -block = ['ec_parkind', 'parkind_wave'] +block = ['ec_parkind', 'parkind_wave', 'yowdrvtype'] # Utility calls and IO statements to remove [transformations.RemoveCodeTransformation] @@ -33,6 +35,102 @@ block = ['ec_parkind', 'parkind_wave'] intrinsic_names = ['write(iu06'] kernel_only = true +# Inline transformation +[transformations.InlineTransformation] + module = "loki.transformations" +[transformations.InlineTransformation.options] + allowed_aliases = "IJ" + inline_elementals = false + +# Split-read-write transformation +[transformations.SplitReadWriteTransformation] + module = "loki.transformations" +[transformations.SplitReadWriteTransformation.options] + dimensions = "%dimensions.horizontal%" + +# GlobalVariableAnalysis +[transformations.GlobalVariableAnalysis] + module = "loki.transformations" +[transformations.GlobalVariableAnalysis.options] + +# Loop transformations +[transformations.TransformLoopsTransformation] + module = "loki.transformations" +[transformations.TransformLoopsTransformation.options] + loop_interchange = true + +# GlobalVarOffloadTransformation +[transformations.GlobalVarOffloadTransformation] + module = "loki.transformations" +[transformations.GlobalVarOffloadTransformation.options] + +# SCC transformations +[transformations.SCCVectorPipeline] + module = "loki.transformations.single_column" +[transformations.SCCVectorPipeline.options] + horizontal = "%dimensions.horizontal%" + directive = "openacc" + trim_vector_sections = true + block_dim = "%dimensions.block_dim%" + +[transformations.SCCStackPipeline] + module = "loki.transformations.single_column" +[transformations.SCCStackPipeline.options] + horizontal = "%dimensions.horizontal%" + directive = "openacc" + trim_vector_sections = true + block_dim = "%dimensions.block_dim%" + check_bounds = false + +[transformations.SCCHoistPipeline] + module = "loki.transformations.single_column" +[transformations.SCCHoistPipeline.options] + horizontal = "%dimensions.horizontal%" + directive = "openacc" + trim_vector_sections = true + block_dim = "%dimensions.block_dim%" + +# ModuleWrap transformation +[transformations.ModuleWrapTransformation] + module = "loki.transformations" +[transformations.ModuleWrapTransformation.options] + module_suffix = "_MOD" + +# Dependency transformation +[transformations.DependencyTransformation] + module = "loki.transformations" +[transformations.DependencyTransformation.options] + module_suffix = "_MOD" + suffix = "_LOKI" + +# FileWrite transformation +[transformations.FileWriteTransformation] + module = "loki.transformations" +[transformations.FileWriteTransformation.options] + include_module_var_imports = true + +# loki pipelines +[pipelines.scc] + transformations = [ + 'RemoveCodeTransformation', 'TransformLoopsTransformation', 'SplitReadWriteTransformation', 'InlineTransformation', + 'GlobalVariableAnalysis', 'GlobalVarOffloadTransformation', 'SCCVectorPipeline', 'ModuleWrapTransformation', + 'DependencyTransformation' +] + +[pipelines.scc-stack] + transformations = [ + 'RemoveCodeTransformation', 'TransformLoopsTransformation', 'SplitReadWriteTransformation', 'InlineTransformation', + 'GlobalVariableAnalysis', 'GlobalVarOffloadTransformation', 'SCCStackPipeline', 'ModuleWrapTransformation', + 'DependencyTransformation' +] + +[pipelines.scc-hoist] + transformations = [ + 'RemoveCodeTransformation', 'TransformLoopsTransformation', 'SplitReadWriteTransformation', 'InlineTransformation', + 'GlobalVariableAnalysis', 'GlobalVarOffloadTransformation', 'SCCHoistPipeline', 'ModuleWrapTransformation', + 'DependencyTransformation' +] + # Define entry point for call-tree transformation [routines.wamintgr_loki_gpu] role = "driver" @@ -40,6 +138,19 @@ block = ['ec_parkind', 'parkind_wave'] replicate = false real_kind = 'JWRB' +[routines.cireduce_loki_gpu] + role = "driver" + expand = true + replicate = false + real_kind = 'JWRB' + +[routines.outbs_loki_gpu] + role = "driver" + expand = true + replicate = false + real_kind = 'JWRB' + block = ['outwnorm', 'yowdrvtype', 'parkind_wave'] + # add inline function calls here to force the plan to add them [routines.chnkmin] [routines.ns_gc] @@ -47,6 +158,47 @@ block = ['ec_parkind', 'parkind_wave'] [routines.transf_snl] [routines.transf] [routines.aki_ice] +[routines.aki] +[routines.w_mode_st] +[routines.transf_r] +[routines.transf_bfi] + +# we add loki inlined routines here to force them to be created +[routines.sebtmean] +[routines.scosfl] +[routines.peakfri] +[routines.femeanws] +[routines.frcutindex] +[routines.omegagc] +[routines.tau_phi_hf] +[routines.stresso] +[routines.wsigstar] +[routines.sinput] +[routines.sinput_ard] +[routines.sinput_jan] +[routines.taut_z0] +[routines.z0wave] +[routines.airsea] +[routines.femean] +[routines.meansqs_lf] +[routines.halphap] +[routines.wnfluxes] +[routines.sdiwbk] +[routines.sbottom] +[routines.fkmean] +[routines.imphftail] +[routines.setice] +[routines.stokestrn] +[routines.stokesdrift] +[routines.cimsstrn] +[routines.semean] +[routines.sdepthlim] +[routines.ciwabr] +[routines.sinflx] +[routines.sdissip_ard] +[routines.sdissip_jan] +[routines.sdissip] +[routines.peak_ang] # Disable replication for modules containing global variables [routines.yowaltas] @@ -88,6 +240,15 @@ block = ['ec_parkind', 'parkind_wave'] [routines.yowwndg] expand = false replicate = false +[routines.yowshal] + expand = false + replicate = false +[routines.yowcurr] + expand = false + replicate = false +[routines.yowmap] + expand = false + replicate = false # Define indices and bounds for array dimensions [dimensions.horizontal] diff --git a/src/ecwam/fndprt.F90 b/src/ecwam/fndprt.F90 index 0367da552..e9fb6d5a5 100644 --- a/src/ecwam/fndprt.F90 +++ b/src/ecwam/fndprt.F90 @@ -83,34 +83,34 @@ SUBROUTINE FNDPRT (KIJS, KIJL, NPMAX, & #include "parmean.intfb.h" INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL, NPMAX - INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJS:KIJL) :: MIJ - INTEGER(KIND=JWIM), INTENT(INOUT), DIMENSION(KIJS:KIJL) :: NPEAK - INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJS:KIJL,NPMAX) :: NTHP, NFRP + INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJL) :: MIJ + INTEGER(KIND=JWIM), INTENT(INOUT), DIMENSION(KIJL) :: NPEAK + INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJL,NPMAX) :: NTHP, NFRP - REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJS:KIJL) :: FLNOISE - REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJS:KIJL,NANG,NFRE) :: FLLOW, FL1 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE), INTENT(INOUT) :: SWM - REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJS:KIJL,0:NPMAX) :: DIR, PER, ENE + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL) :: FLNOISE + REAL(KIND=JWRB), INTENT(IN), DIMENSION(KIJL,NANG,NFRE) :: FLLOW, FL1 + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE), INTENT(INOUT) :: SWM + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL,0:NPMAX) :: DIR, PER, ENE - LOGICAL, INTENT(IN), DIMENSION(KIJS:KIJL,NANG) :: LLCOSDIFF + LOGICAL, INTENT(IN), DIMENSION(KIJL,NANG) :: LLCOSDIFF INTEGER(KIND=JWIM) :: ITHC, IFRC INTEGER(KIND=JWIM) :: IJ, M, K, IP, NITT INTEGER(KIND=JWIM) :: NANGH, KK, KKMIN, KKMAX INTEGER(KIND=JWIM) :: IFRL, ITHL, ITHR - INTEGER(KIND=JWIM), DIMENSION(KIJS:KIJL) :: MMIN, MMAX - INTEGER(KIND=JWIM), DIMENSION(1-NANG:2*NANG) :: KLOC + INTEGER(KIND=JWIM), DIMENSION(KIJL) :: MMIN, MMAX + INTEGER(KIND=JWIM), DIMENSION(3*NANG) :: KLOC REAL(KIND=JWRB) :: HALF_SECTOR REAL(KIND=JPHOOK) :: ZHOOK_HANDLE REAL(KIND=JWRB), DIMENSION(NANG,NFRE) :: W2 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE) :: W1 - REAL(KIND=JWRB), DIMENSION(NANG,NFRE,NPMAX,KIJS:KIJL) :: SPEC + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE) :: W1 + REAL(KIND=JWRB), DIMENSION(NANG,NFRE,NPMAX,KIJL) :: SPEC LOGICAL :: LLCHANGE, LLADD LOGICAL :: LLADDPART - LOGICAL, DIMENSION(KIJS:KIJL,NANG,NFRE) :: LLW3 + LOGICAL, DIMENSION(KIJL,NANG,NFRE) :: LLW3 ! ---------------------------------------------------------------------- @@ -155,7 +155,7 @@ SUBROUTINE FNDPRT (KIJS, KIJL, NPMAX, & KKMIN=ITHC-NANGH KKMAX=ITHC+NANGH DO KK=KKMIN,KKMAX - KLOC(KK)=1+MOD(NANG+KK-1,NANG) + KLOC(KK+NANG)=1+MOD(NANG+KK-1,NANG) ENDDO !* 1. SET UP THE W2 MAP @@ -180,7 +180,7 @@ SUBROUTINE FNDPRT (KIJS, KIJL, NPMAX, & ! FIND IF MORE HIGH FREQUENCY BINS HAVE BECOME EXCLUDED OUT0: DO M=MMAX(IJ),MMIN(IJ),-1 DO KK=KKMIN,KKMAX - K=KLOC(KK) + K=KLOC(KK+NANG) IF (W1(IJ,K,M) < 1.0_JWRB) THEN MMAX(IJ)=M EXIT OUT0 @@ -205,7 +205,7 @@ SUBROUTINE FNDPRT (KIJS, KIJL, NPMAX, & ! by definition bins beyond M=MIJ are never extremas ! and bins above MMAX are excluded. DO KK=KKMIN,KKMAX - K = KLOC(KK) + K = KLOC(KK+NANG) IF (LLW3(IJ,K,M)) THEN IF (W2(K,M) == 0.5_JWRB .AND. & @@ -235,7 +235,7 @@ SUBROUTINE FNDPRT (KIJS, KIJL, NPMAX, & DO M=MMIN(IJ),MMAX(IJ) DO KK=KKMIN,KKMAX - K=KLOC(KK) + K=KLOC(KK+NANG) IF (LLW3(IJ,K,M) .AND. W1(IJ,K,M) < 1.0_JWRB) THEN IF (W2(K,M) == 0.0_JWRB) THEN diff --git a/src/ecwam/getgrbobstrct.F90 b/src/ecwam/getgrbobstrct.F90 index 466f59cab..1940b926e 100644 --- a/src/ecwam/getgrbobstrct.F90 +++ b/src/ecwam/getgrbobstrct.F90 @@ -110,7 +110,7 @@ SUBROUTINE GETGRBOBSTRCT(BLK2GLO, BLK2LOC, IREAD, NPR, FILNM, KFILE_HANDLE, KGRI CALL KTOOBS(IU06) ! INWGRIB REQUIRES FIELDG - CALL FIELDG%ALLOC(NXFFS_LOC, NYFFS_LOC, UBND0=NXFFE_LOC, UBND1=NYFFE_LOC) + CALL FIELDG%ALLOC(LBOUNDS=[NXFFS_LOC, NYFFS_LOC], UBOUNDS=[NXFFE_LOC, NYFFE_LOC]) LLINIALL=.FALSE. LLOCAL=.FALSE. diff --git a/src/ecwam/getspec.F90 b/src/ecwam/getspec.F90 index 830c74c05..e2e733484 100644 --- a/src/ecwam/getspec.F90 +++ b/src/ecwam/getspec.F90 @@ -246,8 +246,8 @@ SUBROUTINE GETSPEC(FL1, BLK2GLO, BLK2LOC, WVENVI, NBLKS, NBLKE, IREAD) LLINIALL = .FALSE. LLOCAL = .FALSE. - CALL FIELDG%ALLOC(NXFFS, NYFFS, UBND0=NXFFE, UBND1=NYFFE) + IF(.NOT. FIELDG%LALLOC) CALL FIELDG%ALLOC(LBOUNDS=[NXFFS, NYFFS], UBOUNDS=[NXFFE, NYFFE]) CALL INIT_FIELDG(BLK2LOC, LLINIALL, LLOCAL, & & NXFFS, NXFFE, NYFFS, NYFFE, FIELDG) diff --git a/src/ecwam/h_max.F90 b/src/ecwam/h_max.F90 index 72a3ece22..f93e45816 100644 --- a/src/ecwam/h_max.F90 +++ b/src/ecwam/h_max.F90 @@ -58,8 +58,8 @@ SUBROUTINE H_MAX(C3,C4,XNSLC,KIJS,KIJL,AA,BB,HMAXN,SIG_HM) IMPLICIT NONE INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: C3, C4, XNSLC - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: AA, BB, HMAXN, SIG_HM + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: C3, C4, XNSLC + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: AA, BB, HMAXN, SIG_HM INTEGER(KIND=JWIM), PARAMETER :: NITER = 5 @@ -79,7 +79,7 @@ SUBROUTINE H_MAX(C3,C4,XNSLC,KIJS,KIJL,AA,BB,HMAXN,SIG_HM) REAL(KIND=JPHOOK) :: ZHOOK_HANDLE REAL(KIND=JWRB) :: ZEPSILON REAL(KIND=JWRB) :: TWOG1, G2, AE, BE, F, Z0, EMIN, EMAX, EVAL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL):: E, BBM1, DFNORMA + REAL(KIND=JWRB), DIMENSION(KIJL):: E, BBM1, DFNORMA !---------------------------------------------------------------------- diff --git a/src/ecwam/halphap.F90 b/src/ecwam/halphap.F90 index 4cf216cc4..189f51392 100644 --- a/src/ecwam/halphap.F90 +++ b/src/ecwam/halphap.F90 @@ -82,8 +82,10 @@ SUBROUTINE HALPHAP(KIJS, KIJL, WAVNUM, COSWDIF, FL1, HALP) ENDDO ENDDO + !$loki inline CALL MEANSQS_LF(NFRE, KIJS, KIJL, FLWD, WAVNUM, XMSS) + !$loki inline CALL FEMEAN (KIJS, KIJL, FLWD, EM, FM) DO IJ = KIJS, KIJL diff --git a/src/ecwam/implsch.F90 b/src/ecwam/implsch.F90 index c88f9c23a..1c3f385bb 100644 --- a/src/ecwam/implsch.F90 +++ b/src/ecwam/implsch.F90 @@ -88,9 +88,6 @@ SUBROUTINE IMPLSCH (KIJS, KIJL, FL1, & USE YOWPCONS , ONLY : WSEMEAN_MIN, ROWATERM1 USE YOWSTAT , ONLY : IDELT ,LBIWBK USE YOWWNDG , ONLY : ICODE ,ICODE_CPL - USE YOWINDN , ONLY : MLSTHG ! needed for Loki - USE YOWFRED , ONLY : NWAV_GC ! needed for Loki - USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK ! ---------------------------------------------------------------------- @@ -202,12 +199,14 @@ SUBROUTINE IMPLSCH (KIJS, KIJL, FL1, & ! REDUCE WAVE ENERGY IF LARGER THAN DEPTH LIMITED WAVE HEIGHT IF (LBIWBK) THEN + !$loki inline CALL SDEPTHLIM(KIJS, KIJL, EMAXDPT, FL1) ENDIF !* 2.2 COMPUTE MEAN PARAMETERS. ! ------------------------ + !$loki inline CALL FKMEAN(KIJS, KIJL, FL1, WAVNUM, & & EMEAN, FMEAN, F1MEAN, AKMEAN, XKMEAN) @@ -220,6 +219,7 @@ SUBROUTINE IMPLSCH (KIJS, KIJL, FL1, & ! COMPUTE DAMPING COEFFICIENT DUE TO FRICTION ON BOTTOM OF THE SEA ICE. !!! testing sea ice attenuation (might need to restrict usage when needed) IF (LCIWABR) THEN + !$loki inline CALL CIWABR(KIJS, KIJL, CICOVER, FL1, WAVNUM, CGROUP, CIREDUC) DO M=1,NFRE DO K=1,NANG @@ -249,6 +249,7 @@ SUBROUTINE IMPLSCH (KIJS, KIJL, FL1, & LUPDTUS = .TRUE. NCALL = 2 DO ICALL = 1, NCALL + !$loki inline CALL SINFLX (ICALL, NCALL, KIJS, KIJL, & & LUPDTUS, & & FL1, & @@ -268,6 +269,7 @@ SUBROUTINE IMPLSCH (KIJS, KIJL, FL1, & ! 2.3.3 ADD THE OTHER SOURCE TERMS. ! --------------------------- + !$loki inline CALL SDISSIP (KIJS, KIJL, FL1 ,FLD, SL, & & WAVNUM, CGROUP, XK2CG, & & EMEAN, F1MEAN, XKMEAN, & @@ -301,8 +303,10 @@ SUBROUTINE IMPLSCH (KIJS, KIJL, FL1, & ENDIF + !$loki inline CALL SDIWBK(KIJS, KIJL, FL1 ,FLD, SL, DEPTH, EMAXDPT, EMEAN, F1MEAN) + !$loki inline CALL SBOTTOM (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH) ! ---------------------------------------------------------------------- @@ -359,6 +363,7 @@ SUBROUTINE IMPLSCH (KIJS, KIJL, FL1, & ENDIF IF (LCFLX) THEN + !$loki inline CALL WNFLUXES (KIJS, KIJL, & & MIJ, RHOWGDFTH, & & CINV, & @@ -379,12 +384,15 @@ SUBROUTINE IMPLSCH (KIJS, KIJL, FL1, & !* 2.5 REPLACE DIAGNOSTIC PART OF SPECTRA BY A F**(-5) TAIL. ! ----------------------------------------------------- + !$loki inline CALL FKMEAN(KIJS, KIJL, FL1, WAVNUM, & & EMEAN, FMEAN, F1MEAN, AKMEAN, XKMEAN) ! MEAN FREQUENCY CHARACTERISTIC FOR WIND SEA + !$loki inline CALL FEMEANWS(KIJS, KIJL, FL1, XLLWS, FMEANWS, EMEANWS) + !$loki inline CALL IMPHFTAIL(KIJS, KIJL, MIJ, FLM, WAVNUM, XK2CG, FL1) @@ -407,6 +415,7 @@ SUBROUTINE IMPLSCH (KIJS, KIJL, FL1, & ! ----------------------------- IF (LICERUN .AND. LMASKICE) THEN + !$loki inline CALL SETICE(KIJS, KIJL, FL1, CICOVER, COSWDIF) ENDIF @@ -414,6 +423,7 @@ SUBROUTINE IMPLSCH (KIJS, KIJL, FL1, & !* 2.7 SURFACE STOKES DRIFT AND STRAIN IN SEA ICE ! ------------------------------------------ + !$loki inline CALL STOKESTRN(KIJS, KIJL, FL1, WAVNUM, STOKFAC, DEPTH, WSWAVE, WDWAVE, CICOVER, CITHICK, & & USTOKES, VSTOKES, STRNMS, NEMOUSTOKES, NEMOVSTOKES, NEMOSTRN) diff --git a/src/ecwam/initmdl.F90 b/src/ecwam/initmdl.F90 index 7fb0d03b2..5263948d4 100644 --- a/src/ecwam/initmdl.F90 +++ b/src/ecwam/initmdl.F90 @@ -671,7 +671,7 @@ SUBROUTINE INITMDL (NADV, & ! INITIALISE GRID POINT FIELDS DEPENDENT ON WATER DEPTH AND FREQUENCY - IF (.NOT.ALLOCATED(WVPRPT_LAND%WAVNUM)) CALL WVPRPT_LAND%ALLOC(NFRE) + IF (.NOT. WVPRPT_LAND%LALLOC) CALL WVPRPT_LAND%ALLOC(UBOUNDS=[NFRE]) CALL INITDPTHFLDS(WVENVI, WVPRPT, WVPRPT_LAND) diff --git a/src/ecwam/intpol.F90 b/src/ecwam/intpol.F90 index 3834b2d90..83b62836e 100644 --- a/src/ecwam/intpol.F90 +++ b/src/ecwam/intpol.F90 @@ -69,25 +69,25 @@ SUBROUTINE INTPOL (KIJS, KIJL, FLR, FLA, WAVNUM, UCUR, VCUR, IRA) #include "abort1.intfb.h" INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE), INTENT(IN) :: FLR - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE), INTENT(OUT) :: FLA - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NFRE), INTENT(IN) :: WAVNUM - REAL(KIND=JWRB), DIMENSION (KIJS:KIJL), INTENT(IN) :: UCUR, VCUR + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE), INTENT(IN) :: FLR + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE), INTENT(OUT) :: FLA + REAL(KIND=JWRB), DIMENSION(KIJL,NFRE), INTENT(IN) :: WAVNUM + REAL(KIND=JWRB), DIMENSION (KIJL), INTENT(IN) :: UCUR, VCUR INTEGER(KIND=JWIM), INTENT(IN) :: IRA INTEGER(KIND=JWIM) :: IJ, M, K INTEGER(KIND=JWIM) :: NFRE_MAX, NEWM, NEWM1, KH - INTEGER(KIND=JWIM), DIMENSION(KIJS:KIJL) :: NEWF, NEWFLA, KNEW + INTEGER(KIND=JWIM), DIMENSION(KIJL) :: NEWF, NEWFLA, KNEW REAL(KIND=JWRB) :: FRE0, CDF, ZPI2GM, COEF, FMAX, FREQ, DFREQTH, FR5OFREQ5 REAL(KIND=JWRB) :: FNEW, GWH REAL(KIND=JPHOOK) :: ZHOOK_HANDLE REAL(KIND=JWRB), DIMENSION(NFRE) :: DFTH - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: OLDFL, WAVN - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: FNEF, GWP, GWM + REAL(KIND=JWRB), DIMENSION(KIJL) :: OLDFL, WAVN + REAL(KIND=JWRB), DIMENSION(KIJL) :: FNEF, GWP, GWM - LOGICAL, DIMENSION(KIJS:KIJL) :: LICE2SEA + LOGICAL, DIMENSION(KIJL) :: LICE2SEA ! ---------------------------------------------------------------------- IF (LHOOK) CALL DR_HOOK('INTPOL',0,ZHOOK_HANDLE) diff --git a/src/ecwam/kurtosis.F90 b/src/ecwam/kurtosis.F90 index 65a0283b1..54236e84e 100644 --- a/src/ecwam/kurtosis.F90 +++ b/src/ecwam/kurtosis.F90 @@ -203,11 +203,11 @@ SUBROUTINE KURTOSIS(KIJS, KIJL, FL1, & INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE), INTENT(IN) :: FL1 + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE), INTENT(IN) :: FL1 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: DEPTH - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: C3, C4, BF2, QP, HMAX, TMAX - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: ETA_M, R, XNSLC, SIG_TH, EPS, XNU + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: DEPTH + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: C3, C4, BF2, QP, HMAX, TMAX + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: ETA_M, R, XNSLC, SIG_TH, EPS, XNU INTEGER(KIND=JWIM) :: IJ, M, K @@ -225,14 +225,14 @@ SUBROUTINE KURTOSIS(KIJS, KIJL, FL1, & REAL(KIND=JWRB) :: ZEPSILON, ZSQREPSILON, FRMAX, FRMIN REAL(KIND=JWRB), DIMENSION(NFRE) :: FAC4 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: HMAXN - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: SUM0,SUM1,SUM2,SUM4,SUM40,SUM6 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: XKP,SIG_OM - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: SIG_HM - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: F_M,OM_UP - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: AA,BB,C4_DYN,C4_B - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: FFMAX - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NFRE) :: FF + REAL(KIND=JWRB), DIMENSION(KIJL) :: HMAXN + REAL(KIND=JWRB), DIMENSION(KIJL) :: SUM0,SUM1,SUM2,SUM4,SUM40,SUM6 + REAL(KIND=JWRB), DIMENSION(KIJL) :: XKP,SIG_OM + REAL(KIND=JWRB), DIMENSION(KIJL) :: SIG_HM + REAL(KIND=JWRB), DIMENSION(KIJL) :: F_M,OM_UP + REAL(KIND=JWRB), DIMENSION(KIJL) :: AA,BB,C4_DYN,C4_B + REAL(KIND=JWRB), DIMENSION(KIJL) :: FFMAX + REAL(KIND=JWRB), DIMENSION(KIJL,NFRE) :: FF !----------------------------------------------------------------------- diff --git a/src/ecwam/mblock.F90 b/src/ecwam/mblock.F90 index ba2a22c64..dd11ff564 100644 --- a/src/ecwam/mblock.F90 +++ b/src/ecwam/mblock.F90 @@ -71,7 +71,7 @@ SUBROUTINE MBLOCK (BATHY, KA, KE, IPP) ! ------------------------------------------- - CALL BLK2GLO%ALLOC(NIBLO) + IF(.NOT. BLK2GLO%LALLOC) CALL BLK2GLO%ALLOC(UBOUNDS=[NIBLO]) DO IJ=1,NIBLO BLK2GLO%IXLG(IJ) = 0 diff --git a/src/ecwam/meansqs.F90 b/src/ecwam/meansqs.F90 index 1489b9812..92fca79df 100644 --- a/src/ecwam/meansqs.F90 +++ b/src/ecwam/meansqs.F90 @@ -66,11 +66,11 @@ SUBROUTINE MEANSQS(XKMSS, KIJS, KIJL, F, WAVNUM, USTAR, COSWDIF, XMSS) REAL(KIND=JWRB), INTENT(IN) :: XKMSS INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE), INTENT(IN) :: F - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NFRE), INTENT(IN) :: WAVNUM - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: USTAR - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG), INTENT(IN) :: COSWDIF - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: XMSS + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE), INTENT(IN) :: F + REAL(KIND=JWRB), DIMENSION(KIJL,NFRE), INTENT(IN) :: WAVNUM + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: USTAR + REAL(KIND=JWRB), DIMENSION(KIJL,NANG), INTENT(IN) :: COSWDIF + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: XMSS INTEGER(KIND=JWIM) :: IJ, NFRE_MSS, NFRE_EFF @@ -78,9 +78,9 @@ SUBROUTINE MEANSQS(XKMSS, KIJS, KIJL, F, WAVNUM, USTAR, COSWDIF, XMSS) REAL(KIND=JWRB) :: XLOGFS, FCUT REAL(KIND=JPHOOK) :: ZHOOK_HANDLE REAL(KIND=JWRB), DIMENSION(NFRE) :: FD - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: TEMP1, TEMP2 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: XMSSLF, XMSS_TAIL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: HALP, FRGC + REAL(KIND=JWRB), DIMENSION(KIJL) :: TEMP1, TEMP2 + REAL(KIND=JWRB), DIMENSION(KIJL) :: XMSSLF, XMSS_TAIL + REAL(KIND=JWRB), DIMENSION(KIJL) :: HALP, FRGC ! ---------------------------------------------------------------------- @@ -101,7 +101,7 @@ SUBROUTINE MEANSQS(XKMSS, KIJS, KIJL, F, WAVNUM, USTAR, COSWDIF, XMSS) NFRE_EFF = MIN(NFRE,NFRE_MSS) CALL MEANSQS_LF (NFRE_EFF, KIJS, KIJL, F, WAVNUM, XMSSLF) - XMSS(:) = XMSS(:) + XMSSLF(:) + XMSS(KIJS:KIJL) = XMSS(KIJS:KIJL) + XMSSLF(KIJS:KIJL) ! ADD TAIL CORRECTION TO MEAN SQUARE SLOPE (between FR(NFRE_EFF) and FRGC). diff --git a/src/ecwam/mpdecomp.F90 b/src/ecwam/mpdecomp.F90 index bb6f6003a..01eb077de 100644 --- a/src/ecwam/mpdecomp.F90 +++ b/src/ecwam/mpdecomp.F90 @@ -1353,10 +1353,8 @@ SUBROUTINE MPDECOMP(NPR, MAXLEN, LLIRANK, LLWVENVI) ! CREATE IFROMIJ, JFROMIJ and WVENVI ! !!!! IT IS ONLY DEFINED FOR GRID POINTS ON A GIVEN PE !!!! -IF (ALLOCATED(BLK2LOC%IFROMIJ)) THEN - CALL BLK2LOC%DEALLOC() -ENDIF -CALL BLK2LOC%ALLOC(NPROMA_WAM, NCHNK) +IF (BLK2LOC%LALLOC) CALL BLK2LOC%DEALLOC() +CALL BLK2LOC%ALLOC(UBOUNDS=[NPROMA_WAM, NCHNK]) ALLOCATE(NXS(NCHNK)) ALLOCATE(NXE(NCHNK)) @@ -1390,10 +1388,8 @@ SUBROUTINE MPDECOMP(NPR, MAXLEN, LLIRANK, LLWVENVI) ELSE IF (LLWVENVI) THEN - IF (ALLOCATED(WVENVI%UCUR)) THEN - CALL WVENVI%DEALLOC() - ENDIF - CALL WVENVI%ALLOC(NPROMA_WAM, NCHNK) + IF (WVENVI%LALLOC) CALL WVENVI%DEALLOC() + CALL WVENVI%ALLOC(UBOUNDS=[NPROMA_WAM, NCHNK]) ENDIF !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(KIJS, IJSB, KIJL, IJLB, IJ, JH) @@ -1493,6 +1489,8 @@ SUBROUTINE MPDECOMP(NPR, MAXLEN, LLIRANK, LLWVENVI) WRITE(IU06,*) ' WAVE MODEL DECOMPOSITION FINISHED.' CALL FLUSH(IU06) +!$acc update device(KLON, KLAT, KCOR, WLAT, WCOR) + IF (LHOOK) CALL DR_HOOK('MPDECOMP',1,ZHOOK_HANDLE) END SUBROUTINE MPDECOMP diff --git a/src/ecwam/mwp1.F90 b/src/ecwam/mwp1.F90 index fd872dafc..e75a70d9c 100644 --- a/src/ecwam/mwp1.F90 +++ b/src/ecwam/mwp1.F90 @@ -61,14 +61,14 @@ SUBROUTINE MWP1 (KIJS, KIJL, F, MEANWP1) IMPLICIT NONE INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB), INTENT(IN) :: F(KIJS:KIJL,NANG,NFRE) - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: MEANWP1 + REAL(KIND=JWRB), INTENT(IN) :: F(KIJL,NANG,NFRE) + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: MEANWP1 INTEGER(KIND=JWIM) :: IJ, K, M REAL(KIND=JPHOOK) :: ZHOOK_HANDLE REAL(KIND=JWRB) :: DELT25, COEF_FR, FR1M1 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: TEMP, EM + REAL(KIND=JWRB), DIMENSION(KIJL) :: TEMP, EM LOGICAL :: LL_HALT_INVALID @@ -78,8 +78,10 @@ SUBROUTINE MWP1 (KIJS, KIJL, F, MEANWP1) ! Turn off Floating-Point-Exceptions in this scope to avoid FPE_INVALID in optimized code ! with branch prediction. It is safe to do so as DIV_BY_ZERO is protected. +#ifndef WAM_GPU CALL IEEE_GET_HALTING_MODE(IEEE_INVALID, LL_HALT_INVALID) IF (LL_HALT_INVALID) CALL IEEE_SET_HALTING_MODE(IEEE_INVALID, .FALSE.) +#endif DO IJ=KIJS,KIJL EM(IJ) = 0.0_JWRB @@ -119,7 +121,9 @@ SUBROUTINE MWP1 (KIJS, KIJL, F, MEANWP1) ENDIF ENDDO +#ifndef WAM_GPU IF (LL_HALT_INVALID) CALL IEEE_SET_HALTING_MODE(IEEE_INVALID, .TRUE.) +#endif IF (LHOOK) CALL DR_HOOK('MWP1',1,ZHOOK_HANDLE) diff --git a/src/ecwam/mwp2.F90 b/src/ecwam/mwp2.F90 index c86efdda7..b0ee1d9f5 100644 --- a/src/ecwam/mwp2.F90 +++ b/src/ecwam/mwp2.F90 @@ -61,13 +61,13 @@ SUBROUTINE MWP2 (KIJS, KIJL, F, MEANWP2) IMPLICIT NONE INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB), INTENT(IN) :: F(KIJS:KIJL,NANG,NFRE) - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: MEANWP2 + REAL(KIND=JWRB), INTENT(IN) :: F(KIJL,NANG,NFRE) + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: MEANWP2 INTEGER(KIND=JWIM) :: IJ, K, M REAL(KIND=JPHOOK) :: ZHOOK_HANDLE REAL(KIND=JWRB) :: DELT25, COEF_FR, FR1M1 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: TEMP, EM + REAL(KIND=JWRB), DIMENSION(KIJL) :: TEMP, EM LOGICAL :: LL_HALT_INVALID @@ -77,8 +77,10 @@ SUBROUTINE MWP2 (KIJS, KIJL, F, MEANWP2) ! Turn off Floating-Point-Exceptions in this scope to avoid FPE_INVALID in optimized code ! with branch prediction. It is safe to do so as DIV_BY_ZERO is protected. +#ifndef WAM_GPU CALL IEEE_GET_HALTING_MODE(IEEE_INVALID, LL_HALT_INVALID) IF (LL_HALT_INVALID) CALL IEEE_SET_HALTING_MODE(IEEE_INVALID, .FALSE.) +#endif DO IJ=KIJS,KIJL EM(IJ) = 0.0_JWRB @@ -118,7 +120,9 @@ SUBROUTINE MWP2 (KIJS, KIJL, F, MEANWP2) ENDIF ENDDO +#ifndef WAM_GPU IF (LL_HALT_INVALID) CALL IEEE_SET_HALTING_MODE(IEEE_INVALID, .TRUE.) +#endif IF (LHOOK) CALL DR_HOOK('MWP2',1,ZHOOK_HANDLE) diff --git a/src/ecwam/newwind.F90 b/src/ecwam/newwind.F90 index 905929010..dd2d8bb78 100644 --- a/src/ecwam/newwind.F90 +++ b/src/ecwam/newwind.F90 @@ -76,7 +76,11 @@ SUBROUTINE NEWWIND (CDATE, CDATEWH, LLNEWFILE, & IMPLICIT NONE #include "abort1.intfb.h" +#ifdef WAM_GPU +#include "cireduce_loki_gpu.intfb.h" +#else #include "cireduce.intfb.h" +#endif #include "incdate.intfb.h" CHARACTER(LEN=14), INTENT(IN) :: CDATE @@ -119,11 +123,16 @@ SUBROUTINE NEWWIND (CDATE, CDATEWH, LLNEWFILE, & CDATEWL = CDTNEXT CALL GSTATS(1492,0) +#ifdef _OPENACC +!$acc parallel loop gang present(FF_NEXT,FF_NOW) private(KIJS,KIJL) vector_length(NPROMA_WAM) +#else !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(ICHNK, KIJS, KIJL, IJ, TLWMAX) +#endif DO ICHNK = 1, NCHNK KIJS = 1 KIJL = NPROMA_WAM IF (ICODE_WND == 3 ) THEN + !$acc loop vector DO IJ = KIJS, KIJL FF_NOW%WSWAVE(IJ,ICHNK) = FF_NEXT%WSWAVE(IJ,ICHNK) ! adapt first estimate of wave induced stress for low winds @@ -135,6 +144,7 @@ SUBROUTINE NEWWIND (CDATE, CDATEWH, LLNEWFILE, & ENDIF ENDDO ELSE + !$acc loop vector DO IJ = KIJS, KIJL FF_NOW%UFRIC(IJ,ICHNK) = FF_NEXT%UFRIC(IJ,ICHNK) ! update the estimate of TAUW @@ -144,23 +154,34 @@ SUBROUTINE NEWWIND (CDATE, CDATEWH, LLNEWFILE, & ENDDO ENDIF - FF_NOW%WDWAVE(KIJS:KIJL,ICHNK) = FF_NEXT%WDWAVE(KIJS:KIJL,ICHNK) - FF_NOW%AIRD(KIJS:KIJL,ICHNK) = FF_NEXT%AIRD(KIJS:KIJL,ICHNK) - FF_NOW%WSTAR(KIJS:KIJL,ICHNK) = FF_NEXT%WSTAR(KIJS:KIJL,ICHNK) - FF_NOW%CICOVER(KIJS:KIJL,ICHNK) = FF_NEXT%CICOVER(KIJS:KIJL,ICHNK) - FF_NOW%CITHICK(KIJS:KIJL,ICHNK) = FF_NEXT%CITHICK(KIJS:KIJL,ICHNK) - FF_NOW%USTRA(KIJS:KIJL,ICHNK) = FF_NEXT%USTRA(KIJS:KIJL,ICHNK) - FF_NOW%VSTRA(KIJS:KIJL,ICHNK) = FF_NEXT%VSTRA(KIJS:KIJL,ICHNK) + !$acc loop vector + DO IJ = KIJS, KIJL + FF_NOW%WDWAVE(IJ,ICHNK) = FF_NEXT%WDWAVE(IJ,ICHNK) + FF_NOW%AIRD(IJ,ICHNK) = FF_NEXT%AIRD(IJ,ICHNK) + FF_NOW%WSTAR(IJ,ICHNK) = FF_NEXT%WSTAR(IJ,ICHNK) + FF_NOW%CICOVER(IJ,ICHNK) = FF_NEXT%CICOVER(IJ,ICHNK) + FF_NOW%CITHICK(IJ,ICHNK) = FF_NEXT%CITHICK(IJ,ICHNK) + FF_NOW%USTRA(IJ,ICHNK) = FF_NEXT%USTRA(IJ,ICHNK) + FF_NOW%VSTRA(IJ,ICHNK) = FF_NEXT%VSTRA(IJ,ICHNK) + ENDDO ENDDO +#ifdef _OPENACC +!$acc end parallel loop +#else !$OMP END PARALLEL DO +#endif CALL GSTATS(1492,1) CALL INCDATE(CDATEWH, IDELWO) ! UPDATE THE SEA ICE REDUCTION FACTOR +#ifdef WAM_GPU + CALL CIREDUCE_LOKI_GPU (WVPRPT, FF_NOW) +#else CALL CIREDUCE (WVPRPT, FF_NOW) +#endif ENDIF diff --git a/src/ecwam/outbeta.F90 b/src/ecwam/outbeta.F90 index bf08de304..0e7583122 100644 --- a/src/ecwam/outbeta.F90 +++ b/src/ecwam/outbeta.F90 @@ -77,14 +77,14 @@ SUBROUTINE OUTBETA (KIJS, KIJL, & IMPLICIT NONE INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: U10 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: USTAR - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: Z0M - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: Z0B - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: CHRNCK - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: BETAM - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: BETAHQ - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT), OPTIONAL :: CD + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: U10 + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: USTAR + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: Z0M + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: Z0B + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: CHRNCK + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: BETAM + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: BETAHQ + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT), OPTIONAL :: CD REAL(KIND=JWRB), PARAMETER :: AMAX=0.02_JWRB @@ -98,8 +98,8 @@ SUBROUTINE OUTBETA (KIJS, KIJL, & INTEGER(KIND=JWIM) :: IJ REAL(KIND=JWRB) :: GUSM2, Z0ATM - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: USM - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: ALPHAMAXU10 + REAL(KIND=JWRB), DIMENSION(KIJL) :: USM + REAL(KIND=JWRB), DIMENSION(KIJL) :: ALPHAMAXU10 REAL(KIND=JPHOOK) :: ZHOOK_HANDLE ! ---------------------------------------------------------------------- @@ -111,9 +111,9 @@ SUBROUTINE OUTBETA (KIJS, KIJL, & ! ---------------------- IF (LLGCBZ0) THEN - ALPHAMAXU10(:)=ALPHAMAX + ALPHAMAXU10(KIJS:KIJL)=ALPHAMAX ELSE - ALPHAMAXU10(:)=MIN(ALPHAMAX,AMAX+BMAX*U10(:)) + ALPHAMAXU10(KIJS:KIJL)=MIN(ALPHAMAX,AMAX+BMAX*U10(KIJS:KIJL)) ENDIF diff --git a/src/ecwam/outblock.F90 b/src/ecwam/outblock.F90 index ebae87705..a434f6243 100644 --- a/src/ecwam/outblock.F90 +++ b/src/ecwam/outblock.F90 @@ -94,31 +94,29 @@ SUBROUTINE OUTBLOCK (KIJS, KIJL, MIJ, & #include "wdirspread.intfb.h" #include "weflux.intfb.h" #include "w_maxh.intfb.h" -#include "halphap.intfb.h" -#include "alphap_tail.intfb.h" INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - INTEGER(KIND=JWIM), DIMENSION(KIJS:KIJL), INTENT(IN) :: MIJ - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE), INTENT(IN) :: FL1, XLLWS - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL, NFRE), INTENT(IN) :: WAVNUM - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL, NFRE), INTENT(IN) :: CINV - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL, NFRE), INTENT(IN) :: CGROUP - - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: DEPTH - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: UCUR - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: VCUR - INTEGER(KIND=JWIM), DIMENSION(KIJS:KIJL), INTENT(IN) :: IODP - - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: AIRD, WDWAVE, CICOVER, WSWAVE, WSTAR - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: UFRIC, TAUW, Z0M, Z0B, CHRNCK, CITHICK - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: ALTWH, CALTWH, RALTCOR, USTOKES, VSTOKES, STRNMS - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: TAUXD, TAUYD, TAUOCXD, TAUOCYD, TAUOC, PHIOCD - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: PHIEPS, PHIAW - REAL(KIND=JWRO), DIMENSION(KIJS:KIJL), INTENT(IN) :: NEMOSST, NEMOCICOVER, NEMOCITHICK, NEMOUCUR, NEMOVCUR - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NIPRMOUT), INTENT(OUT) :: BOUT - - - INTEGER(KIND=JWIM) :: IJ, K, M, ITG, IR, ITR, IH + INTEGER(KIND=JWIM), DIMENSION(KIJL), INTENT(IN) :: MIJ + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE), INTENT(IN) :: FL1, XLLWS + REAL(KIND=JWRB), DIMENSION(KIJL, NFRE), INTENT(IN) :: WAVNUM + REAL(KIND=JWRB), DIMENSION(KIJL, NFRE), INTENT(IN) :: CINV + REAL(KIND=JWRB), DIMENSION(KIJL, NFRE), INTENT(IN) :: CGROUP + + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: DEPTH + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: UCUR + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: VCUR + INTEGER(KIND=JWIM), DIMENSION(KIJL), INTENT(IN) :: IODP + + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: AIRD, WDWAVE, CICOVER, WSWAVE, WSTAR + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: UFRIC, TAUW, Z0M, Z0B, CHRNCK, CITHICK + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: ALTWH, CALTWH, RALTCOR, USTOKES, VSTOKES, STRNMS + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: TAUXD, TAUYD, TAUOCXD, TAUOCYD, TAUOC, PHIOCD + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: PHIEPS, PHIAW + REAL(KIND=JWRO), DIMENSION(KIJL), INTENT(IN) :: NEMOSST, NEMOCICOVER, NEMOCITHICK, NEMOUCUR, NEMOVCUR + REAL(KIND=JWRB), DIMENSION(KIJL,NIPRMOUT), INTENT(OUT) :: BOUT + + + INTEGER(KIND=JWIM) :: IJ, K, M, ITG, ITR, IH INTEGER(KIND=JWIM) :: IRA REAL(KIND=JWRB) :: SIG @@ -126,22 +124,22 @@ SUBROUTINE OUTBLOCK (KIJS, KIJL, MIJ, & REAL(KIND=JWRB) :: XMODEL_CUTOFF REAL(KIND=JWRB) :: TEWHMIN, TEWHMAX REAL(KIND=JPHOOK) :: ZHOOK_HANDLE - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: EM, FM, DP - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: C3, C4, BF, QP, HMAX, TMAX - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: CMAX_F, HMAX_N, CMAX_ST, HMAX_ST, PHIST - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: ETA_M, R, XNSLC, SIG_TH, EPS, XNU - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: FLD1, FLD2 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: ESWELL ,FSWELL ,THSWELL, P1SWELL, P2SWELL, SPRDSWELL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: ESEA ,FSEA ,THWISEA, P1SEA , P2SEA , SPRDSEA - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: CHARNOCK, BETAHQ, CDATM - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: HALP - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NTRAIN) :: EMTRAIN - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NTRAIN) :: THTRAIN, PMTRAIN - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG) :: COSWDIF + REAL(KIND=JWRB), DIMENSION(KIJL) :: EM, FM, DP + REAL(KIND=JWRB), DIMENSION(KIJL) :: C3, C4, BF, QP, HMAX, TMAX + REAL(KIND=JWRB), DIMENSION(KIJL) :: CMAX_F, HMAX_N, CMAX_ST, HMAX_ST, PHIST + REAL(KIND=JWRB), DIMENSION(KIJL) :: ETA_M, R, XNSLC, SIG_TH, EPS, XNU + REAL(KIND=JWRB), DIMENSION(KIJL) :: FLD1, FLD2 + REAL(KIND=JWRB), DIMENSION(KIJL) :: ESWELL ,FSWELL ,THSWELL, P1SWELL, P2SWELL, SPRDSWELL + REAL(KIND=JWRB), DIMENSION(KIJL) :: ESEA ,FSEA ,THWISEA, P1SEA , P2SEA , SPRDSEA + REAL(KIND=JWRB), DIMENSION(KIJL) :: CHARNOCK, BETAHQ, CDATM + REAL(KIND=JWRB), DIMENSION(KIJL) :: HALP + REAL(KIND=JWRB), DIMENSION(KIJL,NTRAIN) :: EMTRAIN + REAL(KIND=JWRB), DIMENSION(KIJL,NTRAIN) :: THTRAIN, PMTRAIN + REAL(KIND=JWRB), DIMENSION(KIJL,NANG) :: COSWDIF ! *FL2ND* SPECTRUM with second order effect added if LSECONDORDER is true . ! and in the absolute frame of reference if currents are used - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE) :: FL2ND + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE) :: FL2ND LOGICAL :: LLPEAKF @@ -195,59 +193,51 @@ SUBROUTINE OUTBLOCK (KIJS, KIJL, MIJ, & ! LOAD THE OUTPUT BUFFER: - IR=0 - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN + IF (IPFGTBL(1) /= 0) THEN ! SIGNIFICANT WAVE HEIGHT CONVERSION - BOUT(KIJS:KIJL,ITOBOUT(IR))=4._JWRB*SQRT(MAX(EM(KIJS:KIJL),0._JWRB)) + BOUT(KIJS:KIJL,ITOBOUT(1))=4._JWRB*SQRT(MAX(EM(KIJS:KIJL),0._JWRB)) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - ITG=ITOBOUT(IR) + IF (IPFGTBL(2) /= 0) THEN + ITG=ITOBOUT(2) CALL STHQ (KIJS, KIJL, FL2ND, BOUT(KIJS,ITG)) ! CONVERT DIRECTIONS TO DEGREES AND METEOROLOGICAL CONVENTION BOUT(KIJS:KIJL,ITG)=MOD(DEG*BOUT(KIJS:KIJL,ITG)+180._JWRB,360._JWRB) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN + IF (IPFGTBL(3) /= 0) THEN ! CONVERSION TO PERIOD DO IJ=KIJS,KIJL IF (FM(IJ) > 0._JWRB) THEN - BOUT(IJ,ITOBOUT(IR))=1._JWRB/FM(IJ) + BOUT(IJ,ITOBOUT(3))=1._JWRB/FM(IJ) ELSE - BOUT(IJ,ITOBOUT(IR))=ZMISS + BOUT(IJ,ITOBOUT(3))=ZMISS ENDIF ENDDO ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=UFRIC(KIJS:KIJL) + IF (IPFGTBL(4) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(4))=UFRIC(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN + IF (IPFGTBL(5) /= 0) THEN ! CONVERT DIRECTIONS TO DEGREES AND METEOROLOGICAL CONVENTION - BOUT(KIJS:KIJL,ITOBOUT(IR))=MOD(DEG*WDWAVE(KIJS:KIJL)+180._JWRB,360._JWRB) + BOUT(KIJS:KIJL,ITOBOUT(5))=MOD(DEG*WDWAVE(KIJS:KIJL)+180._JWRB,360._JWRB) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN + IF (IPFGTBL(6) /= 0) THEN ! CONVERSION TO PERIOD DO IJ=KIJS,KIJL IF (DP(IJ) > 0.0_JWRB) THEN - BOUT(IJ,ITOBOUT(IR))=DP(IJ) + BOUT(IJ,ITOBOUT(6))=DP(IJ) ELSE - BOUT(IJ,ITOBOUT(IR))=ZMISS + BOUT(IJ,ITOBOUT(6))=ZMISS ENDIF ENDDO ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN + IF (IPFGTBL(7) /= 0) THEN !! if the numerical computation of TAU and CD changes, a similar !! modification has to be put in buildstress where the friction !! velocity is determined from U10 and CD. @@ -258,373 +248,309 @@ SUBROUTINE OUTBLOCK (KIJS, KIJL, MIJ, & & WSWAVE, UFRIC, Z0M, Z0B, CHRNCK, & & CHARNOCK, BETAHQ, CD=CDATM) - BOUT(KIJS:KIJL,ITOBOUT(IR))=MIN(CDATM(KIJS:KIJL), 0.01_JWRB) + BOUT(KIJS:KIJL,ITOBOUT(7))=MIN(CDATM(KIJS:KIJL), 0.01_JWRB) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=TAUW(KIJS:KIJL)/MAX(UFRIC(KIJS:KIJL)**2,EPSUS) + IF (IPFGTBL(8) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(8))=TAUW(KIJS:KIJL)/MAX(UFRIC(KIJS:KIJL)**2,EPSUS) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - CALL MEANSQS (XKMSS_CUTOFF, KIJS, KIJL, FL1, WAVNUM, UFRIC, COSWDIF, BOUT(KIJS,ITOBOUT(IR))) + IF (IPFGTBL(9) /= 0) THEN + CALL MEANSQS (XKMSS_CUTOFF, KIJS, KIJL, FL1, WAVNUM, UFRIC, COSWDIF, BOUT(:,ITOBOUT(9))) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=WSWAVE(KIJS:KIJL) + IF (IPFGTBL(10) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(10))=WSWAVE(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN + IF (IPFGTBL(11) /= 0) THEN ! WINDSEA SIGNIFICANT WAVE HEIGHT CONVERSION - BOUT(KIJS:KIJL,ITOBOUT(IR))=4._JWRB*SQRT(MAX(ESEA(KIJS:KIJL),0._JWRB)) + BOUT(KIJS:KIJL,ITOBOUT(11))=4._JWRB*SQRT(MAX(ESEA(KIJS:KIJL),0._JWRB)) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN + IF (IPFGTBL(12) /= 0) THEN ! TOTAL SWELL SIGNIFICANT WAVE HEIGHT CONVERSION - BOUT(KIJS:KIJL,ITOBOUT(IR))=4._JWRB*SQRT(MAX(ESWELL(KIJS:KIJL),0._JWRB)) + BOUT(KIJS:KIJL,ITOBOUT(12))=4._JWRB*SQRT(MAX(ESWELL(KIJS:KIJL),0._JWRB)) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN + IF (IPFGTBL(13) /= 0) THEN ! CONVERT DIRECTIONS TO DEGREES AND METEOROLOGICAL CONVENTION - BOUT(KIJS:KIJL,ITOBOUT(IR))=MOD(DEG*THWISEA(KIJS:KIJL)+180._JWRB,360._JWRB) + BOUT(KIJS:KIJL,ITOBOUT(13))=MOD(DEG*THWISEA(KIJS:KIJL)+180._JWRB,360._JWRB) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN + IF (IPFGTBL(14) /= 0) THEN ! CONVERT DIRECTIONS TO DEGREES AND METEOROLOGICAL CONVENTION - BOUT(KIJS:KIJL,ITOBOUT(IR))=MOD(DEG*THSWELL(KIJS:KIJL)+180._JWRB,360._JWRB) + BOUT(KIJS:KIJL,ITOBOUT(14))=MOD(DEG*THSWELL(KIJS:KIJL)+180._JWRB,360._JWRB) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN + IF (IPFGTBL(15) /= 0) THEN ! CONVERSION TO PERIOD DO IJ=KIJS,KIJL IF (FSEA(IJ) > 0._JWRB) THEN - BOUT(IJ,ITOBOUT(IR))=1._JWRB/FSEA(IJ) + BOUT(IJ,ITOBOUT(15))=1._JWRB/FSEA(IJ) ELSE - BOUT(IJ,ITOBOUT(IR))=ZMISS + BOUT(IJ,ITOBOUT(15))=ZMISS ENDIF ENDDO ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN + IF (IPFGTBL(16) /= 0) THEN ! CONVERSION TO PERIOD DO IJ=KIJS,KIJL IF (FSWELL(IJ) > 0._JWRB) THEN - BOUT(IJ,ITOBOUT(IR))=1._JWRB/FSWELL(IJ) + BOUT(IJ,ITOBOUT(16))=1._JWRB/FSWELL(IJ) ELSE - BOUT(IJ,ITOBOUT(IR))=ZMISS + BOUT(IJ,ITOBOUT(16))=ZMISS ENDIF ENDDO ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=ALTWH(KIJS:KIJL) + IF (IPFGTBL(17) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(17))=ALTWH(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=CALTWH(KIJS:KIJL) + IF (IPFGTBL(18) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(18))=CALTWH(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=RALTCOR(KIJS:KIJL) + IF (IPFGTBL(19) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(19))=RALTCOR(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - CALL MWP1 (KIJS, KIJL, FL2ND, BOUT(KIJS,ITOBOUT(IR))) + IF (IPFGTBL(20) /= 0) THEN + CALL MWP1 (KIJS, KIJL, FL2ND, BOUT(:,ITOBOUT(20))) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - CALL MWP2 (KIJS, KIJL, FL2ND, BOUT(KIJS,ITOBOUT(IR))) + IF (IPFGTBL(21) /= 0) THEN + CALL MWP2 (KIJS, KIJL, FL2ND, BOUT(:,ITOBOUT(21))) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - CALL WDIRSPREAD (KIJS, KIJL, FL2ND, EM, LLPEAKF, BOUT(KIJS,ITOBOUT(IR))) + IF (IPFGTBL(22) /= 0) THEN + CALL WDIRSPREAD (KIJS, KIJL, FL2ND, EM, LLPEAKF, BOUT(:,ITOBOUT(22))) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=P1SEA(KIJS:KIJL) + IF (IPFGTBL(23) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(23))=P1SEA(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=P1SWELL(KIJS:KIJL) + IF (IPFGTBL(24) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(24))=P1SWELL(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=P2SEA(KIJS:KIJL) + IF (IPFGTBL(25) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(25))=P2SEA(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=P2SWELL(KIJS:KIJL) + IF (IPFGTBL(26) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(26))=P2SWELL(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=SPRDSEA(KIJS:KIJL) + IF (IPFGTBL(27) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(27))=SPRDSEA(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=SPRDSWELL(KIJS:KIJL) + IF (IPFGTBL(28) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(28))=SPRDSWELL(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=C4(KIJS:KIJL) + IF (IPFGTBL(29) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(29))=C4(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=BF(KIJS:KIJL) + IF (IPFGTBL(30) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(30))=BF(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=QP(KIJS:KIJL) + IF (IPFGTBL(31) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(31))=QP(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=DEPTH(KIJS:KIJL) + IF (IPFGTBL(32) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(32))=DEPTH(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=HMAX(KIJS:KIJL) + IF (IPFGTBL(33) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(33))=HMAX(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=TMAX(KIJS:KIJL) + IF (IPFGTBL(34) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(34))=TMAX(KIJS:KIJL) ENDIF ! SURFACE STOKES DRIFT U and V - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=USTOKES(KIJS:KIJL) + IF (IPFGTBL(35) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(35))=USTOKES(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=VSTOKES(KIJS:KIJL) + IF (IPFGTBL(36) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(36))=VSTOKES(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=UCUR(KIJS:KIJL) + IF (IPFGTBL(37) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(37))=UCUR(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=VCUR(KIJS:KIJL) + IF (IPFGTBL(38) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(38))=VCUR(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=PHIEPS(KIJS:KIJL) + IF (IPFGTBL(39) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(39))=PHIEPS(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=PHIAW(KIJS:KIJL) + IF (IPFGTBL(40) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(40))=PHIAW(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=TAUOC(KIJS:KIJL) + IF (IPFGTBL(41) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(41))=TAUOC(KIJS:KIJL) ENDIF DO ITR=1,NTRAIN - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=4._JWRB*SQRT(MAX(EMTRAIN(KIJS:KIJL,ITR),0._JWRB)) + IF (IPFGTBL(42 + (ITR-1)*3) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(42 + (ITR-1)*3))=4._JWRB*SQRT(MAX(EMTRAIN(KIJS:KIJL,ITR),0._JWRB)) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=MOD(DEG*THTRAIN(KIJS:KIJL,ITR)+180._JWRB,360._JWRB) + IF (IPFGTBL(43 + (ITR-1)*3) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(43 + (ITR-1)*3))=MOD(DEG*THTRAIN(KIJS:KIJL,ITR)+180._JWRB,360._JWRB) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=PMTRAIN(KIJS:KIJL,ITR) + IF (IPFGTBL(44 + (ITR-1)*3) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(44 + (ITR-1)*3))=PMTRAIN(KIJS:KIJL,ITR) ENDIF ENDDO - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN + IF (IPFGTBL(42 + 3*NTRAIN) /= 0) THEN IF (LWNEMOCOUSTRN) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=STRNMS(KIJS:KIJL) + BOUT(KIJS:KIJL,ITOBOUT(42 + 3*NTRAIN))=STRNMS(KIJS:KIJL) ELSE - CALL CIMSSTRN (KIJS, KIJL, FL1, WAVNUM, DEPTH, CITHICK, BOUT(KIJS,ITOBOUT(IR))) + CALL CIMSSTRN (KIJS, KIJL, FL1, WAVNUM, DEPTH, CITHICK, BOUT(:,ITOBOUT(42 + 3*NTRAIN))) ENDIF ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN + IF (IPFGTBL(43 + 3*NTRAIN) /= 0) THEN CALL SE10MEAN (KIJS, KIJL, FL2ND, FLD1) - BOUT(KIJS:KIJL,ITOBOUT(IR))=4._JWRB*SQRT(MAX(FLD1(KIJS:KIJL),0._JWRB)) + BOUT(KIJS:KIJL,ITOBOUT(43 + 3*NTRAIN))=4._JWRB*SQRT(MAX(FLD1(KIJS:KIJL),0._JWRB)) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=AIRD(KIJS:KIJL) + IF (IPFGTBL(44 + 3*NTRAIN) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(44 + 3*NTRAIN))=AIRD(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=WSTAR(KIJS:KIJL) + IF (IPFGTBL(45 + 3*NTRAIN) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(45 + 3*NTRAIN))=WSTAR(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=CICOVER(KIJS:KIJL) + IF (IPFGTBL(46 + 3*NTRAIN) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(46 + 3*NTRAIN))=CICOVER(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=CITHICK(KIJS:KIJL) + IF (IPFGTBL(47 + 3*NTRAIN) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(47 + 3*NTRAIN))=CITHICK(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=C3(KIJS:KIJL) + IF (IPFGTBL(48 + 3*NTRAIN) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(48 + 3*NTRAIN))=C3(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=NEMOSST(KIJS:KIJL) + IF (IPFGTBL(49 + 3*NTRAIN) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(49 + 3*NTRAIN))=NEMOSST(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=NEMOCICOVER(KIJS:KIJL) + IF (IPFGTBL(50 + 3*NTRAIN) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(50 + 3*NTRAIN))=NEMOCICOVER(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=NEMOCITHICK(KIJS:KIJL) + IF (IPFGTBL(51 + 3*NTRAIN) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(51 + 3*NTRAIN))=NEMOCITHICK(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=NEMOUCUR(KIJS:KIJL) + IF (IPFGTBL(52 + 3*NTRAIN) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(52 + 3*NTRAIN))=NEMOUCUR(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=NEMOVCUR(KIJS:KIJL) + IF (IPFGTBL(53 + 3*NTRAIN) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(53 + 3*NTRAIN))=NEMOVCUR(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0 .OR. IPFGTBL(IR+1) /= 0) THEN + IF (IPFGTBL(54 + 3*NTRAIN) /= 0 .OR. IPFGTBL(55 + 3*NTRAIN) /= 0) THEN CALL WEFLUX (KIJS, KIJL, FL1, CGROUP, & & NFRE, NANG, DFIM, DELTH, & & COSTH, SINTH, & & FLD1, FLD2) ENDIF - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=FLD1(KIJS:KIJL) + IF (IPFGTBL(54 + 3*NTRAIN) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(54 + 3*NTRAIN))=FLD1(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN + IF (IPFGTBL(55 + 3*NTRAIN) /= 0) THEN ! CONVERT DIRECTIONS TO DEGREES AND METEOROLOGICAL CONVENTION - BOUT(KIJS:KIJL,ITOBOUT(IR))=MOD(DEG*FLD2(KIJS:KIJL)+180._JWRB,360._JWRB) + BOUT(KIJS:KIJL,ITOBOUT(55 + 3*NTRAIN))=MOD(DEG*FLD2(KIJS:KIJL)+180._JWRB,360._JWRB) ENDIF DO IH=1,NTEWH - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - TEWHMIN = REAL(IPRMINFO(IR,4),JWRB) - TEWHMAX = REAL(IPRMINFO(IR,5),JWRB) - CALL SEBTMEAN (KIJS, KIJL, FL2ND, TEWHMIN, TEWHMAX, BOUT(KIJS,ITOBOUT(IR))) + IF (IPFGTBL(55 + 3*NTRAIN + IH) /= 0) THEN + TEWHMIN = REAL(IPRMINFO(55 + 3*NTRAIN + IH,4),JWRB) + TEWHMAX = REAL(IPRMINFO(55 + 3*NTRAIN + IH,5),JWRB) + CALL SEBTMEAN (KIJS, KIJL, FL2ND, TEWHMIN, TEWHMAX, BOUT(:,ITOBOUT(55 + 3*NTRAIN + IH))) ! SIGNIFICANT WAVE HEIGHT CONVERSION - BOUT(KIJS:KIJL,ITOBOUT(IR))=4._JWRB*SQRT(MAX(BOUT(KIJS:KIJL,ITOBOUT(IR)),0._JWRB)) + BOUT(KIJS:KIJL,ITOBOUT(55 + 3*NTRAIN + IH))=4._JWRB*SQRT(MAX(BOUT(KIJS:KIJL,ITOBOUT(55 + 3*NTRAIN + IH)),0._JWRB)) ENDIF ENDDO - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=ETA_M(KIJS:KIJL) + IF (IPFGTBL(56 + 3*NTRAIN + NTEWH) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(56 + 3*NTRAIN + NTEWH))=ETA_M(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=R(KIJS:KIJL) + IF (IPFGTBL(57 + 3*NTRAIN + NTEWH) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(57 + 3*NTRAIN + NTEWH))=R(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=XNSLC(KIJS:KIJL) + IF (IPFGTBL(58 + 3*NTRAIN + NTEWH) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(58 + 3*NTRAIN + NTEWH))=XNSLC(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=TAUXD(KIJS:KIJL) + IF (IPFGTBL(59 + 3*NTRAIN + NTEWH) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(59 + 3*NTRAIN + NTEWH))=TAUXD(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=TAUYD(KIJS:KIJL) + IF (IPFGTBL(60 + 3*NTRAIN + NTEWH) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(60 + 3*NTRAIN + NTEWH))=TAUYD(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=TAUOCXD(KIJS:KIJL) + IF (IPFGTBL(61 + 3*NTRAIN + NTEWH) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(61 + 3*NTRAIN + NTEWH))=TAUOCXD(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=TAUOCYD(KIJS:KIJL) + IF (IPFGTBL(62 + 3*NTRAIN + NTEWH) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(62 + 3*NTRAIN + NTEWH))=TAUOCYD(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN + IF (IPFGTBL(63 + 3*NTRAIN + NTEWH) /= 0) THEN ! !!! make the energy flux positive - BOUT(KIJS:KIJL,ITOBOUT(IR))=MAX(-PHIOCD(KIJS:KIJL),0.0_JWRB) + BOUT(KIJS:KIJL,ITOBOUT(63 + 3*NTRAIN + NTEWH))=MAX(-PHIOCD(KIJS:KIJL),0.0_JWRB) ENDIF !! alternative ways to determine wave height extremes - IF (IPFGTBL(IR ) /= 0 .OR. IPFGTBL(IR+1) /= 0 .OR. & -& IPFGTBL(IR+2) /= 0 .OR. IPFGTBL(IR+3) /= 0 ) THEN + IF (IPFGTBL(63 + 3*NTRAIN + NTEWH) /= 0 .OR. IPFGTBL(64 + 3*NTRAIN + NTEWH) /= 0 .OR. & +& IPFGTBL(65 + 3*NTRAIN + NTEWH) /= 0 .OR. IPFGTBL(66 + 3*NTRAIN + NTEWH) /= 0 ) THEN CALL W_MAXH (KIJS, KIJL, FL1, DEPTH, WAVNUM, & & CMAX_F, HMAX_N, CMAX_ST, HMAX_ST, PHIST) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=CMAX_F(KIJS:KIJL) + IF (IPFGTBL(64 + 3*NTRAIN + NTEWH) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(64 + 3*NTRAIN + NTEWH))=CMAX_F(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=HMAX_N(KIJS:KIJL) + IF (IPFGTBL(65 + 3*NTRAIN + NTEWH) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(65 + 3*NTRAIN + NTEWH))=HMAX_N(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=CMAX_ST(KIJS:KIJL) + IF (IPFGTBL(66 + 3*NTRAIN + NTEWH) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(66 + 3*NTRAIN + NTEWH))=CMAX_ST(KIJS:KIJL) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=HMAX_ST(KIJS:KIJL) + IF (IPFGTBL(67 + 3*NTRAIN + NTEWH) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(67 + 3*NTRAIN + NTEWH))=HMAX_ST(KIJS:KIJL) ENDIF !! @@ -632,36 +558,31 @@ SUBROUTINE OUTBLOCK (KIJS, KIJL, MIJ, & ! COMPUTE OUTPUT EXTRA FIELDS ! add necessary code to compute the extra output fields !!!for testing - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - CALL CTCOR (KIJS, KIJL, FL1, BOUT(KIJS,ITOBOUT(IR))) + IF (IPFGTBL(68 + 3*NTRAIN + NTEWH) /= 0) THEN + CALL CTCOR (KIJS, KIJL, FL1, BOUT(:,ITOBOUT(68 + 3*NTRAIN + NTEWH))) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN + IF (IPFGTBL(69 + 3*NTRAIN + NTEWH) /= 0) THEN XMODEL_CUTOFF=(ZPI*FR(NFRE))**2/G - CALL MEANSQS (XMODEL_CUTOFF, KIJS, KIJL, FL1, WAVNUM, UFRIC, COSWDIF, BOUT(KIJS,ITOBOUT(IR))) + CALL MEANSQS (XMODEL_CUTOFF, KIJS, KIJL, FL1, WAVNUM, UFRIC, COSWDIF, BOUT(:,ITOBOUT(69 + 3*NTRAIN + NTEWH))) ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=0._JWRB + IF (IPFGTBL(70 + 3*NTRAIN + NTEWH) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(70 + 3*NTRAIN + NTEWH))=0._JWRB ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=0._JWRB + IF (IPFGTBL(71 + 3*NTRAIN + NTEWH) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(71 + 3*NTRAIN + NTEWH))=0._JWRB ENDIF - IR=IR+1 - IF (IPFGTBL(IR) /= 0) THEN - BOUT(KIJS:KIJL,ITOBOUT(IR))=0._JWRB + IF (IPFGTBL(72 + 3*NTRAIN + NTEWH) /= 0) THEN + BOUT(KIJS:KIJL,ITOBOUT(72 + 3*NTRAIN + NTEWH))=0._JWRB ENDIF ! APPLY SEA ICE MASK AND SEA MASK IF NECESSARY - CALL OUTSETWMASK (KIJS, KIJL, IODP(KIJS:KIJL), CICOVER, BOUT) + CALL OUTSETWMASK (KIJS, KIJL, IODP, CICOVER, BOUT) IF (LHOOK) CALL DR_HOOK('OUTBLOCK',1,ZHOOK_HANDLE) diff --git a/src/ecwam/outbs_loki_gpu.F90 b/src/ecwam/outbs_loki_gpu.F90 new file mode 100644 index 000000000..9c4720b5d --- /dev/null +++ b/src/ecwam/outbs_loki_gpu.F90 @@ -0,0 +1,133 @@ +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + +SUBROUTINE OUTBS_LOKI_GPU (MIJ, FL1, XLLWS, & + & WVPRPT, WVENVI, FF_NOW, INTFLDS, NEMO2WAM, & + & BOUT) +! ---------------------------------------------------------------------- + +!**** *OUTBS* - MODEL OUTPUT FROM BLOCK TO FILE, PRINTER AND COMMON. + +!* PURPOSE. +! -------- + +! CONTROL OUTPUT OF WAVE AND WIND FIELDS (except spectrum). + +!** INTERFACE. +! ---------- +! *CALL*OUTBS (MIJ, FL1, XLLWS, +! WVPRPT, WVENVI, FF_NOW, INTFLDS, NEMO2WAM, BOUT) +! *MIJ* - LAST FREQUENCY INDEX OF THE PROGNOSTIC RANGE. +! *FL1* - INPUT SPECTRUM. +! *XLLWS* - WINDSEA MASK FROM INPUT SOURCE TERM +! *WVENVI* - WAVE ENVIRONMENT (depth, currents,...) +! *FF_NOW* - FORCING FIELDS +! *INTFLDS* - INTEGRATED/DERIVED PARAMETERS +! *NEMO2WAM*- FIELDS FRON OCEAN MODEL to WAM +! *BOUT* - OUTPUT PARAMETERS BUFFER + + + +! EXTERNALS. +! ---------- + +! *OUTBLOCK* - GET ALL OUTPUT PARAMETERS +! +! METHOD. +! ------- + +! NONE. + +! REFERENCE. +! ---------- + +! NONE. + +! ---------------------------------------------------------------------- + USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU + USE YOWDRVTYPE , ONLY : ENVIRONMENT, FREQUENCY, FORCING_FIELDS, & + & INTGT_PARAM_FIELDS, OCEAN2WAVE + + USE YOWCOUT , ONLY : JPPFLAG ,NIPRMOUT + USE YOWCOUP , ONLY : LLNORMWAMOUT + USE YOWGRID , ONLY : NPROMA_WAM, NCHNK + USE YOWPARAM , ONLY : NANG ,NFRE + + USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK + +! ---------------------------------------------------------------------- + IMPLICIT NONE + +#include "outblock.intfb.h" +#include "outwnorm.intfb.h" + + INTEGER(KIND=JWIM), DIMENSION(NPROMA_WAM, NCHNK), INTENT(IN) :: MIJ + REAL(KIND=JWRB), DIMENSION(NPROMA_WAM, NANG, NFRE, NCHNK), INTENT(IN) :: FL1 + REAL(KIND=JWRB), DIMENSION(NPROMA_WAM, NANG, NFRE, NCHNK), INTENT(IN) :: XLLWS + TYPE(FREQUENCY), INTENT(IN) :: WVPRPT + TYPE(ENVIRONMENT), INTENT(IN) :: WVENVI + TYPE(FORCING_FIELDS), INTENT(IN) :: FF_NOW + TYPE(INTGT_PARAM_FIELDS), INTENT(IN) :: INTFLDS + TYPE(OCEAN2WAVE), INTENT(IN) :: NEMO2WAM + REAL(KIND=JWRB), DIMENSION(NPROMA_WAM, NIPRMOUT, NCHNK), INTENT(OUT) :: BOUT + + + INTEGER(KIND=JWIM) :: ICHNK + + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + + LOGICAL :: LDREPROD + +! ---------------------------------------------------------------------- + +IF (LHOOK) CALL DR_HOOK('OUTBS',0,ZHOOK_HANDLE) + +!* 1. COMPUTE MEAN PARAMETERS. +! ------------------------ + +! COMPUTE MEAN PARAMETERS +!$loki update_device + + CALL GSTATS(1502,0) +!$acc data present(MIJ,WVPRPT,WVENVI,INTFLDS,FF_NOW,NEMO2WAM) copyout(BOUT) + + DO ICHNK = 1, NCHNK + CALL OUTBLOCK(1, NPROMA_WAM, MIJ(:,ICHNK), & + & FL1(:,:,:,ICHNK), XLLWS(:,:,:,ICHNK), & + & WVPRPT%WAVNUM(:,:,ICHNK), WVPRPT%CINV(:,:,ICHNK), WVPRPT%CGROUP(:,:,ICHNK), & + & WVENVI%DEPTH(:,ICHNK), WVENVI%UCUR(:,ICHNK), WVENVI%VCUR(:,ICHNK), & + & WVENVI%IODP(:,ICHNK), & + & INTFLDS%ALTWH(:,ICHNK), INTFLDS%CALTWH(:,ICHNK), INTFLDS%RALTCOR(:,ICHNK), & + & INTFLDS%USTOKES(:,ICHNK), INTFLDS%VSTOKES(:,ICHNK), INTFLDS%STRNMS(:,ICHNK), & + & INTFLDS%TAUXD(:,ICHNK), INTFLDS%TAUYD(:,ICHNK), INTFLDS%TAUOCXD(:,ICHNK), & + & INTFLDS%TAUOCYD(:,ICHNK), INTFLDS%TAUOC(:,ICHNK), INTFLDS%PHIOCD(:,ICHNK), & + & INTFLDS%PHIEPS(:,ICHNK), INTFLDS%PHIAW(:,ICHNK), & + & FF_NOW%AIRD(:,ICHNK), FF_NOW%WDWAVE(:,ICHNK), FF_NOW%CICOVER(:,ICHNK), & + & FF_NOW%WSWAVE(:,ICHNK), FF_NOW%WSTAR(:,ICHNK), & + & FF_NOW%UFRIC(:,ICHNK), FF_NOW%TAUW(:,ICHNK), & + & FF_NOW%Z0M(:,ICHNK), FF_NOW%Z0B(:,ICHNK), FF_NOW%CHRNCK(:,ICHNK), & + & FF_NOW%CITHICK(:,ICHNK), & + & NEMO2WAM%NEMOSST(:, ICHNK), NEMO2WAM%NEMOCICOVER(:,ICHNK), & + & NEMO2WAM%NEMOCITHICK(:, ICHNK), NEMO2WAM%NEMOUCUR(:,ICHNK), & + & NEMO2WAM%NEMOVCUR(:, ICHNK), & + & BOUT(:,:,ICHNK)) + ENDDO + +!$acc end data + CALL GSTATS(1502,1) + +! PRINT OUT NORMS +!!!1 to do: decide if there are cases where we might want LDREPROD false + LDREPROD=.TRUE. + IF (LLNORMWAMOUT) CALL OUTWNORM(LDREPROD, BOUT) + + +IF (LHOOK) CALL DR_HOOK('OUTBS',1,ZHOOK_HANDLE) + +END SUBROUTINE OUTBS_LOKI_GPU diff --git a/src/ecwam/outsetwmask.F90 b/src/ecwam/outsetwmask.F90 index 487be1133..24bded88b 100644 --- a/src/ecwam/outsetwmask.F90 +++ b/src/ecwam/outsetwmask.F90 @@ -43,9 +43,9 @@ SUBROUTINE OUTSETWMASK (KIJS, KIJL, IODP, CICVR, BOUT) IMPLICIT NONE INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - INTEGER(KIND=JWIM), DIMENSION(KIJS:KIJL), INTENT(IN) :: IODP - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: CICVR - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NIPRMOUT), INTENT(INOUT) :: BOUT + INTEGER(KIND=JWIM), DIMENSION(KIJL), INTENT(IN) :: IODP + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: CICVR + REAL(KIND=JWRB), DIMENSION(KIJL,NIPRMOUT), INTENT(INOUT) :: BOUT INTEGER(KIND=JWIM) :: IJ, ITG, IR diff --git a/src/ecwam/outspec.F90 b/src/ecwam/outspec.F90 index 57e2d645c..c3cf84c90 100644 --- a/src/ecwam/outspec.F90 +++ b/src/ecwam/outspec.F90 @@ -70,7 +70,7 @@ SUBROUTINE OUTSPEC (FL1, FF_NOW) #include "difdate.intfb.h" REAL(KIND=JWRB), DIMENSION(NPROMA_WAM, NANG, NFRE, NCHNK), INTENT(IN) :: FL1 - TYPE(FORCING_FIELDS), INTENT(INOUT) :: FF_NOW + TYPE(FORCING_FIELDS), INTENT(IN) :: FF_NOW INTEGER(KIND=JWIM) :: IJ, K, M diff --git a/src/ecwam/outstep0.F90 b/src/ecwam/outstep0.F90 index dced0a6f8..ee11031a6 100644 --- a/src/ecwam/outstep0.F90 +++ b/src/ecwam/outstep0.F90 @@ -43,6 +43,7 @@ SUBROUTINE OUTSTEP0 (WVENVI, WVPRPT, FF_NOW, INTFLDS, & USE YOWPARAM , ONLY : NANG ,NFRE ,LLUNSTR USE YOWSTAT , ONLY : CDTPRO ,CDTINTT ,IREST , MARSTYPE , & & LLSOURCE , LANAONLY ,LFRSTFLD + USE YOWTEST , ONLY : IU06 USE YOWTEXT , ONLY : LRESTARTED #ifdef WAM_HAVE_UNWAM USE UNWAM , ONLY : EXCHANGE_FOR_FL1 @@ -219,11 +220,15 @@ SUBROUTINE OUTSTEP0 (WVENVI, WVPRPT, FF_NOW, INTFLDS, & IF ( .NOT. LRESTARTED ) THEN IF (IREST == 1 .AND. MARSTYPE /= 'an' .AND. LGRIBOUT) THEN CALL OUTSPEC(FL1, FF_NOW) + WRITE(IU06,*) '' + WRITE(IU06,*) ' OUTSTEP0: OUTSPEC WAS CALLED !' LLFLUSH = .TRUE. ENDIF IF (NIPRMOUT > 0 ) THEN CALL OUTWINT(BOUTST0) + WRITE(IU06,*) '' + WRITE(IU06,*) ' OUTSTEP0: OUTWINT WAS CALLED !' LLFLUSH = .TRUE. ENDIF diff --git a/src/ecwam/parmean.F90 b/src/ecwam/parmean.F90 index ea3a61289..58b4f659b 100644 --- a/src/ecwam/parmean.F90 +++ b/src/ecwam/parmean.F90 @@ -69,9 +69,9 @@ SUBROUTINE PARMEAN (KIJS, KIJL, NPMAX, NPEAK, & IMPLICIT NONE INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL, NPMAX - INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJS:KIJL) :: NPEAK - REAL(KIND=JWRB), INTENT(IN) :: SPEC(NANG,NFRE,NPMAX,KIJS:KIJL) - REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJS:KIJL,0:NPMAX) :: ENE, DIR, PER + INTEGER(KIND=JWIM), INTENT(IN), DIMENSION(KIJL) :: NPEAK + REAL(KIND=JWRB), INTENT(IN) :: SPEC(NANG,NFRE,NPMAX,KIJL) + REAL(KIND=JWRB), INTENT(OUT), DIMENSION(KIJL,0:NPMAX) :: ENE, DIR, PER INTEGER(KIND=JWIM) :: IPK, IJ, K, M, IP diff --git a/src/ecwam/peakfri.F90 b/src/ecwam/peakfri.F90 index 3b7b02411..c6e3bec3a 100644 --- a/src/ecwam/peakfri.F90 +++ b/src/ecwam/peakfri.F90 @@ -64,10 +64,10 @@ SUBROUTINE PEAKFRI (KIJS, KIJL, F, IPEAKF, EPEAKF, F1D) IMPLICIT NONE INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB), INTENT(IN) :: F(KIJS:KIJL,NANG,NFRE) - INTEGER(KIND=JWIM), INTENT(OUT) :: IPEAKF(KIJS:KIJL) - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: EPEAKF - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NFRE), INTENT(OUT) :: F1D + REAL(KIND=JWRB), INTENT(IN) :: F(KIJL,NANG,NFRE) + INTEGER(KIND=JWIM), INTENT(OUT) :: IPEAKF(KIJL) + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: EPEAKF + REAL(KIND=JWRB), DIMENSION(KIJL,NFRE), INTENT(OUT) :: F1D INTEGER(KIND=JWIM) :: IJ, K, M REAL(KIND=JPHOOK) :: ZHOOK_HANDLE diff --git a/src/ecwam/prewind.F90 b/src/ecwam/prewind.F90 index ea5ec27c7..aa6240d77 100644 --- a/src/ecwam/prewind.F90 +++ b/src/ecwam/prewind.F90 @@ -178,7 +178,7 @@ SUBROUTINE PREWIND (BLK2LOC, WVENVI, FF_NOW, FF_NEXT, & !* 2.0 GLOBAL FIELD FOR THE INPUTS ! --------------------------- - CALL FIELDG%ALLOC(NXS, NYS, UBND0=NXE, UBND1=NYE) + IF(.NOT. FIELDG%LALLOC) CALL FIELDG%ALLOC(LBOUNDS=[NXS, NYS], UBOUNDS=[NXE, NYE]) IF (LLINIT_FIELDG) THEN LLINIALL=.TRUE. diff --git a/src/ecwam/proenvhalo.F90 b/src/ecwam/proenvhalo.F90 index 0414edacc..b5e27bff6 100644 --- a/src/ecwam/proenvhalo.F90 +++ b/src/ecwam/proenvhalo.F90 @@ -50,7 +50,7 @@ SUBROUTINE PROENVHALO (NINF, NSUP, & INTEGER(KIND=JWIM) :: IJ, M INTEGER(KIND=JWIM) :: ICHNK, KIJS, KIJL, IJSB, IJLB - REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE, ZHOOK_HANDLE_MPI ! ---------------------------------------------------------------------- @@ -89,11 +89,13 @@ SUBROUTINE PROENVHALO (NINF, NSUP, & !$OMP END PARALLEL DO #endif /*_OPENACC*/ -!$acc data copyin(WVPRPT_LAND) & -!$acc copyin(WVPRPT_LAND%WAVNUM,WVPRPT_LAND%CGROUP,WVPRPT_LAND%OMOSNH2KD) - +#ifdef WAM_GPU + CALL WVPRPT_LAND%GET_DEVICE_DATA_RDONLY() +#endif + IF (LHOOK) CALL DR_HOOK('MPI_TIME',0,ZHOOK_HANDLE_MPI) CALL MPEXCHNG(BUFFER_EXT, 3*NFRE_RED+5, 1, 1) - !$acc kernels + IF (LHOOK) CALL DR_HOOK('MPI_TIME',1,ZHOOK_HANDLE_MPI) + !$acc kernels present(WVPRPT_LAND) BUFFER_EXT(NSUP+1,1:NFRE_RED) = WVPRPT_LAND%WAVNUM(1:NFRE_RED) BUFFER_EXT(NSUP+1,NFRE_RED+1:2*NFRE_RED) = WVPRPT_LAND%CGROUP(1:NFRE_RED) BUFFER_EXT(NSUP+1,2*NFRE_RED+1:3*NFRE_RED) = WVPRPT_LAND%OMOSNH2KD(1:NFRE_RED) @@ -105,7 +107,6 @@ SUBROUTINE PROENVHALO (NINF, NSUP, & !$acc end kernels !$acc end data -!$acc end data IF (LHOOK) CALL DR_HOOK('PROENVHALO',1,ZHOOK_HANDLE) diff --git a/src/ecwam/propag_wam.F90 b/src/ecwam/propag_wam.F90 index dd058d46b..518fe5d74 100644 --- a/src/ecwam/propag_wam.F90 +++ b/src/ecwam/propag_wam.F90 @@ -83,7 +83,7 @@ SUBROUTINE PROPAG_WAM (BLK2GLO, WAVNUM, CGROUP, OMOSNH2KD, FL1, & INTEGER(KIND=JWIM) :: IJSG, IJLG, ICHNK, KIJS, KIJL, IJSB, IJLB INTEGER(KIND=JWIM) :: ND3SF1, ND3EF1, ND3S, ND3E - REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE, ZHOOK_HANDLE_MPI ! Spectra extended with the halo exchange for the propagation ! But limited to NFRE_RED frequencies @@ -100,7 +100,7 @@ SUBROUTINE PROPAG_WAM (BLK2GLO, WAVNUM, CGROUP, OMOSNH2KD, FL1, & IF (LHOOK) CALL DR_HOOK('PROPAG_WAM',0,ZHOOK_HANDLE) -!$acc data present(FL1, WAVNUM, CGROUP, OMOSNH2KD, DEPTH, DELLAM1,COSPHM1,UCUR,VCUR) CREATE(FL1_EXT,FL3_EXT) & +!$acc data present(FL1, WAVNUM, CGROUP, OMOSNH2KD, DEPTH, DELLAM1,COSPHM1,UCUR,VCUR,BLK2GLO) CREATE(FL1_EXT,FL3_EXT) & !$acc & create(BUFFER_EXT) IF (NIBLO > 1) THEN @@ -160,7 +160,9 @@ SUBROUTINE PROPAG_WAM (BLK2GLO, WAVNUM, CGROUP, OMOSNH2KD, FL1, & ! OBTAIN INFORMATION AT NEIGHBORING GRID POINTS (HALO) ! ---------------------------------------------------- + IF (LHOOK) CALL DR_HOOK('MPI_TIME',0,ZHOOK_HANDLE_MPI) CALL MPEXCHNG(FL1_EXT, NANG, 1, NFRE_RED) + IF (LHOOK) CALL DR_HOOK('MPI_TIME',1,ZHOOK_HANDLE_MPI) CALL GSTATS(1430,0) @@ -280,7 +282,9 @@ SUBROUTINE PROPAG_WAM (BLK2GLO, WAVNUM, CGROUP, OMOSNH2KD, FL1, & #endif /*_OPENACC*/ ! OBTAIN INFORMATION AT NEIGHBORING GRID POINTS (HALO) + IF (LHOOK) CALL DR_HOOK('MPI_TIME',0,ZHOOK_HANDLE_MPI) CALL MPEXCHNG(FL1_EXT(:,:,ND3S:ND3E), NANG, ND3S, ND3E) + IF (LHOOK) CALL DR_HOOK('MPI_TIME',1,ZHOOK_HANDLE_MPI) #ifndef _OPENACC !$OMP PARALLEL DO SCHEDULE(STATIC,1) PRIVATE(JKGLO, KIJS, KIJL) diff --git a/src/ecwam/readmdlconf.F90 b/src/ecwam/readmdlconf.F90 index 3d3fed26f..057a27d6c 100644 --- a/src/ecwam/readmdlconf.F90 +++ b/src/ecwam/readmdlconf.F90 @@ -72,6 +72,9 @@ SUBROUTINE READMDLCONF (LLREADPRE, LLREADBATHY) LLBATHY = .TRUE. ENDIF + IF (BLK2GLO%LALLOC) CALL BLK2GLO%DEALLOC() + CALL BLK2GLO%ALLOC(UBOUNDS=[NIBLO]) + IREAD = IREADG IF ( LLREAD ) THEN @@ -103,8 +106,8 @@ SUBROUTINE READMDLCONF (LLREADPRE, LLREADBATHY) CALL ABORT1 ENDIF - IF (ALLOCATED(BLK2GLO%IXLG)) CALL BLK2GLO%DEALLOC - CALL BLK2GLO%ALLOC(NIBLO) + IF (BLK2GLO%LALLOC) CALL BLK2GLO%DEALLOC() + CALL BLK2GLO%ALLOC(UBOUNDS=[NIBLO]) IP = 0 DO K=1,NGY @@ -167,6 +170,7 @@ SUBROUTINE READMDLCONF (LLREADPRE, LLREADBATHY) IJS = 1 IJL = NIBLO +!$acc update device(COSPH) IF (LHOOK) CALL DR_HOOK('READMDLCONF',1,ZHOOK_HANDLE) END SUBROUTINE READMDLCONF diff --git a/src/ecwam/runwam.F90 b/src/ecwam/runwam.F90 index 680e4dee4..c55562603 100644 --- a/src/ecwam/runwam.F90 +++ b/src/ecwam/runwam.F90 @@ -102,7 +102,7 @@ SUBROUTINE RUNWAM USE YOWMPP , ONLY : IRANK ,NPROC USE YOWSTAT , ONLY : CDATEE ,CDTPRO , & & IPROPAGS ,LSUBGRID ,IREFRA ,IDELPRO, TIME_PHYS, & - & TIME_PROPAG, TIME_OFFLOAD + & TIME_PROPAG USE YOWWAMI , ONLY : CBPLTDT ,CEPLTDT USE YOWALTAS , ONLY : LODBRALT USE MPL_MODULE, ONLY : MPL_INIT, MPL_END, MPL_COMM @@ -120,6 +120,7 @@ SUBROUTINE RUNWAM #include "mpclose_unit.intfb.h" #include "wavemdl.intfb.h" #include "wvalloc.intfb.h" +#include "wvdealloc.intfb.h" #include "wvwamdecomp.intfb.h" #include "wvwaminit.intfb.h" #include "wvwaminit1.intfb.h" @@ -369,6 +370,8 @@ SUBROUTINE RUNWAM ! 4. FINALIZE RUNWAM ! --------------- + CALL WVDEALLOC + CALL GSTATS(0,1) CALL WAM_GSTATS_FILE_OPEN(IUGSTATS) @@ -389,15 +392,8 @@ SUBROUTINE RUNWAM WRITE (IU06,'(A,F18.2,A)') ' + ', time, ' +' WRITE (IU06,'(A)') ' + WAVE PROPAGATION TIME +' WRITE (IU06,'(A,F18.2,A)') ' + ', TIME_PROPAG, ' +' -#if defined(WAM_GPU) - WRITE (IU06,'(A)') ' + SOURCE TERM TIME +' - WRITE (IU06,'(A,F18.2,A)') ' + ', TIME_PHYS, ' +' - WRITE (IU06,'(A)') ' + DATA OFFLOAD TIME +' - WRITE (IU06,'(A,F18.2,A)') ' + ', TIME_OFFLOAD, ' +' -#else WRITE (IU06,'(A)') ' + SOURCE TERM TIME +' WRITE (IU06,'(A,F18.2,A)') ' + ', TIME_PHYS, ' +' -#endif WRITE (IU06,'(A)') ' + +' WRITE (IU06,'(A,I8,A)') ' + ON PE : ', IRANK, ' +' WRITE (IU06,'(A)') ' ++++++++++++++++++++++++++++++' @@ -407,15 +403,8 @@ SUBROUTINE RUNWAM WRITE (6,'(A,F18.2,A)') ' + ', time, ' +' WRITE (6,'(A)') ' + WAVE PROPAGATION TIME +' WRITE (6,'(A,F18.2,A)') ' + ', TIME_PROPAG, ' +' -#if defined(WAM_GPU) WRITE (6,'(A)') ' + SOURCE TERM TIME +' WRITE (6,'(A,F18.2,A)') ' + ', TIME_PHYS, ' +' - WRITE (6,'(A)') ' + DATA OFFLOAD TIME +' - WRITE (6,'(A,F18.2,A)') ' + ', TIME_OFFLOAD, ' +' -#else - WRITE (6,'(A)') ' + SOURCE TERM TIME +' - WRITE (6,'(A,F18.2,A)') ' + ', TIME_PHYS, ' +' -#endif WRITE (6,'(A)') ' + +' WRITE (6,'(A,I8,A)') ' + ON PE : ', IRANK, ' +' WRITE (6,'(A)') ' ++++++++++++++++++++++++++++++' diff --git a/src/ecwam/scosfl.F90 b/src/ecwam/scosfl.F90 index 9b0e881d2..4989f7413 100644 --- a/src/ecwam/scosfl.F90 +++ b/src/ecwam/scosfl.F90 @@ -61,14 +61,14 @@ SUBROUTINE SCOSFL (KIJS, KIJL, F, MM, MEANCOSFL) IMPLICIT NONE INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL, NANG, NFRE), INTENT(IN) :: F - INTEGER(KIND=JWIM), DIMENSION(KIJS:KIJL), INTENT(IN) :: MM - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: MEANCOSFL + REAL(KIND=JWRB), DIMENSION(KIJL, NANG, NFRE), INTENT(IN) :: F + INTEGER(KIND=JWIM), DIMENSION(KIJL), INTENT(IN) :: MM + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: MEANCOSFL INTEGER(KIND=JWIM) :: IJ, K REAL(KIND=JPHOOK) :: ZHOOK_HANDLE - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: MEANDIR, SI, CI + REAL(KIND=JWRB), DIMENSION(KIJL) :: MEANDIR, SI, CI ! ---------------------------------------------------------------------- diff --git a/src/ecwam/sdepthlim.F90 b/src/ecwam/sdepthlim.F90 index 0e3245807..78abf8538 100644 --- a/src/ecwam/sdepthlim.F90 +++ b/src/ecwam/sdepthlim.F90 @@ -62,6 +62,7 @@ SUBROUTINE SDEPTHLIM(KIJS, KIJL, EMAXDPT, FL1) IF (LHOOK) CALL DR_HOOK('SDEPTHLIM',0,ZHOOK_HANDLE) LLEPSMIN=.TRUE. + !$loki inline CALL SEMEAN (FL1, KIJS, KIJL, EM, LLEPSMIN) DO IJ=KIJS,KIJL diff --git a/src/ecwam/sdissip.F90 b/src/ecwam/sdissip.F90 index 6a1ef58d1..a0427fc45 100644 --- a/src/ecwam/sdissip.F90 +++ b/src/ecwam/sdissip.F90 @@ -75,11 +75,13 @@ SUBROUTINE SDISSIP (KIJS, KIJL, FL1, FLD, SL, & SELECT CASE (IPHYS) CASE(0) + !$loki inline CALL SDISSIP_JAN (KIJS, KIJL, FL1 ,FLD, SL, & & WAVNUM, & & EMEAN, F1MEAN, XKMEAN) CASE(1) + !$loki inline CALL SDISSIP_ARD (KIJS, KIJL, FL1 ,FLD, SL, & & WAVNUM, CGROUP, XK2CG, & & UFRIC, COSWDIF, RAORW) diff --git a/src/ecwam/se10mean.F90 b/src/ecwam/se10mean.F90 index ae6d3d4c0..a1429c623 100644 --- a/src/ecwam/se10mean.F90 +++ b/src/ecwam/se10mean.F90 @@ -59,8 +59,8 @@ SUBROUTINE SE10MEAN (KIJS, KIJL, FL1, E10) INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL, NANG, NFRE), INTENT(IN) :: FL1 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: E10 + REAL(KIND=JWRB), DIMENSION(KIJL, NANG, NFRE), INTENT(IN) :: FL1 + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: E10 INTEGER(KIND=JWIM) :: IJ, M, K, MCUT @@ -69,7 +69,7 @@ SUBROUTINE SE10MEAN (KIJS, KIJL, FL1, E10) REAL(KIND=JWRB) :: DFCUT REAL(KIND=JPHOOK) :: ZHOOK_HANDLE REAL(KIND=JWRB), DIMENSION(NFRE) :: DFIMLOC - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: TEMP + REAL(KIND=JWRB), DIMENSION(KIJL) :: TEMP ! ---------------------------------------------------------------------- diff --git a/src/ecwam/sebtmean.F90 b/src/ecwam/sebtmean.F90 index 510dd5586..44e1380fa 100644 --- a/src/ecwam/sebtmean.F90 +++ b/src/ecwam/sebtmean.F90 @@ -61,9 +61,9 @@ SUBROUTINE SEBTMEAN (KIJS, KIJL, FL1, TB, TT, EBT) IMPLICIT NONE INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL, NANG, NFRE), INTENT(IN) :: FL1 + REAL(KIND=JWRB), DIMENSION(KIJL, NANG, NFRE), INTENT(IN) :: FL1 REAL(KIND=JWRB), INTENT(IN) :: TB, TT - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: EBT + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: EBT INTEGER(KIND=JWIM) :: IJ, M, K, MCUTB, MCUTT @@ -71,7 +71,7 @@ SUBROUTINE SEBTMEAN (KIJS, KIJL, FL1, TB, TT, EBT) REAL(KIND=JWRB) :: FCUTB, FCUTT, DFCUT, FBOT, FTOP, ZW REAL(KIND=JPHOOK) :: ZHOOK_HANDLE REAL(KIND=JWRB), DIMENSION(NFRE) :: DFIMLOC - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: TEMP + REAL(KIND=JWRB), DIMENSION(KIJL) :: TEMP ! ---------------------------------------------------------------------- diff --git a/src/ecwam/secspom.F90 b/src/ecwam/secspom.F90 index b5d65a056..10b789927 100644 --- a/src/ecwam/secspom.F90 +++ b/src/ecwam/secspom.F90 @@ -9,8 +9,8 @@ !-------------------------------------------------------------------- ! - SUBROUTINE SECSPOM(F1,F3,KIJS,KIJL,NFRE,NANG,NMAX,NDEPTH,DEPTHA, & - & DEPTHD,OMSTART,FRAC,MR,DFDTH,OMEGA,DEPTH, & + SUBROUTINE SECSPOM(F1,F3,KIJS,KIJL,NFRE,NANG,NDEPTH,DEPTHA, & + & DEPTHD,OMSTART,FRAC,MR,DFDTH,OMEGA,DEPTH, & & AKMEAN,TA,TB,TC_QL,TT_4M,TT_4P,IM_P,IM_M) ! !-------------------------------------------------------------------- @@ -84,6 +84,7 @@ SUBROUTINE SECSPOM(F1,F3,KIJS,KIJL,NFRE,NANG,NMAX,NDEPTH,DEPTHA, & !-------------------------------------------------------------------- USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU + USE YOWTABL, ONLY : NMAX USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK @@ -91,26 +92,26 @@ SUBROUTINE SECSPOM(F1,F3,KIJS,KIJL,NFRE,NANG,NMAX,NDEPTH,DEPTHA, & IMPLICIT NONE - INTEGER(KIND=JWIM),INTENT(IN) :: KIJS,KIJL,NFRE,NANG,NMAX,NDEPTH,MR + INTEGER(KIND=JWIM),INTENT(IN) :: KIJS,KIJL,NFRE,NANG,NDEPTH,MR INTEGER(KIND=JWIM),DIMENSION(NFRE,NFRE), INTENT(IN) :: IM_P, IM_M REAL(KIND=JWRB), INTENT(IN) :: DEPTHA, DEPTHD, OMSTART, FRAC REAL(KIND=JWRB), DIMENSION(NFRE), INTENT(IN) :: OMEGA, DFDTH - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: DEPTH, AKMEAN - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE), INTENT(IN) :: F1 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE), INTENT(OUT) :: F3 + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: DEPTH, AKMEAN + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE), INTENT(IN) :: F1 + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE), INTENT(OUT) :: F3 REAL(KIND=JWRB), DIMENSION(NDEPTH,NANG,NFRE,NFRE), INTENT(IN) :: TA,TB,TC_QL,TT_4M,TT_4P INTEGER(KIND=JWIM):: IJ, M, K, M1, K1, M2_M, M2_P, K2, MP, MM,L,ID INTEGER(KIND=JWIM), DIMENSION(NANG,NANG) :: LL - INTEGER(KIND=JWIM), DIMENSION(KIJS:KIJL) :: JD + INTEGER(KIND=JWIM), DIMENSION(KIJL) :: JD REAL(KIND=JWRB) :: OM0, OM0P, OM0M, OM0H, OM1 REAL(KIND=JWRB) :: T_4M, T_4P, DELM1, XD, X_MIN, OMRT, XLOGD, OMG5 REAL(KIND=JPHOOK) :: ZHOOK_HANDLE REAL(KIND=JWRB), DIMENSION(NMAX) :: OMEGA_EXT - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: XINCR, DF2KP, DF2KM, PSUM - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NMAX) :: F2 + REAL(KIND=JWRB), DIMENSION(KIJL) :: XINCR, DF2KP, DF2KM, PSUM + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NMAX) :: F2 LOGICAL :: LLSAMEDPTH diff --git a/src/ecwam/sep3tr.F90 b/src/ecwam/sep3tr.F90 index cc3bafffb..94e1afca6 100644 --- a/src/ecwam/sep3tr.F90 +++ b/src/ecwam/sep3tr.F90 @@ -70,7 +70,7 @@ SUBROUTINE SEP3TR (KIJS, KIJL, FL1, MIJ, WSWAVE, WDWAVE , COSWDIF, & & TH ,COSTH ,SINTH ,FRIC USE YOWICE , ONLY : FLMIN USE YOWPARAM , ONLY : NANG ,NFRE - USE YOWPCONS , ONLY : ZPI ,G ,EPSMIN + USE YOWPCONS , ONLY : ZPI ,G ,EPSMIN, NPMAX USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK @@ -81,28 +81,27 @@ SUBROUTINE SEP3TR (KIJS, KIJL, FL1, MIJ, WSWAVE, WDWAVE , COSWDIF, & #include "semean.intfb.h" INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE), INTENT(IN) :: FL1 - INTEGER(KIND=JWIM), DIMENSION(KIJS:KIJL), INTENT(IN) :: MIJ - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: WSWAVE, WDWAVE - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG), INTENT(IN) :: COSWDIF - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: ESWELL, FSWELL, THSWELL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: FSEA - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE), INTENT(INOUT) :: FLSW, SWM - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NTRAIN), INTENT(OUT) :: EMTRAIN, THTRAIN, PMTRAIN + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE), INTENT(IN) :: FL1 + INTEGER(KIND=JWIM), DIMENSION(KIJL), INTENT(IN) :: MIJ + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: WSWAVE, WDWAVE + REAL(KIND=JWRB), DIMENSION(KIJL,NANG), INTENT(IN) :: COSWDIF + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: ESWELL, FSWELL, THSWELL + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: FSEA + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE), INTENT(INOUT) :: FLSW, SWM + REAL(KIND=JWRB), DIMENSION(KIJL,NTRAIN), INTENT(OUT) :: EMTRAIN, THTRAIN, PMTRAIN - INTEGER(KIND=JWIM), PARAMETER :: NPMAX=20 INTEGER(KIND=JWIM) :: NPMAX_LOC INTEGER(KIND=JWIM) :: IJ, M, K, IP INTEGER(KIND=JWIM) :: ISORT, I, IPLOC INTEGER(KIND=JWIM) :: IFL, IFH, ITHL, ITHH INTEGER(KIND=JWIM) :: KM, KP - INTEGER(KIND=JWIM), DIMENSION(KIJS:KIJL) :: NPEAK, NPK - INTEGER(KIND=JWIM), DIMENSION(KIJS:KIJL) :: FRINVMIJ - INTEGER(KIND=JWIM), DIMENSION(KIJS:KIJL) :: MMIN, MMAX - INTEGER(KIND=JWIM), DIMENSION(KIJS:KIJL) :: IPNOW - INTEGER(KIND=JWIM), DIMENSION(KIJS:KIJL,NTRAIN) :: IENERGY - INTEGER(KIND=JWIM), DIMENSION(KIJS:KIJL,NPMAX) :: NFRP, NTHP + INTEGER(KIND=JWIM), DIMENSION(KIJL) :: NPEAK, NPK + INTEGER(KIND=JWIM), DIMENSION(KIJL) :: FRINVMIJ + INTEGER(KIND=JWIM), DIMENSION(KIJL) :: MMIN, MMAX + INTEGER(KIND=JWIM), DIMENSION(KIJL) :: IPNOW + INTEGER(KIND=JWIM), DIMENSION(KIJL,NTRAIN) :: IENERGY + INTEGER(KIND=JWIM), DIMENSION(KIJL,NPMAX) :: NFRP, NTHP ! relative value above max swell value that is considered above noise level REAL(KIND=JWRB), PARAMETER :: XNOISELEVEL=0.005_JWRB @@ -116,18 +115,18 @@ SUBROUTINE SEP3TR (KIJS, KIJL, FL1, MIJ, WSWAVE, WDWAVE , COSWDIF, & REAL(KIND=JWRB) :: COSDIR, FRLIMIT REAL(KIND=JPHOOK) :: ZHOOK_HANDLE REAL(KIND=JWRB) :: FLLOWEST - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: ENEX, SUMETRAIN - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: ETT - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: ENMAX, FLNOISE - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG) :: SPRD - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,0:NPMAX) :: DIR, PER, ENE - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NTRAIN) :: TEMPDIR, TEMPPER, TEMPENE - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE) :: FL, FLLOW + REAL(KIND=JWRB), DIMENSION(KIJL) :: ENEX, SUMETRAIN + REAL(KIND=JWRB), DIMENSION(KIJL) :: ETT + REAL(KIND=JWRB), DIMENSION(KIJL) :: ENMAX, FLNOISE + REAL(KIND=JWRB), DIMENSION(KIJL,NANG) :: SPRD + REAL(KIND=JWRB), DIMENSION(KIJL,0:NPMAX) :: DIR, PER, ENE + REAL(KIND=JWRB), DIMENSION(KIJL,NTRAIN) :: TEMPDIR, TEMPPER, TEMPENE + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE) :: FL, FLLOW LOGICAL :: LLEPSMIN LOGICAL :: LLADDPART - LOGICAL, DIMENSION(KIJS:KIJL,NTRAIN) :: LPWSECTOR - LOGICAL, DIMENSION(KIJS:KIJL,NANG) :: LLCOSDIFF + LOGICAL, DIMENSION(KIJL,NTRAIN) :: LPWSECTOR + LOGICAL, DIMENSION(KIJL,NANG) :: LLCOSDIFF ! ---------------------------------------------------------------------- diff --git a/src/ecwam/sepwisw.F90 b/src/ecwam/sepwisw.F90 index 7e318b537..8055a14d1 100644 --- a/src/ecwam/sepwisw.F90 +++ b/src/ecwam/sepwisw.F90 @@ -77,7 +77,7 @@ SUBROUTINE SEPWISW (KIJS, KIJL, MIJ, FL1, XLLWS, CINV, & USE YOWCOUT , ONLY : NTRAIN ,LLPARTITION USE YOWFRED , ONLY : FR ,TH ,FRIC ,OLDWSFC, ZPIFR - USE YOWPCONS , ONLY : G ,EPSMIN + USE YOWPCONS , ONLY : G ,EPSMIN, NPMAX USE YOWMAP , ONLY : CLDOMAIN USE YOWPARAM , ONLY : NANG ,NFRE @@ -95,15 +95,15 @@ SUBROUTINE SEPWISW (KIJS, KIJL, MIJ, FL1, XLLWS, CINV, & #include "wdirspread.intfb.h" INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - INTEGER(KIND=JWIM), DIMENSION(KIJS:KIJL), INTENT(IN) :: MIJ - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE), INTENT(IN) :: FL1 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE), INTENT(IN) :: XLLWS - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NFRE), INTENT(IN) :: CINV - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: UFRIC, WSWAVE, WDWAVE - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG), INTENT(IN) :: COSWDIF - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: ESWELL ,FSWELL ,THSWELL, P1SWELL, P2SWELL, SPRDSWELL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: ESEA ,FSEA ,THWISEA, P1SEA , P2SEA , SPRDSEA - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NTRAIN), INTENT(OUT) :: EMTRAIN, THTRAIN, PMTRAIN + INTEGER(KIND=JWIM), DIMENSION(KIJL), INTENT(IN) :: MIJ + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE), INTENT(IN) :: FL1 + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE), INTENT(IN) :: XLLWS + REAL(KIND=JWRB), DIMENSION(KIJL,NFRE), INTENT(IN) :: CINV + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: UFRIC, WSWAVE, WDWAVE + REAL(KIND=JWRB), DIMENSION(KIJL,NANG), INTENT(IN) :: COSWDIF + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: ESWELL ,FSWELL ,THSWELL, P1SWELL, P2SWELL, SPRDSWELL + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: ESEA ,FSEA ,THWISEA, P1SEA , P2SEA , SPRDSEA + REAL(KIND=JWRB), DIMENSION(KIJL,NTRAIN), INTENT(OUT) :: EMTRAIN, THTRAIN, PMTRAIN INTEGER(KIND=JWIM) :: IJ, K, M @@ -111,10 +111,10 @@ SUBROUTINE SEPWISW (KIJS, KIJL, MIJ, FL1, XLLWS, CINV, & REAL(KIND=JWRB) :: COEF REAL(KIND=JWRB) :: CHECKTA REAL(KIND=JPHOOK) :: ZHOOK_HANDLE - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: R - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NFRE) :: XINVWVAGE - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG) :: DIRCOEF - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE) :: SWM, F1 + REAL(KIND=JWRB), DIMENSION(KIJL) :: R + REAL(KIND=JWRB), DIMENSION(KIJL,NFRE) :: XINVWVAGE + REAL(KIND=JWRB), DIMENSION(KIJL,NANG) :: DIRCOEF + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE) :: SWM, F1 LOGICAL :: LLPEAKF diff --git a/src/ecwam/sinflx.F90 b/src/ecwam/sinflx.F90 index 215f30f3f..9b0316193 100644 --- a/src/ecwam/sinflx.F90 +++ b/src/ecwam/sinflx.F90 @@ -29,7 +29,6 @@ SUBROUTINE SINFLX (ICALL, NCALL, KIJS, KIJL, & USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU - USE YOWFRED , ONLY : NWAV_GC ! needed for Loki USE YOWCOUP , ONLY : LWCOU ,LLCAPCHNK , LLGCBZ0, LLNORMAGAM USE YOWPARAM , ONLY : NANG ,NFRE USE YOWPHYS , ONLY : DTHRN_A ,DTHRN_U @@ -130,6 +129,7 @@ SUBROUTINE SINFLX (ICALL, NCALL, KIJS, KIJL, & ENDDO IF (LLGCBZ0) THEN + !$loki inline CALL HALPHAP(KIJS, KIJL, WAVNUM, COSWDIF, FL1, HALP) ELSE HALP(KIJS:KIJL) = 0.0_JWRB @@ -137,6 +137,7 @@ SUBROUTINE SINFLX (ICALL, NCALL, KIJS, KIJL, & ENDIF + !$loki inline CALL AIRSEA (KIJS, KIJL, & & HALP, WSWAVE, WDWAVE, TAUW, TAUWDIR, RNFAC, & & UFRIC, Z0M, Z0B, CHRNCK, ICODE_WND, IUSFG) @@ -155,6 +156,7 @@ SUBROUTINE SINFLX (ICALL, NCALL, KIJS, KIJL, & LLSNEG = .TRUE. ENDIF +!$loki inline CALL SINPUT (NGST, LLSNEG, KIJS, KIJL, FL1, & & WAVNUM, CINV, XK2CG, & & WDWAVE, WSWAVE, UFRIC, Z0M, & @@ -164,12 +166,15 @@ SUBROUTINE SINFLX (ICALL, NCALL, KIJS, KIJL, & ! MEAN FREQUENCY CHARACTERISTIC FOR WIND SEA +!$loki inline CALL FEMEANWS(KIJS, KIJL, FL1, XLLWS, FMEANWS) ! COMPUTE LAST FREQUENCY INDEX OF PROGNOSTIC PART OF SPECTRUM. +!$loki inline CALL FRCUTINDEX(KIJS, KIJL, FMEAN, FMEANWS, UFRIC, CICOVER, MIJ, RHOWGDFTH) ! UPDATE TAUW +!$loki inline CALL STRESSO (KIJS, KIJL, MIJ, RHOWGDFTH, & & FL1, SL, SPOS, & & CINV, & diff --git a/src/ecwam/sinput.F90 b/src/ecwam/sinput.F90 index d873d9061..96ffa99c9 100644 --- a/src/ecwam/sinput.F90 +++ b/src/ecwam/sinput.F90 @@ -101,6 +101,7 @@ SUBROUTINE SINPUT (NGST, LLSNEG, KIJS, KIJL, FL1, & SELECT CASE (IPHYS) CASE(0) + !$loki inline CALL SINPUT_JAN (NGST, LLSNEG, KIJS, KIJL, FL1, & & WAVNUM, CINV, XK2CG, & & WSWAVE, UFRIC, Z0M, & @@ -108,6 +109,7 @@ SUBROUTINE SINPUT (NGST, LLSNEG, KIJS, KIJL, FL1, & & RAORW, WSTAR, RNFAC, & & FLD, SL, SPOS, XLLWS) CASE(1) + !$loki inline CALL SINPUT_ARD (NGST, LLSNEG, KIJS, KIJL, FL1, & & WAVNUM, CINV, XK2CG, & & WDWAVE, WSWAVE, UFRIC, Z0M, & diff --git a/src/ecwam/sinput_ard.F90 b/src/ecwam/sinput_ard.F90 index 968eb6ace..f3e0f2295 100644 --- a/src/ecwam/sinput_ard.F90 +++ b/src/ecwam/sinput_ard.F90 @@ -135,9 +135,9 @@ SUBROUTINE SINPUT_ARD (NGST, LLSNEG, KIJS, KIJL, FL1, & REAL(KIND=JWRB), DIMENSION(KIJL) :: CNSN, SUMF, SUMFSIN2 REAL(KIND=JWRB), DIMENSION(KIJL) :: CSTRNFAC REAL(KIND=JWRB), DIMENSION(KIJL) :: FLP_AVG, SLP_AVG - REAL(KIND=JWRB), DIMENSION(KIJL) :: ROGOROAIR, AIRD_PVISC - REAL(KIND=JWRB), DIMENSION(KIJL,2) :: XSTRESS, YSTRESS, FLP, SLP - REAL(KIND=JWRB), DIMENSION(KIJL,2) :: USG2, TAUX, TAUY, USTP, USTPM1, USDIRP, UCN + REAL(KIND=JWRB), DIMENSION(KIJL) :: ROGOROAIR, AIRD_PVISC, USG2, FLP, SLP + REAL(KIND=JWRB), DIMENSION(KIJL,2) :: XSTRESS, YSTRESS + REAL(KIND=JWRB), DIMENSION(KIJL,2) :: TAUX, TAUY, USTP, USTPM1, USDIRP, UCN REAL(KIND=JWRB), DIMENSION(KIJL,2) :: UCNZALPD REAL(KIND=JWRB), DIMENSION(KIJL) :: XNGAMCONST REAL(KIND=JWRB), DIMENSION(KIJL,2) :: GAMNORMA ! ! RENORMALISATION FACTOR OF THE GROWTH RATE @@ -163,7 +163,10 @@ SUBROUTINE SINPUT_ARD (NGST, LLSNEG, KIJS, KIJL, FL1, & ! ESTIMATE THE STANDARD DEVIATION OF GUSTINESS. - IF (NGST > 1) CALL WSIGSTAR (KIJS, KIJL, WSWAVE, UFRIC, Z0M, WSTAR, SIG_N) + IF (NGST > 1)THEN + !$loki inline + CALL WSIGSTAR (KIJS, KIJL, WSWAVE, UFRIC, Z0M, WSTAR, SIG_N) + ENDIF IF (LLNORMAGAM) THEN @@ -292,21 +295,28 @@ SUBROUTINE SINPUT_ARD (NGST, LLSNEG, KIJS, KIJL, FL1, & CALL ABORT1 ENDIF - DO IGST=1,NGST - DO IJ=KIJS,KIJL - USTPM1(IJ,IGST) = 1.0_JWRB/MAX(USTP(IJ,IGST),EPSUS) - ENDDO + !... Expressing the IGST loop in this way enables the compiler to + !... unroll it whilst still retaining correctness for the case + !... where NGST == 1. This is an important optimisation for GPUs. + DO IGST=1,2 + IF(IGST <= NGST)THEN + DO IJ=KIJS,KIJL + USTPM1(IJ,IGST) = 1.0_JWRB/MAX(USTP(IJ,IGST),EPSUS) + ENDDO + ENDIF ENDDO IF (LTAUWSHELTER) THEN - DO IGST=1,NGST - DO IJ=KIJS,KIJL - XSTRESS(IJ,IGST)=0.0_JWRB - YSTRESS(IJ,IGST)=0.0_JWRB - USG2(IJ,IGST)=USTP(IJ,IGST)**2 - TAUX(IJ,IGST)=USG2(IJ,IGST)*SIN(WDWAVE(IJ)) - TAUY(IJ,IGST)=USG2(IJ,IGST)*COS(WDWAVE(IJ)) - ENDDO + DO IGST=1,2 + IF(IGST <= NGST)THEN + DO IJ=KIJS,KIJL + XSTRESS(IJ,IGST)=0.0_JWRB + YSTRESS(IJ,IGST)=0.0_JWRB + USG2(IJ)=USTP(IJ,IGST)**2 + TAUX(IJ,IGST)=USG2(IJ)*SIN(WDWAVE(IJ)) + TAUY(IJ,IGST)=USG2(IJ)*COS(WDWAVE(IJ)) + ENDDO + ENDIF ENDDO DO IJ=KIJS,KIJL @@ -344,14 +354,16 @@ SUBROUTINE SINPUT_ARD (NGST, LLSNEG, KIJS, KIJL, FL1, & ENDIF IF (LTAUWSHELTER) THEN - DO IGST=1,NGST - DO IJ=KIJS,KIJL - TAUPX=TAUX(IJ,IGST)-ABS_TAUWSHELTER*XSTRESS(IJ,IGST) - TAUPY=TAUY(IJ,IGST)-ABS_TAUWSHELTER*YSTRESS(IJ,IGST) - USDIRP(IJ,IGST)=ATAN2(TAUPX,TAUPY) - USTP(IJ,IGST)=(TAUPX**2+TAUPY**2)**0.25_JWRB - USTPM1(IJ,IGST)=1.0_JWRB/MAX(USTP(IJ,IGST),EPSUS) - ENDDO + DO IGST=1,2 + IF(IGST <= NGST)THEN + DO IJ=KIJS,KIJL + TAUPX=TAUX(IJ,IGST)-ABS_TAUWSHELTER*XSTRESS(IJ,IGST) + TAUPY=TAUY(IJ,IGST)-ABS_TAUWSHELTER*YSTRESS(IJ,IGST) + USDIRP(IJ,IGST)=ATAN2(TAUPX,TAUPY) + USTP(IJ,IGST)=(TAUPX**2+TAUPY**2)**0.25_JWRB + USTPM1(IJ,IGST)=1.0_JWRB/MAX(USTP(IJ,IGST),EPSUS) + ENDDO + ENDIF ENDDO DO IJ=KIJS,KIJL @@ -363,11 +375,13 @@ SUBROUTINE SINPUT_ARD (NGST, LLSNEG, KIJS, KIJL, FL1, & !* PRECALCULATE FREQUENCY DEPENDENCE. ! ---------------------------------- - DO IGST=1,NGST - DO IJ=KIJS,KIJL - UCN(IJ,IGST) = USTP(IJ,IGST)*CINV(IJ,M) - UCNZALPD(IJ,IGST) = XKAPPA/(UCN(IJ,IGST) + ZALP) - ENDDO + DO IGST=1,2 + IF(IGST <= NGST)THEN + DO IJ=KIJS,KIJL + UCN(IJ,IGST) = USTP(IJ,IGST)*CINV(IJ,M) + UCNZALPD(IJ,IGST) = XKAPPA/(UCN(IJ,IGST) + ZALP) + ENDDO + ENDIF ENDDO DO IJ=KIJS,KIJL ZCN(IJ) = LOG(WAVNUM(IJ,M)*Z0M(IJ)) @@ -397,52 +411,54 @@ SUBROUTINE SINPUT_ARD (NGST, LLSNEG, KIJS, KIJL, FL1, & ENDDO ENDIF - DO IGST=1,NGST - DO K=1,NANG - IF(LTAUWSHELTER)THEN - DO IJ=KIJS,KIJL - COSLP(IJ,K) = COS(TH(K)-USDIRP(IJ,IGST)) - ENDDO - ENDIF - DO IJ=KIJS,KIJL - GAM0(IJ,K,IGST) = 0.0_JWRB - IF (COSLP(IJ,K) > 0.01_JWRB) THEN - X = COSLP(IJ,K)*UCN(IJ,IGST) - ZLOG = ZCN(IJ) + UCNZALPD(IJ,IGST)/COSLP(IJ,K) - IF (ZLOG < 0.0_JWRB) THEN - ZLOG2X=ZLOG*ZLOG*X - GAM0(IJ,K,IGST) = EXP(ZLOG)*ZLOG2X*ZLOG2X * CNSN(IJ) - XLLWS(IJ,K,M) = 1.0_JWRB - ENDIF - ENDIF - ENDDO - ENDDO - - IF (LLNORMAGAM) THEN - - SUMF(KIJS:KIJL) = 0.0_JWRB - SUMFSIN2(KIJS:KIJL) = 0.0_JWRB + DO IGST=1,2 + IF(IGST <= NGST)THEN DO K=1,NANG + IF(LTAUWSHELTER)THEN + DO IJ=KIJS,KIJL + COSLP(IJ,K) = COS(TH(K)-USDIRP(IJ,IGST)) + ENDDO + ENDIF DO IJ=KIJS,KIJL - SUMF(IJ) = SUMF(IJ) + GAM0(IJ,K,IGST)*FL1(IJ,K,M) - SUMFSIN2(IJ) = SUMFSIN2(IJ) + GAM0(IJ,K,IGST)*FL1(IJ,K,M)*SINWDIF2(IJ,K) + GAM0(IJ,K,IGST) = 0.0_JWRB + IF (COSLP(IJ,K) > 0.01_JWRB) THEN + X = COSLP(IJ,K)*UCN(IJ,IGST) + ZLOG = ZCN(IJ) + UCNZALPD(IJ,IGST)/COSLP(IJ,K) + IF (ZLOG < 0.0_JWRB) THEN + ZLOG2X=ZLOG*ZLOG*X + GAM0(IJ,K,IGST) = EXP(ZLOG)*ZLOG2X*ZLOG2X * CNSN(IJ) + XLLWS(IJ,K,M) = 1.0_JWRB + ENDIF + ENDIF ENDDO ENDDO - - DO IJ=KIJS,KIJL - ZNZ = XNGAMCONST(IJ)*USTPM1(IJ,IGST) - GAMNORMA(IJ,IGST) = (1.0_JWRB + ZNZ*SUMFSIN2(IJ)) / (1.0_JWRB + ZNZ*SUMF(IJ)) - ENDDO - - ENDIF - - IF (LLSNEG) THEN - DO K=1,NANG + + IF (LLNORMAGAM) THEN + + SUMF(KIJS:KIJL) = 0.0_JWRB + SUMFSIN2(KIJS:KIJL) = 0.0_JWRB + DO K=1,NANG + DO IJ=KIJS,KIJL + SUMF(IJ) = SUMF(IJ) + GAM0(IJ,K,IGST)*FL1(IJ,K,M) + SUMFSIN2(IJ) = SUMFSIN2(IJ) + GAM0(IJ,K,IGST)*FL1(IJ,K,M)*SINWDIF2(IJ,K) + ENDDO + ENDDO + DO IJ=KIJS,KIJL - DSTAB2 = TEMP1(IJ)*(TEMP2(IJ)+(FU+FUD*COSLP(IJ,K))*USTP(IJ,IGST)) - DSTAB(IJ,K,IGST) = DSTAB1(IJ)+PTURB(IJ)*DSTAB2 + ZNZ = XNGAMCONST(IJ)*USTPM1(IJ,IGST) + GAMNORMA(IJ,IGST) = (1.0_JWRB + ZNZ*SUMFSIN2(IJ)) / (1.0_JWRB + ZNZ*SUMF(IJ)) ENDDO - ENDDO + + ENDIF + + IF (LLSNEG) THEN + DO K=1,NANG + DO IJ=KIJS,KIJL + DSTAB2 = TEMP1(IJ)*(TEMP2(IJ)+(FU+FUD*COSLP(IJ,K))*USTP(IJ,IGST)) + DSTAB(IJ,K,IGST) = DSTAB1(IJ)+PTURB(IJ)*DSTAB2 + ENDDO + ENDDO + ENDIF ENDIF ENDDO @@ -453,43 +469,41 @@ SUBROUTINE SINPUT_ARD (NGST, LLSNEG, KIJS, KIJL, FL1, & DO K=1,NANG - DO IGST=1,NGST - DO IJ=KIJS,KIJL - ! SLP: only the positive contributions - SLP(IJ,IGST) = GAM0(IJ,K,IGST) * GAMNORMA(IJ,IGST) - FLP(IJ,IGST) = SLP(IJ,IGST)+DSTAB(IJ,K,IGST) - ENDDO - ENDDO - - DO IGST=1,NGST - DO IJ=KIJS,KIJL - SLP(IJ,IGST) = SLP(IJ,IGST)*FL1(IJ,K,M) - ENDDO - ENDDO - - IF (LTAUWSHELTER) THEN - DO IJ=KIJS,KIJL - CONST11(IJ)=CONSTF(IJ)*SINTH(K) - CONST22(IJ)=CONSTF(IJ)*COSTH(K) - ENDDO - DO IGST=1,NGST + DO IGST=1,2 + IF(IGST <= NGST)THEN DO IJ=KIJS,KIJL - XSTRESS(IJ,IGST)=XSTRESS(IJ,IGST)+SLP(IJ,IGST)*CONST11(IJ) - YSTRESS(IJ,IGST)=YSTRESS(IJ,IGST)+SLP(IJ,IGST)*CONST22(IJ) + ! SLP: only the positive contributions + SLP(IJ) = GAM0(IJ,K,IGST) * GAMNORMA(IJ,IGST) + FLP(IJ) = SLP(IJ)+DSTAB(IJ,K,IGST) ENDDO - ENDDO - ENDIF - - IGST=1 - DO IJ=KIJS,KIJL - SLP_AVG(IJ) = SLP(IJ,IGST) - FLP_AVG(IJ) = FLP(IJ,IGST) - ENDDO - DO IGST=2,NGST - DO IJ=KIJS,KIJL - SLP_AVG(IJ) = SLP_AVG(IJ)+SLP(IJ,IGST) - FLP_AVG(IJ) = FLP_AVG(IJ)+FLP(IJ,IGST) - ENDDO + + DO IJ=KIJS,KIJL + SLP(IJ) = SLP(IJ)*FL1(IJ,K,M) + ENDDO + + IF (LTAUWSHELTER) THEN + DO IJ=KIJS,KIJL + CONST11(IJ)=CONSTF(IJ)*SINTH(K) + CONST22(IJ)=CONSTF(IJ)*COSTH(K) + ENDDO + DO IJ=KIJS,KIJL + XSTRESS(IJ,IGST)=XSTRESS(IJ,IGST)+SLP(IJ)*CONST11(IJ) + YSTRESS(IJ,IGST)=YSTRESS(IJ,IGST)+SLP(IJ)*CONST22(IJ) + ENDDO + ENDIF + + IF(IGST == 1)THEN + DO IJ=KIJS,KIJL + SLP_AVG(IJ) = SLP(IJ) + FLP_AVG(IJ) = FLP(IJ) + ENDDO + ELSE + DO IJ=KIJS,KIJL + SLP_AVG(IJ) = SLP_AVG(IJ)+SLP(IJ) + FLP_AVG(IJ) = FLP_AVG(IJ)+FLP(IJ) + ENDDO + ENDIF + ENDIF ENDDO DO IJ=KIJS,KIJL diff --git a/src/ecwam/sinput_jan.F90 b/src/ecwam/sinput_jan.F90 index 4f9377a80..e218189a7 100644 --- a/src/ecwam/sinput_jan.F90 +++ b/src/ecwam/sinput_jan.F90 @@ -164,8 +164,7 @@ SUBROUTINE SINPUT_JAN (NGST, LLSNEG, KIJS, KIJL, FL1 , & REAL(KIND=JWRB), DIMENSION(KIJL,2) :: SIGDEV ,US, Z0, UCN, ZCN REAL(KIND=JWRB), DIMENSION(KIJL,2) :: USTPM1 REAL(KIND=JWRB), DIMENSION(KIJL,2) :: XVD, UCND, CONST3_UCN2 - REAL(KIND=JWRB), DIMENSION(KIJL,NANG) :: UFAC1, UFAC2 - REAL(KIND=JWRB), DIMENSION(KIJL,NANG) :: TEMPD + REAL(KIND=JWRB), DIMENSION(KIJL) :: UFAC1, UFAC2 REAL(KIND=JWRB), DIMENSION(KIJL,NANG,2) :: GAM0 LOGICAL, DIMENSION(KIJL,NANG) :: LZ @@ -183,7 +182,10 @@ SUBROUTINE SINPUT_JAN (NGST, LLSNEG, KIJS, KIJL, FL1 , & CONSTN = DELTH/(XKAPPA*ZPI) ! ESTIMATE THE STANDARD DEVIATION OF GUSTINESS. - IF (NGST > 1) CALL WSIGSTAR (KIJS, KIJL, WSWAVE, UFRIC, Z0M, WSTAR, SIG_N) + IF (NGST > 1)THEN + !$loki inline + CALL WSIGSTAR (KIJS, KIJL, WSWAVE, UFRIC, Z0M, WSTAR, SIG_N) + ENDIF !* 1. PRECALCULATED ANGULAR DEPENDENCE. ! --------------------------------- @@ -192,10 +194,8 @@ SUBROUTINE SINPUT_JAN (NGST, LLSNEG, KIJS, KIJL, FL1 , & DO IJ=KIJS,KIJL IF (COSWDIF(IJ,K) > 0.01_JWRB) THEN LZ(IJ,K) = .TRUE. - TEMPD(IJ,K) = XKAPPA/COSWDIF(IJ,K) ELSE LZ(IJ,K) = .FALSE. - TEMPD(IJ,K) = XKAPPA ENDIF ENDDO ENDDO @@ -241,18 +241,25 @@ SUBROUTINE SINPUT_JAN (NGST, LLSNEG, KIJS, KIJL, FL1 , & Z0(IJ,1) = Z0M(IJ) ENDDO ELSE - DO IGST=1,NGST - DO IJ=KIJS,KIJL - US(IJ,IGST) = UFRIC(IJ)*SIGDEV(IJ,IGST) - Z0(IJ,IGST) = Z0M(IJ) - ENDDO + !... Expressing the IGST loop in this way enables the compiler to + !... unroll it whilst still retaining correctness for the case + !... where NGST == 1. This is an important optimisation for GPUs. + DO IGST=1,2 + IF(IGST <= NGST)THEN + DO IJ=KIJS,KIJL + US(IJ,IGST) = UFRIC(IJ)*SIGDEV(IJ,IGST) + Z0(IJ,IGST) = Z0M(IJ) + ENDDO + ENDIF ENDDO ENDIF - DO IGST=1,NGST - DO IJ=KIJS,KIJL - USTPM1(IJ,IGST) = 1.0_JWRB/MAX(US(IJ,IGST),EPSUS) - ENDDO + DO IGST=1,2 + IF(IGST <= NGST)THEN + DO IJ=KIJS,KIJL + USTPM1(IJ,IGST) = 1.0_JWRB/MAX(US(IJ,IGST),EPSUS) + ENDDO + ENDIF ENDDO ! ---------------------------------------------------------------------- @@ -260,14 +267,6 @@ SUBROUTINE SINPUT_JAN (NGST, LLSNEG, KIJS, KIJL, FL1 , & !* 2. LOOP OVER FREQUENCIES. ! ---------------------- - IF ( .NOT. LLNORMAGAM) THEN - GAMNORMA(KIJS:KIJL,:) = 1.0_JWRB - ENDIF - - IF ( .NOT. LLSNEG) THEN - UFAC2(KIJS:KIJL,:) = 0.0_JWRB - ENDIF - DO M=1,NFRE CONST=ZPIFR(M)*CONST1 @@ -283,14 +282,16 @@ SUBROUTINE SINPUT_JAN (NGST, LLSNEG, KIJS, KIJL, FL1 , & CNSN(IJ) = CONST*ZTANHKD(IJ)*RAORW(IJ) ENDDO - DO IGST=1,NGST - DO IJ=KIJS,KIJL - UCN(IJ,IGST) = US(IJ,IGST)*CINV(IJ,M) + ZALP - CONST3_UCN2(IJ,IGST) = CONST3*UCN(IJ,IGST)**2 - UCND(IJ,IGST) = 1.0_JWRB/ UCN(IJ,IGST) - ZCN(IJ,IGST) = LOG(WAVNUM(IJ,M)*Z0(IJ,IGST)) - XVD(IJ,IGST) = 1.0_JWRB/(-US(IJ,IGST)*XKAPPAD*ZCN(IJ,IGST)*CINV(IJ,M)) - ENDDO + DO IGST=1,2 + IF(IGST <= NGST)THEN + DO IJ=KIJS,KIJL + UCN(IJ,IGST) = US(IJ,IGST)*CINV(IJ,M) + ZALP + CONST3_UCN2(IJ,IGST) = CONST3*UCN(IJ,IGST)**2 + UCND(IJ,IGST) = 1.0_JWRB/ UCN(IJ,IGST) + ZCN(IJ,IGST) = LOG(WAVNUM(IJ,M)*Z0(IJ,IGST)) + XVD(IJ,IGST) = 1.0_JWRB/(-US(IJ,IGST)*XKAPPAD*ZCN(IJ,IGST)*CINV(IJ,M)) + ENDDO + ENDIF ENDDO !* 2.1 LOOP OVER DIRECTIONS. @@ -302,22 +303,24 @@ SUBROUTINE SINPUT_JAN (NGST, LLSNEG, KIJS, KIJL, FL1 , & XLLWS(IJ,K,M)= 0.0_JWRB ENDDO - DO IGST=1,NGST - DO IJ=KIJS,KIJL - IF (LZ(IJ,K)) THEN - ZLOG = ZCN(IJ,IGST) + TEMPD(IJ,K)*UCND(IJ,IGST) - IF (ZLOG < 0.0_JWRB) THEN - X=COSWDIF(IJ,K)*UCN(IJ,IGST) - ZLOG2X=ZLOG*ZLOG*X - GAM0(IJ,K,IGST) = ZLOG2X*ZLOG2X*EXP(ZLOG) * CNSN(IJ) - XLLWS(IJ,K,M)= 1.0_JWRB + DO IGST=1,2 + IF(IGST <= NGST)THEN + DO IJ=KIJS,KIJL + IF (LZ(IJ,K)) THEN + ZLOG = ZCN(IJ,IGST) + XKAPPA/COSWDIF(IJ,K)*UCND(IJ,IGST) + IF (ZLOG < 0.0_JWRB) THEN + X=COSWDIF(IJ,K)*UCN(IJ,IGST) + ZLOG2X=ZLOG*ZLOG*X + GAM0(IJ,K,IGST) = ZLOG2X*ZLOG2X*EXP(ZLOG) * CNSN(IJ) + XLLWS(IJ,K,M)= 1.0_JWRB + ELSE + GAM0(IJ,K,IGST) = 0.0_JWRB + ENDIF ELSE GAM0(IJ,K,IGST) = 0.0_JWRB ENDIF - ELSE - GAM0(IJ,K,IGST) = 0.0_JWRB - ENDIF - ENDDO + ENDDO + ENDIF ENDDO ENDDO @@ -329,63 +332,63 @@ SUBROUTINE SINPUT_JAN (NGST, LLSNEG, KIJS, KIJL, FL1 , & XNGAMCONST(IJ) = CSTRNFAC(IJ)*XK2CG(IJ,M) ENDDO - DO IGST=1,NGST + DO IGST=1,2 + IF(IGST <= NGST)THEN - SUMF(KIJS:KIJL) = 0.0_JWRB - SUMFSIN2(KIJS:KIJL) = 0.0_JWRB - DO K=1,NANG - DO IJ=KIJS,KIJL - SUMF(IJ) = SUMF(IJ) + GAM0(IJ,K,IGST)*FL1(IJ,K,M) - SUMFSIN2(IJ) = SUMFSIN2(IJ) + GAM0(IJ,K,IGST)*FL1(IJ,K,M)*SINWDIF2(IJ,K) + SUMF(KIJS:KIJL) = 0.0_JWRB + SUMFSIN2(KIJS:KIJL) = 0.0_JWRB + DO K=1,NANG + DO IJ=KIJS,KIJL + SUMF(IJ) = SUMF(IJ) + GAM0(IJ,K,IGST)*FL1(IJ,K,M) + SUMFSIN2(IJ) = SUMFSIN2(IJ) + GAM0(IJ,K,IGST)*FL1(IJ,K,M)*SINWDIF2(IJ,K) + ENDDO ENDDO - ENDDO - DO IJ=KIJS,KIJL - ZNZ = XNGAMCONST(IJ)*USTPM1(IJ,IGST) - GAMNORMA(IJ,IGST) = (1.0_JWRB + ZNZ*SUMFSIN2(IJ)) / (1.0_JWRB + ZNZ*SUMF(IJ)) - ENDDO + DO IJ=KIJS,KIJL + ZNZ = XNGAMCONST(IJ)*USTPM1(IJ,IGST) + GAMNORMA(IJ,IGST) = (1.0_JWRB + ZNZ*SUMFSIN2(IJ)) / (1.0_JWRB + ZNZ*SUMF(IJ)) + ENDDO + ENDIF ENDDO - + + ELSE + GAMNORMA(KIJS:KIJL,:) = 1.0_JWRB ENDIF DO K=1,NANG DO IJ=KIJS,KIJL - UFAC1(IJ,K) = WSIN(1)*GAM0(IJ,K,1)*GAMNORMA(IJ,1) + UFAC1(IJ) = WSIN(1)*GAM0(IJ,K,1)*GAMNORMA(IJ,1) ENDDO - DO IGST=2,NGST + IF(NGST == 2)THEN DO IJ=KIJS,KIJL - UFAC1(IJ,K) = UFAC1(IJ,K) + WSIN(IGST)*GAM0(IJ,K,IGST)*GAMNORMA(IJ,IGST) + UFAC1(IJ) = UFAC1(IJ) + WSIN(2)*GAM0(IJ,K,2)*GAMNORMA(IJ,2) ENDDO - ENDDO - ENDDO + ENDIF - IF (LLSNEG) THEN -! SWELL DAMPING: - DO K=1,NANG - DO IGST=1,1 - DO IJ=KIJS,KIJL - ZBETA = CONST3_UCN2(IJ,IGST)*(COSWDIF(IJ,K)-XVD(IJ,IGST)) - UFAC2(IJ,K) = WSIN(IGST)*ZBETA - ENDDO + IF (LLSNEG) THEN +! SWELL DAMPING: + DO IJ=KIJS,KIJL + ZBETA = CONST3_UCN2(IJ,1)*(COSWDIF(IJ,K)-XVD(IJ,1)) + UFAC2(IJ) = WSIN(1)*ZBETA ENDDO - DO IGST=2,NGST + IF(NGST == 2)THEN DO IJ=KIJS,KIJL - ZBETA = CONST3_UCN2(IJ,IGST)*(COSWDIF(IJ,K)-XVD(IJ,IGST)) - UFAC2(IJ,K) = UFAC2(IJ,K)+WSIN(IGST)*ZBETA + ZBETA = CONST3_UCN2(IJ,2)*(COSWDIF(IJ,K)-XVD(IJ,2)) + UFAC2(IJ) = UFAC2(IJ)+WSIN(2)*ZBETA ENDDO - ENDDO - ENDDO - ENDIF + ENDIF + ELSE + UFAC2(KIJS:KIJL) = 0.0_JWRB + ENDIF !* 2.2 ADDING INPUT SOURCE TERM TO NET SOURCE FUNCTION. ! ------------------------------------------------ - DO K=1,NANG DO IJ=KIJS,KIJL - FLD(IJ,K,M) = UFAC1(IJ,K) + UFAC2(IJ,K)*CNSN(IJ) - SPOS(IJ,K,M) = UFAC1(IJ,K)*FL1(IJ,K,M) + FLD(IJ,K,M) = UFAC1(IJ) + UFAC2(IJ)*CNSN(IJ) + SPOS(IJ,K,M) = UFAC1(IJ)*FL1(IJ,K,M) SL(IJ,K,M) = FLD(IJ,K,M)*FL1(IJ,K,M) ENDDO ENDDO diff --git a/src/ecwam/snonlin.F90 b/src/ecwam/snonlin.F90 index 94fa37d7f..a12b69990 100644 --- a/src/ecwam/snonlin.F90 +++ b/src/ecwam/snonlin.F90 @@ -149,6 +149,7 @@ SUBROUTINE SNONLIN (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, AKMEAN) ENDDO CASE(2) + !$loki inline CALL PEAK_ANG(KIJS, KIJL, FL1, XNU, SIG_TH) DO MC=1,NFRE DO IJ = KIJS, KIJL @@ -221,6 +222,7 @@ SUBROUTINE SNONLIN (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, AKMEAN) IF (MC > MFR1STFR .AND. MC < MFRLSTFR ) THEN ! the interactions for MC are all within the fully resolved spectral domain + !$loki loop-interchange DO KH=1,2 DO K=1,NANG K1 = K1W (K,KH) @@ -248,6 +250,7 @@ SUBROUTINE SNONLIN (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, AKMEAN) DELAM(IJ) = (FIJ-2.0_JWRB*SAP)*DAL2*FCEN ENDDO + !$loki split-read-write DO IJ=KIJS,KIJL SL(IJ,K ,MC ) = SL(IJ,K ,MC ) - 2.0_JWRB*AD(IJ) ENDDO @@ -302,10 +305,12 @@ SUBROUTINE SNONLIN (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, AKMEAN) DO IJ=KIJS,KIJL FLD(IJ,K11,MP1) = FLD(IJ,K11,MP1) + DELAP(IJ)*FKLAPB2 ENDDO + !$loki end split-read-write ENDDO ENDDO ELSEIF (MC >= MFRLSTFR ) THEN + !$loki loop-interchange DO KH=1,2 DO K=1,NANG K1 = K1W (K,KH) @@ -329,6 +334,7 @@ SUBROUTINE SNONLIN (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, AKMEAN) DELAM(IJ) = (FIJ-2.0_JWRB*SAP)*DAL2*FCEN ENDDO + !$loki split-read-write DO IJ=KIJS,KIJL SL(IJ,K2 ,MM ) = SL(IJ,K2 ,MM ) + AD(IJ)*FKLAMM1 ENDDO @@ -401,11 +407,13 @@ SUBROUTINE SNONLIN (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, AKMEAN) ENDIF ENDIF ENDIF + !$loki end split-read-write ENDDO ENDDO ELSE + !$loki loop-interchange DO KH=1,2 DO K=1,NANG K1 = K1W (K,KH) @@ -429,6 +437,7 @@ SUBROUTINE SNONLIN (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, AKMEAN) DELAM(IJ) = (FIJ-2.0_JWRB*SAP)*DAL2*FCEN ENDDO + !$loki split-read-write IF (MM1 >= 1) THEN DO IJ=KIJS,KIJL SL(IJ,K2 ,MM1) = SL(IJ,K2 ,MM1) + AD(IJ)*FKLAMMA @@ -474,6 +483,7 @@ SUBROUTINE SNONLIN (KIJS, KIJL, FL1, FLD, SL, WAVNUM, DEPTH, AKMEAN) DO IJ=KIJS,KIJL FLD(IJ,K11,MP1) = FLD(IJ,K11,MP1) + DELAP(IJ)*FKLAPB2 ENDDO + !$loki end split-read-write ENDDO ENDDO diff --git a/src/ecwam/stat_nl.F90 b/src/ecwam/stat_nl.F90 index 8f3453cdb..8a3a743ab 100644 --- a/src/ecwam/stat_nl.F90 +++ b/src/ecwam/stat_nl.F90 @@ -55,8 +55,8 @@ SUBROUTINE STAT_NL(KIJS, KIJL, & #include "transf_r.intfb.h" INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB),DIMENSION(KIJS:KIJL), INTENT(IN) :: XM0, XK0, BF2, XNU, SIG_TH, DPTH - REAL(KIND=JWRB),DIMENSION(KIJS:KIJL), INTENT(OUT) :: C3, C4, ETA_M, R, C4_B, C4_DYN + REAL(KIND=JWRB),DIMENSION(KIJL), INTENT(IN) :: XM0, XK0, BF2, XNU, SIG_TH, DPTH + REAL(KIND=JWRB),DIMENSION(KIJL), INTENT(OUT) :: C3, C4, ETA_M, R, C4_B, C4_DYN REAL(KIND=JWRB), PARAMETER :: EPS = 0.0001_JWRB REAL(KIND=JWRB), PARAMETER :: RMIN = 0._JWRB @@ -79,7 +79,7 @@ SUBROUTINE STAT_NL(KIJS, KIJL, & REAL(KIND=JWRB) :: DELTA_2D,C_0,C_S_SQ,V_G,V_G_SQ,ZFAC,ZFAC1,ZFAC2 REAL(KIND=JWRB) :: XKAPPA1,ALPHA,XJ REAL(KIND=JWRB) :: ZEPSILON, ZSQREPSILON - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: TRANSF + REAL(KIND=JWRB), DIMENSION(KIJL) :: TRANSF !----------------------------------------------------------------------- diff --git a/src/ecwam/sthq.F90 b/src/ecwam/sthq.F90 index 5c00ff169..be4c6bc5a 100644 --- a/src/ecwam/sthq.F90 +++ b/src/ecwam/sthq.F90 @@ -60,12 +60,12 @@ SUBROUTINE STHQ (KIJS, KIJL, FL1, THQ) IMPLICIT NONE INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE), INTENT(IN) :: FL1 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: THQ + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE), INTENT(IN) :: FL1 + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: THQ INTEGER(KIND=JWIM) :: IJ, M, K REAL(KIND=JPHOOK) :: ZHOOK_HANDLE - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: TEMP, SI, CI + REAL(KIND=JWRB), DIMENSION(KIJL) :: TEMP, SI, CI ! ---------------------------------------------------------------------- diff --git a/src/ecwam/stokestrn.F90 b/src/ecwam/stokestrn.F90 index ee16feab6..872681b2e 100644 --- a/src/ecwam/stokestrn.F90 +++ b/src/ecwam/stokestrn.F90 @@ -64,9 +64,13 @@ SUBROUTINE STOKESTRN (KIJS, KIJL, FL1, WAVNUM, STOKFAC, DEPTH, WSWAVE, WDWAVE, C IF (LHOOK) CALL DR_HOOK('STOKESTRN',0,ZHOOK_HANDLE) +!$loki inline CALL STOKESDRIFT(KIJS, KIJL, FL1, STOKFAC, WSWAVE, WDWAVE, CICOVER, USTOKES,VSTOKES) -IF (LWNEMOCOUSTRN) CALL CIMSSTRN(KIJS, KIJL, FL1, WAVNUM, DEPTH, CITHICK, STRNMS) +IF (LWNEMOCOUSTRN)THEN + !$loki inline + CALL CIMSSTRN(KIJS, KIJL, FL1, WAVNUM, DEPTH, CITHICK, STRNMS) +ENDIF IF (LWNEMOCOU .AND. & diff --git a/src/ecwam/stress_gc.F90 b/src/ecwam/stress_gc.F90 index f6828750b..0b7afc949 100644 --- a/src/ecwam/stress_gc.F90 +++ b/src/ecwam/stress_gc.F90 @@ -7,7 +7,7 @@ ! nor does it submit to any jurisdiction. ! -REAL(KIND=JWRB) FUNCTION STRESS_GC(ANG_GC, USTAR, Z0, Z0MIN, HALP, RNFAC) +FUNCTION STRESS_GC(ANG_GC, USTAR, Z0, Z0MIN, HALP, RNFAC) RESULT(STRESS_GC_RES) !*** DETERMINE WAVE INDUCED STRESS FOR GRAV-CAP WAVES @@ -61,10 +61,11 @@ REAL(KIND=JWRB) FUNCTION STRESS_GC(ANG_GC, USTAR, Z0, Z0MIN, HALP, RNFAC) REAL(KIND=JWRB) :: X, XLOG, ZLOG, ZLOG2X REAL(KIND=JWRB) :: CONST, ZN REAL(KIND=JWRB) :: GAMNORMA ! RENORMALISATION FACTOR OF THE GROWTH RATE + REAL(KIND=JWRB) :: GAM_W + REAL(KIND=JWRB) :: STRESS_GC_RES REAL(KIND=JPHOOK) :: ZHOOK_HANDLE - REAL(KIND=JWRB), DIMENSION(NWAV_GC) :: GAM_W -! INCLUDE FUNCTIONS FROM GRAVITY-CAPILLARY DISPERSION REALTIONS +! INCLUDE FUNCTIONS FROM GRAVITY-CAPILLARY DISPERSION RELATIONS #include "gc_dispersion.h" #include "ns_gc.intfb.h" @@ -89,20 +90,20 @@ REAL(KIND=JWRB) FUNCTION STRESS_GC(ANG_GC, USTAR, Z0, Z0MIN, HALP, RNFAC) CONST = 0.0_JWRB ENDIF - DO I = NS, NWAV_GC -! GROWTHRATE BY WIND WITHOUT the multiplicative factor representing the ratio of air density to water density (eps) -! and BETAMAXOXKAPPA2 - X = USTAR*CM_GC(I) - XLOG = LOG(XK_GC(I)*Z0) + XKAPPA/(X + ZALP) - ZLOG = XLOG - LOG(XLAMBDA) - ZLOG = MIN(ZLOG, 0.0_JWRB) - ZLOG2X = ZLOG*ZLOG*X - GAM_W(I)= ZLOG2X*ZLOG2X*EXP(XLOG)*OM3GMKM_GC(I) - ENDDO +! GAM_W GROWTHRATE BY WIND WITHOUT the multiplicative factor representing the ratio of air density to water density (eps) +! and BETAMAXOXKAPPA2 + X = USTAR*CM_GC(NS) + XLOG = LOG(XK_GC(NS)*Z0) + XKAPPA/(X + ZALP) + ZLOG = XLOG - LOG(XLAMBDA) + ZLOG = MIN(ZLOG, 0.0_JWRB) + ZLOG2X = ZLOG*ZLOG*X + GAM_W = ZLOG2X*ZLOG2X*EXP(XLOG)*OM3GMKM_GC(NS) - ZN = CONST*XKMSQRTVGOC2_GC(NS)*GAM_W(NS) + ZN = CONST*XKMSQRTVGOC2_GC(NS)*GAM_W GAMNORMA = (1.0_JWRB + RN1_RN*ZN)/(1.0_JWRB + ZN) - TAUWCG = GAM_W(NS) * DELKCC_GC_NS(NS) * OMXKM3_GC(NS) * GAMNORMA + + TAUWCG = GAM_W * DELKCC_GC_NS(NS) * OMXKM3_GC(NS) * GAMNORMA + DO I = NS+1, NWAV_GC ! ANALYTICAL FORM INERTIAL SUB RANGE F(k) = k**(-4)*BB ! BB = HALP * C2OSQRTVG_GC(NS)*SQRT(VG_GC(I))/C_GC(I)**2 @@ -113,11 +114,20 @@ REAL(KIND=JWRB) FUNCTION STRESS_GC(ANG_GC, USTAR, Z0, Z0MIN, HALP, RNFAC) ! Tauwcg : integral of omega * gammma_wam * F(k) k dk ! It should be done in vector form with actual directional spreading information ! It simplified here by using the ANG_GC factor. - ZN = CONST*XKMSQRTVGOC2_GC(I)*GAM_W(I) + + X = USTAR*CM_GC(I) + XLOG = LOG(XK_GC(I)*Z0) + XKAPPA/(X + ZALP) + ZLOG = XLOG - LOG(XLAMBDA) + ZLOG = MIN(ZLOG, 0.0_JWRB) + ZLOG2X = ZLOG*ZLOG*X + GAM_W = ZLOG2X*ZLOG2X*EXP(XLOG)*OM3GMKM_GC(I) + + ZN = CONST*XKMSQRTVGOC2_GC(I)*GAM_W GAMNORMA = (1.0_JWRB + RN1_RN*ZN)/(1.0_JWRB + ZN) - TAUWCG = TAUWCG + GAM_W(I) * DELKCC_OMXKM3_GC(I) * GAMNORMA + + TAUWCG = TAUWCG + GAM_W * DELKCC_OMXKM3_GC(I) * GAMNORMA ENDDO - STRESS_GC = MAX(ZABHRC * TAUWCG, TAUWCG_MIN) + STRESS_GC_RES = MAX(ZABHRC * TAUWCG, TAUWCG_MIN) IF (LHOOK) CALL DR_HOOK('STRESS_GC',1,ZHOOK_HANDLE) diff --git a/src/ecwam/stresso.F90 b/src/ecwam/stresso.F90 index e7d74d5c4..ae9a406e4 100644 --- a/src/ecwam/stresso.F90 +++ b/src/ecwam/stresso.F90 @@ -151,11 +151,13 @@ SUBROUTINE STRESSO (KIJS, KIJL, MIJ, RHOWGDFTH, & DO IJ=KIJS,KIJL SUMX(IJ) = SPOS(IJ,K,M)*SINTH(K) SUMY(IJ) = SPOS(IJ,K,M)*COSTH(K) + SUMT(IJ) = SPOS(IJ,K,M) ENDDO DO K=2,NANG DO IJ=KIJS,KIJL SUMX(IJ) = SUMX(IJ) + SPOS(IJ,K,M)*SINTH(K) SUMY(IJ) = SUMY(IJ) + SPOS(IJ,K,M)*COSTH(K) + SUMT(IJ) = SUMT(IJ) + SPOS(IJ,K,M) ENDDO ENDDO DO IJ=KIJS,KIJL @@ -163,6 +165,12 @@ SUBROUTINE STRESSO (KIJS, KIJL, MIJ, RHOWGDFTH, & XSTRESS(IJ) = XSTRESS(IJ) + CMRHOWGDFTH(IJ)*SUMX(IJ) YSTRESS(IJ) = YSTRESS(IJ) + CMRHOWGDFTH(IJ)*SUMY(IJ) ENDDO + + IF ( LLPHIWA ) THEN + DO IJ=KIJS,KIJL + PHIWA(IJ) = PHIWA(IJ) + RHOWGDFTH(IJ,M)*SUMT(IJ) + ENDDO + ENDIF ENDDO ! TAUW is the kinematic wave stress ! @@ -171,23 +179,6 @@ SUBROUTINE STRESSO (KIJS, KIJL, MIJ, RHOWGDFTH, & YSTRESS(IJ) = YSTRESS(IJ)/MAX(AIRD(IJ), 1.0_JWRB) ENDDO - IF ( LLPHIWA ) THEN - DO M=1,NFRE -! THE INTEGRATION ONLY UP TO FR=MIJ SINCE RHOWGDFTH=0 FOR FR>MIJ - K=1 - DO IJ=KIJS,KIJL - SUMT(IJ) = SPOS(IJ,K,M) - ENDDO - DO K=2,NANG - DO IJ=KIJS,KIJL - SUMT(IJ) = SUMT(IJ) + SPOS(IJ,K,M) - ENDDO - ENDDO - DO IJ=KIJS,KIJL - PHIWA(IJ) = PHIWA(IJ) + RHOWGDFTH(IJ,M)*SUMT(IJ) - ENDDO - ENDDO - ENDIF !* CALCULATE HIGH-FREQUENCY CONTRIBUTION TO STRESS and energy flux (positive sinput). ! ---------------------------------------------------------------------------------- @@ -210,6 +201,7 @@ SUBROUTINE STRESSO (KIJS, KIJL, MIJ, RHOWGDFTH, & ENDDO ENDIF + !$loki inline CALL TAU_PHI_HF(KIJS, KIJL, MIJ, LTAUWSHELTER, UFRIC, Z0M, & & FL1, AIRD, RNFAC, & & COSWDIF, SINWDIF2, & diff --git a/src/ecwam/tau_phi_hf.F90 b/src/ecwam/tau_phi_hf.F90 index 9b0390509..67a17d38b 100644 --- a/src/ecwam/tau_phi_hf.F90 +++ b/src/ecwam/tau_phi_hf.F90 @@ -117,11 +117,13 @@ SUBROUTINE TAU_PHI_HF(KIJS, KIJL, MIJ, LTAUWSHELTER, UFRIC, Z0M, & REAL(KIND=JWRB), DIMENSION(KIJL) :: F1DCOS2, F1DCOS3 REAL(KIND=JWRB), DIMENSION(KIJL) :: F1D, F1DSIN2 + ! ---------------------------------------------------------------------- IF (LHOOK) CALL DR_HOOK('TAU_PHI_HF',0,ZHOOK_HANDLE) IF (LLGCBZ0) THEN + !$loki inline CALL OMEGAGC(KIJS, KIJL, UFRIC, NS, XKS, OMS) ENDIF diff --git a/src/ecwam/taut_z0.F90 b/src/ecwam/taut_z0.F90 index c1e676587..d98450f11 100644 --- a/src/ecwam/taut_z0.F90 +++ b/src/ecwam/taut_z0.F90 @@ -68,7 +68,6 @@ SUBROUTINE TAUT_Z0(KIJS, KIJL, IUSFG, & USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU - USE YOWFRED , ONLY : NWAV_GC ! needed for Loki USE YOWCOUP , ONLY : LLCAPCHNK, LLGCBZ0 USE YOWPARAM , ONLY : NANG ,NFRE USE YOWPCONS , ONLY : G, GM1, EPSUS, EPSMIN, ACD, BCD, ACDLIN, BCDLIN, CDMAX @@ -91,9 +90,10 @@ SUBROUTINE TAUT_Z0(KIJS, KIJL, IUSFG, & REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: Z0, Z0B, CHRNCK - INTEGER(KIND=JWIM), PARAMETER :: NITER=17 + INTEGER(KIND=JWIM), PARAMETER :: NITER=18 REAL(KIND=JWRB), PARAMETER :: TWOXMP1=3.0_JWRB + REAL(KIND=JWRB), PARAMETER :: PMAX=0.99_JWRB INTEGER(KIND=JWIM) :: IJ, ITER INTEGER(KIND=JWIM) :: IFRPH @@ -109,6 +109,7 @@ SUBROUTINE TAUT_Z0(KIJS, KIJL, IUSFG, & REAL(KIND=JWRB) :: US2TOTAUW, USMAX REAL(KIND=JWRB) :: XLOGXL, XKUTOP, XOLOGZ0 REAL(KIND=JWRB) :: USTOLD, USTNEW, TAUOLD, TAUNEW, X, F, DELF, CDFG + REAL(KIND=JWRB) :: USNRF, Z0NRF, Z0BNRF, ALPOG REAL(KIND=JWRB) :: USTM1, Z0TOT, Z0CH, Z0VIS, HZ0VISO1MX, ZZ REAL(KIND=JWRB) :: CONST, TAUV, DEL REAL(KIND=JWRB) :: RNUEFF, RNUKAPPAM1 @@ -122,13 +123,7 @@ SUBROUTINE TAUT_Z0(KIJS, KIJL, IUSFG, & ! ---------------------------------------------------------------------- -! INLINE FUNCTION. -! ---------------- - -! Simple empirical fit to model drag coefficient - REAL(KIND=JWRB) :: CDM, U10 - - CDM(U10) = MAX(MIN(0.0006_JWRB+0.00008_JWRB*U10, 0.001_JWRB+0.0018_JWRB*EXP(-0.05_JWRB*(U10-33._JWRB))),0.001_JWRB) +#include "cdm.func.h" ! ---------------------------------------------------------------------- @@ -137,6 +132,11 @@ SUBROUTINE TAUT_Z0(KIJS, KIJL, IUSFG, & XLOGXL=LOG(XNLEV) US2TOTAUW=1.0_JWRB+EPS1 + RNUEFF = 0.04_JWRB*RNU + RNUKAPPAM1 = RNUEFF/XKAPPA + + PCE_GC = 0.001_JWRB * IUSFG + (1-IUSFG) * 0.005_JWRB + ! ONLY take the contribution of TAUW that is in the wind direction DO IJ = KIJS, KIJL COSDIFF = COS(UDIR(IJ)-TAUWDIR(IJ)) @@ -161,11 +161,6 @@ SUBROUTINE TAUT_Z0(KIJS, KIJL, IUSFG, & TAUWEFF(IJ) = MIN(TAUWACT(IJ)*US2TOTAUW, USMAX**2 ) ENDDO - RNUEFF = 0.04_JWRB*RNU - - RNUKAPPAM1 = RNUEFF/XKAPPA - - PCE_GC = 0.001_JWRB * IUSFG + (1-IUSFG) * 0.005_JWRB IF (IUSFG == 0 ) THEN ALPHAGM1 = ALPHA*GM1 @@ -173,7 +168,7 @@ SUBROUTINE TAUT_Z0(KIJS, KIJL, IUSFG, & IF ( UTOP(IJ) < 1.0_JWRB ) THEN CDFG = 0.002_JWRB ELSEIF ( LLCOSDIFF(IJ) ) THEN - X = MIN(TAUWACT(IJ)/MAX(USTAR(IJ),EPSUS)**2,0.99_JWRB) + X = MIN(TAUWACT(IJ)/MAX(USTAR(IJ),EPSUS)**2,PMAX) ZCHAR = MIN( ALPHAGM1 * USTAR(IJ)**2 / SQRT(1.0_JWRB - X), 0.05_JWRB*EXP(-0.05_JWRB*(UTOP(IJ)-35._JWRB)) ) ZCHAR = MIN(ZCHAR,ALPHAMAX) CDFG = ACDLIN + BCDLIN*SQRT(ZCHAR) * UTOP(IJ) @@ -211,12 +206,15 @@ SUBROUTINE TAUT_Z0(KIJS, KIJL, IUSFG, & ! CONVERGENCE ? DEL = USTAR(IJ)-USTOLD - IF (ABS(DEL) < PCE_GC*USTAR(IJ)) EXIT + IF (ABS(DEL) < PCE_GC*USTAR(IJ)) EXIT TAUOLD = USTAR(IJ)**2 USTOLD = USTAR(IJ) ENDDO + + X = TAUWEFF(IJ)/TAUOLD + ! protection just in case there is no convergence - IF (ITER > NITER ) THEN + IF (ITER > NITER .AND. X >= PMAX ) THEN CDFG = CDM(UTOP(IJ)) USTAR(IJ) = UTOP(IJ)*SQRT(CDFG) Z0MINRST = USTAR(IJ)**2 * ALPHA*GM1 @@ -228,50 +226,52 @@ SUBROUTINE TAUT_Z0(KIJS, KIJL, IUSFG, & ENDIF ! Refine solution - X = TAUWEFF(IJ)/TAUOLD - IF (X < 0.99_JWRB) THEN + IF (X < PMAX) THEN + + USNRF = USTAR(IJ) + Z0NRF = Z0(IJ) + Z0BNRF = Z0B(IJ) + USTOLD = USTAR(IJ) TAUOLD = MAX(USTOLD**2,TAUWEFF(IJ)) + ALPOG = MAX(MIN(Z0B(IJ)/TAUOLD,ALPHAMAX), ALPHAOG(IJ)) + DO ITER=1,NITER - X = MIN(TAUWEFF(IJ)/TAUOLD, 0.99_JWRB) + X = MIN(TAUWEFF(IJ)/TAUOLD, PMAX) USTM1 = 1.0_JWRB/MAX(USTOLD,EPSUS) - !!!! Limit how small z0 could become - !!!! This is a bit of a compromise to limit very low Charnock for intermediate high winds (15 -25 m/s) - !!!! It is not ideal !!! - Z0(IJ) = MAX(XNLEV/(EXP(MIN(XKUTOP/USTOLD, 50.0_JWRB))-1.0_JWRB), Z0MIN) - - TAUUNR(IJ) = STRESS_GC(ANG_GC(IJ), USTOLD, Z0(IJ), Z0MIN, HALP(IJ), RNFAC(IJ)) - - Z0B(IJ) = MAX( Z0(IJ)*SQRT(TAUUNR(IJ)/TAUOLD), ALPHAOG(IJ)*TAUOLD) Z0VIS = RNUM*USTM1 HZ0VISO1MX = 0.5_JWRB*Z0VIS/(1.0_JWRB-X) + Z0B(IJ) = ALPOG*TAUOLD Z0(IJ) = HZ0VISO1MX+SQRT(HZ0VISO1MX**2+Z0B(IJ)**2/(1.0_JWRB-X)) - XOLOGZ0= 1.0_JWRB/(XLOGXL-LOG(Z0(IJ))) + XOLOGZ0= 1.0_JWRB/LOG(XNLEV/Z0(IJ)+1.0_JWRB) F = USTOLD-XKUTOP*XOLOGZ0 ZZ = 2.0_JWRB*USTM1*(3.0_JWRB*Z0B(IJ)**2+0.5_JWRB*Z0VIS*Z0(IJ)-Z0(IJ)**2) & & / (2.0_JWRB*Z0(IJ)**2*(1.0_JWRB-X)-Z0VIS*Z0(IJ)) DELF= 1.0_JWRB-XKUTOP*XOLOGZ0**2*ZZ - IF (DELF /= 0.0_JWRB) USTAR(IJ) = USTOLD-F/DELF + IF (DELF /= 0.0_JWRB) USTAR(IJ) = USTOLD-F/DELF ! CONVERGENCE ? - DEL = USTAR(IJ)-USTOLD - - IF (ABS(DEL) < PCE_GC*USTAR(IJ)) EXIT + TAUNEW = MAX(USTAR(IJ)**2,TAUWEFF(IJ)) + USTAR(IJ) = SQRT(TAUNEW) + DEL = TAUNEW-TAUOLD + IF (ABS(DEL) < PCE_GC*TAUOLD) EXIT + TAUOLD = TAUNEW USTOLD = USTAR(IJ) - TAUOLD = MAX(USTOLD**2,TAUWEFF(IJ)) + ENDDO ! protection just in case there is no convergence IF (ITER > NITER ) THEN - CDFG = CDM(UTOP(IJ)) - USTAR(IJ) = UTOP(IJ)*SQRT(CDFG) - Z0MINRST = USTAR(IJ)**2 * ALPHA*GM1 - Z0(IJ) = MAX(XNLEV/(EXP(XKUTOP/USTAR(IJ))-1.0_JWRB), Z0MINRST) - Z0B(IJ) = Z0MINRST - CHRNCK(IJ) = MAX(G*Z0(IJ)/USTAR(IJ)**2, ALPHAMIN) + USTAR(IJ) = USNRF + Z0(IJ) = Z0NRF + Z0B(IJ) = Z0BNRF + USTM1 = 1.0_JWRB/MAX(USTAR(IJ), EPSUS) + Z0VIS = RNUM*USTM1 + CHRNCK(IJ) = MAX(G*(Z0(IJ)-Z0VIS) * USTM1**2, ALPHAMIN) + ELSE CHRNCK(IJ) = MAX( G*(Z0B(IJ)/SQRT(1.0_JWRB-X))/MAX(USTAR(IJ),EPSUS)**2, ALPHAMIN) ENDIF diff --git a/src/ecwam/transf_bfi.F90 b/src/ecwam/transf_bfi.F90 index 6464e11b1..73b2b636c 100644 --- a/src/ecwam/transf_bfi.F90 +++ b/src/ecwam/transf_bfi.F90 @@ -35,6 +35,7 @@ REAL(KIND=JWRB) FUNCTION TRANSF_BFI(XK0,D,XNU,SIG_TH) !---------------------------------------------------------------------- IMPLICIT NONE +!$loki routine seq REAL(KIND=JWRB), INTENT(IN) :: XK0,D,XNU,SIG_TH REAL(KIND=JWRB), PARAMETER :: EPS=0.0001_JWRB diff --git a/src/ecwam/transf_r.F90 b/src/ecwam/transf_r.F90 index de5aba934..367a05dc9 100644 --- a/src/ecwam/transf_r.F90 +++ b/src/ecwam/transf_r.F90 @@ -32,6 +32,7 @@ REAL(KIND=JWRB) FUNCTION TRANSF_R(XK0,D) !---------------------------------------------------------------------- IMPLICIT NONE +!$loki routine seq REAL(KIND=JWRB), PARAMETER :: EPS=0.0001_JWRB REAL(KIND=JPHOOK) :: ZHOOK_HANDLE diff --git a/src/ecwam/updnemostress.F90 b/src/ecwam/updnemostress.F90 index b8701c950..c0708cb47 100644 --- a/src/ecwam/updnemostress.F90 +++ b/src/ecwam/updnemostress.F90 @@ -78,7 +78,7 @@ SUBROUTINE UPDNEMOSTRESS IF (LHOOK) CALL DR_HOOK('UPDNEMOSTRESS',0,ZHOOK_HANDLE) - IF (LWNEMOCOU .AND. ALLOCATED(WAM2NEMO%NEMOTAUX) ) THEN + IF (LWNEMOCOU .AND. WAM2NEMO%LALLOC ) THEN IF (NEMONTAU > 0) THEN ZNEMONTAUM1= 1.0_JWRB/NEMONTAU diff --git a/src/ecwam/w_maxh.F90 b/src/ecwam/w_maxh.F90 index a6afa6506..0b067c136 100644 --- a/src/ecwam/w_maxh.F90 +++ b/src/ecwam/w_maxh.F90 @@ -53,14 +53,14 @@ SUBROUTINE W_MAXH (KIJS, KIJL, F, DEPTH, WAVNUM, & INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE), INTENT(IN) :: F !! BLOCK OF SPECTRA -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: DEPTH !! DEPTH -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NFRE), INTENT(IN) :: WAVNUM !! WAVE NUMBER -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: CMAX_F !! MAXIMUM CREST H.- TIME (FORRISTALL) -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: HMAX_N !! MAXIMUM WAVE H.- TIME (NAESS) -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: CMAX_ST !! MAXIMUM CREST H.- SPACE-TIME (STQD) -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: HMAX_ST !! MAXIMUM WAVE H.- SPACE-TIME (STQD) -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: PHIST !! 1st minimum of the aotocovariance function +REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE), INTENT(IN) :: F !! BLOCK OF SPECTRA +REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: DEPTH !! DEPTH +REAL(KIND=JWRB), DIMENSION(KIJL,NFRE), INTENT(IN) :: WAVNUM !! WAVE NUMBER +REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: CMAX_F !! MAXIMUM CREST H.- TIME (FORRISTALL) +REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: HMAX_N !! MAXIMUM WAVE H.- TIME (NAESS) +REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: CMAX_ST !! MAXIMUM CREST H.- SPACE-TIME (STQD) +REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: HMAX_ST !! MAXIMUM WAVE H.- SPACE-TIME (STQD) +REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: PHIST !! 1st minimum of the aotocovariance function ! LOCAL VARIABLES. ! ---------------- @@ -74,7 +74,7 @@ SUBROUTINE W_MAXH (KIJS, KIJL, F, DEPTH, WAVNUM, & REAL(KIND=JWRB), PARAMETER :: TOL = 0.01_JWRB ! GOLDEN SEARCH TOLERANCE INTEGER(KIND=JWIM) :: IJ, IT, M, K -INTEGER(KIND=JWIM), DIMENSION(KIJS:KIJL) :: K_THMAX +INTEGER(KIND=JWIM), DIMENSION(KIJL) :: K_THMAX REAL(KIND=JPHOOK) :: ZHOOK_HANDLE REAL(KIND=JWRB) :: Z0, RNW, ALFA, BETA, URSN, STEEP, WNUM1 @@ -82,17 +82,17 @@ SUBROUTINE W_MAXH (KIJS, KIJL, F, DEPTH, WAVNUM, & REAL(KIND=JWRB) :: ZEPSILON REAL(KIND=JWRB) :: DELT25, EM, XK2_DFIM, XK_ZPI_DFIM REAL(KIND=JWRB), DIMENSION(4) :: TLGS, ACFS -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: HS, RLX, RLY, AXT, AYT, AXY -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: WMDX, WMDY ! SPACE TIME EXTREME OVER WMDX x WMDY m**2 AREA -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: WMDUR_TD ! TIME EXTREME OVER WMDUR_TD for TIME DOMAIN in sec. -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: WMDUR_ST ! TIME EXTREME OVER WMDUR_ST for SPACE TIME in sec. -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: FMAX -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: ACF, T1, T2, EMEAN -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: TEMP, TEMP_X, TEMP_Y, TEMP_X2, TEMP_Y2, TEMP_XY -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: RNI, RMU +REAL(KIND=JWRB), DIMENSION(KIJL) :: HS, RLX, RLY, AXT, AYT, AXY +REAL(KIND=JWRB), DIMENSION(KIJL) :: WMDX, WMDY ! SPACE TIME EXTREME OVER WMDX x WMDY m**2 AREA +REAL(KIND=JWRB), DIMENSION(KIJL) :: WMDUR_TD ! TIME EXTREME OVER WMDUR_TD for TIME DOMAIN in sec. +REAL(KIND=JWRB), DIMENSION(KIJL) :: WMDUR_ST ! TIME EXTREME OVER WMDUR_ST for SPACE TIME in sec. +REAL(KIND=JWRB), DIMENSION(KIJL) :: FMAX +REAL(KIND=JWRB), DIMENSION(KIJL) :: ACF, T1, T2, EMEAN +REAL(KIND=JWRB), DIMENSION(KIJL) :: TEMP, TEMP_X, TEMP_Y, TEMP_X2, TEMP_Y2, TEMP_XY +REAL(KIND=JWRB), DIMENSION(KIJL) :: RNI, RMU REAL(KIND=JWRB), DIMENSION(NFRE) :: OMEGA -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL, NANG) :: CX, CY, CX2, CY2, CXCY -REAL(KIND=JWRB), DIMENSION(KIJS:KIJL, NFRE) :: TEMPDFIM +REAL(KIND=JWRB), DIMENSION(KIJL, NANG) :: CX, CY, CX2, CY2, CXCY +REAL(KIND=JWRB), DIMENSION(KIJL, NFRE) :: TEMPDFIM ! ---------------------------------------------------------------------------- @@ -207,34 +207,34 @@ SUBROUTINE W_MAXH (KIJS, KIJL, F, DEPTH, WAVNUM, & ENDIF ENDDO -WHERE (EMEAN > ZEPSILON) - AXY = MIN(AXY/SQRT(RLX*RLY), 1._JWRB) - AXT = MIN(AXT/(ZPI*SQRT(RLX*T2)), 1._JWRB) - AYT = MIN(AYT/(ZPI*SQRT(RLY*T2)), 1._JWRB) - RLX = ZPI*SQRT(EMEAN/RLX) - RLY = ZPI*SQRT(EMEAN/RLY) - RNI = SQRT(MAX(EMEAN*T2/T1**2 - 1._JWRB,ZEPSILON)) - RMU = (ZPI*T1)**2*(1._JWRB-RNI+RNI**2)/(G*EMEAN**THREEHALF) - T1 = MIN(MAX(EMEAN/T1,TMIN),TMAX) - T2 = MIN(MAX(SQRT(EMEAN/T2),TMIN),TMAX) +WHERE (EMEAN(KIJS:KIJL) > ZEPSILON) + AXY(KIJS:KIJL) = MIN(AXY(KIJS:KIJL)/SQRT(RLX(KIJS:KIJL)*RLY(KIJS:KIJL)), 1._JWRB) + AXT(KIJS:KIJL) = MIN(AXT(KIJS:KIJL)/(ZPI*SQRT(RLX(KIJS:KIJL)*T2(KIJS:KIJL))), 1._JWRB) + AYT(KIJS:KIJL) = MIN(AYT(KIJS:KIJL)/(ZPI*SQRT(RLY(KIJS:KIJL)*T2(KIJS:KIJL))), 1._JWRB) + RLX(KIJS:KIJL) = ZPI*SQRT(EMEAN(KIJS:KIJL)/RLX(KIJS:KIJL)) + RLY(KIJS:KIJL) = ZPI*SQRT(EMEAN(KIJS:KIJL)/RLY(KIJS:KIJL)) + RNI(KIJS:KIJL) = SQRT(MAX(EMEAN(KIJS:KIJL)*T2(KIJS:KIJL)/T1(KIJS:KIJL)**2 - 1._JWRB,ZEPSILON)) + RMU(KIJS:KIJL) = (ZPI*T1(KIJS:KIJL))**2*(1._JWRB-RNI+RNI**2)/(G*EMEAN(KIJS:KIJL)**THREEHALF) + T1(KIJS:KIJL) = MIN(MAX(EMEAN(KIJS:KIJL)/T1(KIJS:KIJL),TMIN),TMAX) + T2(KIJS:KIJL) = MIN(MAX(SQRT(EMEAN(KIJS:KIJL)/T2(KIJS:KIJL)),TMIN),TMAX) !!! WMDUR_TD = XNWVP*T2 - WMDX = MAX(RLX,WVLMIN) - WMDY = MAX(RLY,WVLMIN) - WMDUR_ST = XNWVP*T2 + WMDX(KIJS:KIJL) = MAX(RLX(KIJS:KIJL),WVLMIN) + WMDY(KIJS:KIJL) = MAX(RLY(KIJS:KIJL),WVLMIN) + WMDUR_ST(KIJS:KIJL) = XNWVP*T2(KIJS:KIJL) ELSEWHERE - AXY = 0._JWRB - AXT = 0._JWRB - AYT = 0._JWRB - RLX = 1._JWRB - RLY = 1._JWRB - RNI = 0._JWRB - RMU = 0._JWRB - T1 = TMIN - T2 = TMIN + AXY(KIJS:KIJL) = 0._JWRB + AXT(KIJS:KIJL) = 0._JWRB + AYT(KIJS:KIJL) = 0._JWRB + RLX(KIJS:KIJL) = 1._JWRB + RLY(KIJS:KIJL) = 1._JWRB + RNI(KIJS:KIJL) = 0._JWRB + RMU(KIJS:KIJL) = 0._JWRB + T1(KIJS:KIJL) = TMIN + T2(KIJS:KIJL) = TMIN !!! WMDUR_TD = XNWVP*T2 - WMDX = MAX(RLX,WVLMIN) - WMDY = MAX(RLY,WVLMIN) - WMDUR_ST = XNWVP*T2 + WMDX(KIJS:KIJL) = MAX(RLX(KIJS:KIJL),WVLMIN) + WMDY(KIJS:KIJL) = MAX(RLY(KIJS:KIJL),WVLMIN) + WMDUR_ST(KIJS:KIJL) = XNWVP*T2(KIJS:KIJL) END WHERE ! MIN OF AUTOCOVARIANCE FUNCTION VIA GOLDEN RATIO SEARCH diff --git a/src/ecwam/w_mode_st.F90 b/src/ecwam/w_mode_st.F90 index f6b03cb9a..adb3bc0cc 100644 --- a/src/ecwam/w_mode_st.F90 +++ b/src/ecwam/w_mode_st.F90 @@ -33,6 +33,7 @@ REAL(KIND=JWRB) FUNCTION W_MODE_ST (RN3, RN2, RN1) ! ---------------------------------------------------------------------- IMPLICIT NONE +!$loki routine seq ! INTERFACE VARIABLES. ! ! -------------------- ! diff --git a/src/ecwam/wam_init_gpu_mod.F90 b/src/ecwam/wam_init_gpu_mod.F90 deleted file mode 100644 index 2c16e0617..000000000 --- a/src/ecwam/wam_init_gpu_mod.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! (C) Copyright 1989- ECMWF. -! -! This software is licensed under the terms of the Apache Licence Version 2.0 -! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -! In applying this licence, ECMWF does not waive the privileges and immunities -! granted to it by virtue of its status as an intergovernmental organisation -! nor does it submit to any jurisdiction. -! - - MODULE WAM_INIT_GPU_MOD - CONTAINS - SUBROUTINE WAM_INIT_GPU(IRANK) -#ifdef _OPENACC - USE OPENACC -#endif - USE PARKIND_WAVE, ONLY : JWIM - IMPLICIT NONE - - INTEGER(KIND=JWIM), INTENT(IN) :: IRANK - INTEGER :: DEVTYPE, DEVNUM, DEV - - -#ifdef _OPENACC - DEVTYPE = ACC_GET_DEVICE_TYPE() - DEVNUM = ACC_GET_NUM_DEVICES(DEVTYPE) - DEV = MOD(IRANK-1, DEVNUM) - CALL ACC_SET_DEVICE_NUM(DEV, DEVTYPE) -#endif - END SUBROUTINE WAM_INIT_GPU - END MODULE WAM_INIT_GPU_MOD diff --git a/src/ecwam/wamintgr.F90 b/src/ecwam/wamintgr.F90 index af018775f..6d4292263 100644 --- a/src/ecwam/wamintgr.F90 +++ b/src/ecwam/wamintgr.F90 @@ -10,7 +10,7 @@ SUBROUTINE WAMINTGR (CDTPRA, CDATE, CDATEWH, CDTIMP, CDTIMPNEXT, & & BLK2GLO, & & WVENVI, WVPRPT, FF_NOW, FF_NEXT, INTFLDS, & - & WAM2NEMO, MIJ, FL1, XLLWS) + & WAM2NEMO, MIJ, VARS_4D) ! ---------------------------------------------------------------------- @@ -33,7 +33,7 @@ SUBROUTINE WAMINTGR (CDTPRA, CDATE, CDATEWH, CDTIMP, CDTIMPNEXT, & USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU USE YOWDRVTYPE , ONLY : WVGRIDGLO, ENVIRONMENT, FREQUENCY, FORCING_FIELDS, & - & INTGT_PARAM_FIELDS, WAVE2OCEAN + & INTGT_PARAM_FIELDS, WAVE2OCEAN, TYPE_4D, MIJ_TYPE USE YOWCOUP , ONLY : LWNEMOCOU, NEMONTAU USE YOWGRID , ONLY : NPROMA_WAM, NCHNK @@ -42,9 +42,6 @@ SUBROUTINE WAMINTGR (CDTPRA, CDATE, CDATEWH, CDTIMP, CDTIMPNEXT, & USE YOWSTAT , ONLY : CDTPRO, IDELPRO, IDELT, IDELWI, LLSOURCE, TIME_PROPAG, & & TIME_PHYS USE YOWWIND , ONLY : CDAWIFL, CDATEWO, CDATEFL -USE YOWINDN , ONLY : MLSTHG !...Needed for Loki -USE YOWFIELD_MOD, ONLY : FREQUENCY_FIELD, ENVIRONMENT_FIELD, FORCING_FIELDS_FIELD, & - & WAVE2OCEAN_FIELD, INTGT_PARAM_FIELDS_FIELD, SOURCE_CONTRIBS_FIELD USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK @@ -70,9 +67,8 @@ SUBROUTINE WAMINTGR (CDTPRA, CDATE, CDATEWH, CDTIMP, CDTIMPNEXT, & TYPE(FORCING_FIELDS), INTENT(IN) :: FF_NEXT ! DATA STRUCTURE WITH THE NEXT FORCING FIELDS TYPE(INTGT_PARAM_FIELDS), INTENT(INOUT) :: INTFLDS ! INTEGRATED/DERIVED PARAMETERS TYPE(WAVE2OCEAN), INTENT(INOUT) :: WAM2NEMO ! WAVE FIELDS PASSED TO NEMO -INTEGER(KIND=JWIM), DIMENSION(NPROMA_WAM, NCHNK), INTENT(INOUT) :: MIJ ! LAST FREQUENCY INDEX OF THE PROGNOSTIC RANGE -REAL(KIND=JWRB), DIMENSION(NPROMA_WAM, NANG, NFRE, NCHNK), INTENT(INOUT) :: FL1 -REAL(KIND=JWRB), DIMENSION(NPROMA_WAM, NANG, NFRE, NCHNK), INTENT(INOUT) :: XLLWS ! TOTAL WINDSEA MASK FROM INPUT SOURCE TERM +TYPE(MIJ_TYPE), INTENT(INOUT) :: MIJ +TYPE(TYPE_4D), INTENT(INOUT) :: VARS_4D REAL(KIND=JWRB) :: TIME0 @@ -81,14 +77,6 @@ SUBROUTINE WAMINTGR (CDTPRA, CDATE, CDATEWH, CDTIMP, CDTIMPNEXT, & INTEGER(KIND=JWIM) :: ICHNK INTEGER(KIND=JWIM) :: IDELWH -! Objects to store fields -TYPE(FREQUENCY_FIELD) :: WVPRPT_FIELD -TYPE(ENVIRONMENT_FIELD) :: WVENVI_FIELD -TYPE(FORCING_FIELDS_FIELD) :: FF_NOW_FIELD -TYPE(WAVE2OCEAN_FIELD) :: WAM2NEMO_FIELD -TYPE(INTGT_PARAM_FIELDS_FIELD) :: INTFLDS_FIELD -TYPE(SOURCE_CONTRIBS_FIELD) :: SRC_CONTRIBS - REAL(KIND=JPHOOK) :: ZHOOK_HANDLE @@ -105,7 +93,7 @@ SUBROUTINE WAMINTGR (CDTPRA, CDATE, CDATEWH, CDTIMP, CDTIMPNEXT, & IF (CDATE == CDTPRA) THEN TIME0=-WAM_USER_CLOCK() - CALL PROPAG_WAM(BLK2GLO, WVPRPT%WAVNUM, WVPRPT%CGROUP, WVPRPT%OMOSNH2KD, FL1,& + CALL PROPAG_WAM(BLK2GLO, WVPRPT%WAVNUM, WVPRPT%CGROUP, WVPRPT%OMOSNH2KD, VARS_4D%FL1,& & WVENVI%DEPTH, WVENVI%DELLAM1, WVENVI%COSPHM1, WVENVI%UCUR, WVENVI%VCUR) TIME_PROPAG = TIME_PROPAG + (TIME0+WAM_USER_CLOCK())*1.E-06 CDATE = CDTPRO @@ -125,68 +113,35 @@ SUBROUTINE WAMINTGR (CDTPRA, CDATE, CDATEWH, CDTIMP, CDTIMPNEXT, & IF (LLSOURCE) THEN TIME0=-WAM_USER_CLOCK() - CALL WVPRPT_FIELD%INIT(WAVNUM=WVPRPT%WAVNUM, CGROUP=WVPRPT%CGROUP, CIWA=WVPRPT%CIWA, CINV=WVPRPT%CINV, XK2CG=WVPRPT%XK2CG, & - & STOKFAC=WVPRPT%STOKFAC) - CALL WVENVI_FIELD%INIT(EMAXDPT=WVENVI%EMAXDPT, DEPTH=WVENVI%DEPTH, IOBND=WVENVI%IOBND, IODP=WVENVI%IODP) - CALL FF_NOW_FIELD%INIT(AIRD=FF_NOW%AIRD, WDWAVE=FF_NOW%WDWAVE, CICOVER=FF_NOW%CICOVER, WSWAVE=FF_NOW%WSWAVE, & -& WSTAR=FF_NOW%WSTAR, UFRIC=FF_NOW%UFRIC, TAUW=FF_NOW%TAUW, TAUWDIR=FF_NOW%TAUWDIR, & -& Z0M=FF_NOW%Z0M, Z0B=FF_NOW%Z0B, CHRNCK=FF_NOW%CHRNCK, CITHICK=FF_NOW%CITHICK, USTRA=FF_NOW%USTRA, & -& VSTRA=FF_NOW%VSTRA) - CALL WAM2NEMO_FIELD%INIT(NEMOUSTOKES=WAM2NEMO%NEMOUSTOKES, NEMOVSTOKES=WAM2NEMO%NEMOVSTOKES, NEMOSTRN=WAM2NEMO%NEMOSTRN, & -& NPHIEPS=WAM2NEMO%NPHIEPS, NTAUOC=WAM2NEMO%NTAUOC, NSWH=WAM2NEMO%NSWH, NMWP=WAM2NEMO%NMWP, & -& NEMOTAUX=WAM2NEMO%NEMOTAUX, NEMOTAUY=WAM2NEMO%NEMOTAUY, NEMOWSWAVE=WAM2NEMO%NEMOWSWAVE, & -& NEMOPHIF=WAM2NEMO%NEMOPHIF) - CALL INTFLDS_FIELD%INIT(WSEMEAN=INTFLDS%WSEMEAN, WSFMEAN=INTFLDS%WSFMEAN, USTOKES=INTFLDS%USTOKES, VSTOKES=INTFLDS%VSTOKES, & -& STRNMS=INTFLDS%STRNMS, TAUXD=INTFLDS%TAUXD, TAUYD=INTFLDS%TAUYD, TAUOCXD=INTFLDS%TAUOCXD, & -& TAUOCYD=INTFLDS%TAUOCYD, TAUOC=INTFLDS%TAUOC, PHIOCD=INTFLDS%PHIOCD, PHIEPS=INTFLDS%PHIEPS, & -& PHIAW=INTFLDS%PHIAW) - CALL SRC_CONTRIBS%INIT(FL1=FL1, XLLWS=XLLWS, MIJ=MIJ) - -!$loki update_device - -!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(ICHNK) FIRSTPRIVATE(WVPRPT_FIELD, WVENVI_FIELD, FF_NOW_FIELD, WAM2NEMO_FIELD, & -!$OMP INTFLDS_FIELD, SRC_CONTRIBS) + +!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(ICHNK) DO ICHNK = 1, NCHNK - CALL WVPRPT_FIELD%UPDATE_VIEW(ICHNK) - CALL WVENVI_FIELD%UPDATE_VIEW(ICHNK) - CALL FF_NOW_FIELD%UPDATE_VIEW(ICHNK) - CALL WAM2NEMO_FIELD%UPDATE_VIEW(ICHNK) - CALL INTFLDS_FIELD%UPDATE_VIEW(ICHNK) - CALL SRC_CONTRIBS%UPDATE_VIEW(ICHNK) - - CALL IMPLSCH (1, NPROMA_WAM, SRC_CONTRIBS%FL1, & - & WVPRPT_FIELD%WAVNUM, WVPRPT_FIELD%CGROUP, WVPRPT_FIELD%CIWA, & - & WVPRPT_FIELD%CINV, WVPRPT_FIELD%XK2CG, WVPRPT_FIELD%STOKFAC, & - & WVENVI_FIELD%EMAXDPT, & - & WVENVI_FIELD%DEPTH, WVENVI_FIELD%IOBND, WVENVI_FIELD%IODP, & - & FF_NOW_FIELD%AIRD, FF_NOW_FIELD%WDWAVE, FF_NOW_FIELD%CICOVER, & - & FF_NOW_FIELD%WSWAVE, FF_NOW_FIELD%WSTAR, & - & FF_NOW_FIELD%USTRA, FF_NOW_FIELD%VSTRA, & - & FF_NOW_FIELD%UFRIC, FF_NOW_FIELD%TAUW, FF_NOW_FIELD%TAUWDIR, & - & FF_NOW_FIELD%Z0M, FF_NOW_FIELD%Z0B, FF_NOW_FIELD%CHRNCK, & - & FF_NOW_FIELD%CITHICK, & - & WAM2NEMO_FIELD%NEMOUSTOKES, WAM2NEMO_FIELD%NEMOVSTOKES, WAM2NEMO_FIELD%NEMOSTRN, & - & WAM2NEMO_FIELD%NPHIEPS, WAM2NEMO_FIELD%NTAUOC, WAM2NEMO_FIELD%NSWH, & - & WAM2NEMO_FIELD%NMWP, WAM2NEMO_FIELD%NEMOTAUX, WAM2NEMO_FIELD%NEMOTAUY, & - & WAM2NEMO_FIELD%NEMOWSWAVE, WAM2NEMO_FIELD%NEMOPHIF, & - & INTFLDS_FIELD%WSEMEAN, INTFLDS_FIELD%WSFMEAN, & - & INTFLDS_FIELD%USTOKES, INTFLDS_FIELD%VSTOKES, INTFLDS_FIELD%STRNMS, & - & INTFLDS_FIELD%TAUXD, INTFLDS_FIELD%TAUYD, INTFLDS_FIELD%TAUOCXD, & - & INTFLDS_FIELD%TAUOCYD, INTFLDS_FIELD%TAUOC, INTFLDS_FIELD%PHIOCD, & - & INTFLDS_FIELD%PHIEPS, INTFLDS_FIELD%PHIAW, & - & SRC_CONTRIBS%MIJ, SRC_CONTRIBS%XLLWS ) + + CALL IMPLSCH (1, NPROMA_WAM, VARS_4D%FL1(:,:,:,ICHNK), & + & WVPRPT%WAVNUM(:,:,ICHNK), WVPRPT%CGROUP(:,:,ICHNK), WVPRPT%CIWA(:,:,ICHNK), & + & WVPRPT%CINV(:,:,ICHNK), WVPRPT%XK2CG(:,:,ICHNK), WVPRPT%STOKFAC(:,:,ICHNK), & + & WVENVI%EMAXDPT(:,ICHNK), & + & WVENVI%DEPTH(:,ICHNK), WVENVI%IOBND(:,ICHNK), WVENVI%IODP(:,ICHNK), & + & FF_NOW%AIRD(:,ICHNK), FF_NOW%WDWAVE(:,ICHNK), FF_NOW%CICOVER(:,ICHNK), & + & FF_NOW%WSWAVE(:,ICHNK), FF_NOW%WSTAR(:,ICHNK), & + & FF_NOW%USTRA(:,ICHNK), FF_NOW%VSTRA(:,ICHNK), & + & FF_NOW%UFRIC(:,ICHNK), FF_NOW%TAUW(:,ICHNK), FF_NOW%TAUWDIR(:,ICHNK), & + & FF_NOW%Z0M(:,ICHNK), FF_NOW%Z0B(:,ICHNK), FF_NOW%CHRNCK(:,ICHNK), & + & FF_NOW%CITHICK(:,ICHNK), & + & WAM2NEMO%NEMOUSTOKES(:,ICHNK), WAM2NEMO%NEMOVSTOKES(:,ICHNK), WAM2NEMO%NEMOSTRN(:,ICHNK), & + & WAM2NEMO%NPHIEPS(:,ICHNK), WAM2NEMO%NTAUOC(:,ICHNK), WAM2NEMO%NSWH(:,ICHNK), & + & WAM2NEMO%NMWP(:,ICHNK), WAM2NEMO%NEMOTAUX(:,ICHNK), WAM2NEMO%NEMOTAUY(:,ICHNK), & + & WAM2NEMO%NEMOWSWAVE(:,ICHNK), WAM2NEMO%NEMOPHIF(:,ICHNK), & + & INTFLDS%WSEMEAN(:,ICHNK), INTFLDS%WSFMEAN(:,ICHNK), & + & INTFLDS%USTOKES(:,ICHNK), INTFLDS%VSTOKES(:,ICHNK), INTFLDS%STRNMS(:,ICHNK), & + & INTFLDS%TAUXD(:,ICHNK), INTFLDS%TAUYD(:,ICHNK), INTFLDS%TAUOCXD(:,ICHNK), & + & INTFLDS%TAUOCYD(:,ICHNK), INTFLDS%TAUOC(:,ICHNK), INTFLDS%PHIOCD(:,ICHNK), & + & INTFLDS%PHIEPS(:,ICHNK), INTFLDS%PHIAW(:,ICHNK), & + & MIJ%PTR(:,ICHNK), VARS_4D%XLLWS(:,:,:,ICHNK) ) ENDDO !$OMP END PARALLEL DO -!$loki update_host - CALL WVPRPT_FIELD%FINAL() - CALL WVENVI_FIELD%FINAL() - CALL FF_NOW_FIELD%FINAL() - CALL WAM2NEMO_FIELD%FINAL() - CALL INTFLDS_FIELD%FINAL() - CALL SRC_CONTRIBS%FINAL() - TIME_PHYS = TIME_PHYS + (TIME0+WAM_USER_CLOCK())*1.E-06 IF (LWNEMOCOU) NEMONTAU = NEMONTAU + 1 @@ -195,9 +150,9 @@ SUBROUTINE WAMINTGR (CDTPRA, CDATE, CDATEWH, CDTIMP, CDTIMPNEXT, & ! NO SOURCE TERM CONTRIBUTION !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(ICHNK) DO ICHNK = 1, NCHNK - MIJ(:,ICHNK) = NFRE - FL1(:,:,:,ICHNK) = MAX(FL1(:,:,:,ICHNK), EPSMIN) - XLLWS(:,:,:,ICHNK) = 0.0_JWRB + MIJ%PTR(:,ICHNK) = NFRE + VARS_4D%FL1(:,:,:,ICHNK) = MAX(VARS_4D%FL1(:,:,:,ICHNK), EPSMIN) + VARS_4D%XLLWS(:,:,:,ICHNK) = 0.0_JWRB ENDDO !$OMP END PARALLEL DO ENDIF diff --git a/src/ecwam/wamintgr_loki_gpu.F90 b/src/ecwam/wamintgr_loki_gpu.F90 index 1d4268505..705e10e82 100644 --- a/src/ecwam/wamintgr_loki_gpu.F90 +++ b/src/ecwam/wamintgr_loki_gpu.F90 @@ -10,7 +10,7 @@ SUBROUTINE WAMINTGR_LOKI_GPU(CDTPRA, CDATE, CDATEWH, CDTIMP, CDTIMPNEXT, & & BLK2GLO, & & WVENVI, WVPRPT, FF_NOW, FF_NEXT, INTFLDS, & - & WAM2NEMO, MIJ, FL1, XLLWS) + & WAM2NEMO, MIJ, VARS_4D) ! ---------------------------------------------------------------------- @@ -33,17 +33,16 @@ SUBROUTINE WAMINTGR_LOKI_GPU(CDTPRA, CDATE, CDATEWH, CDTIMP, CDTIMPNEXT, & USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU, JWRO USE YOWDRVTYPE , ONLY : WVGRIDGLO, ENVIRONMENT, FREQUENCY, FORCING_FIELDS, & - & INTGT_PARAM_FIELDS, WAVE2OCEAN + & INTGT_PARAM_FIELDS, WAVE2OCEAN, MIJ_TYPE, TYPE_4D USE YOWCOUP , ONLY : LWNEMOCOU, NEMONTAU USE YOWGRID , ONLY : NPROMA_WAM, NCHNK USE YOWPARAM , ONLY : NANG, NFRE USE YOWPCONS , ONLY : EPSMIN USE YOWSTAT , ONLY : CDTPRO, IDELPRO, IDELT, IDELWI, LLSOURCE, TIME_PROPAG, TIME_PHYS, & - & TIME_OFFLOAD + & LUPDATE_GPU_GLOBALS USE YOWWIND , ONLY : CDAWIFL, CDATEWO, CDATEFL -USE YOWFIELD_MOD, ONLY : FREQUENCY_FIELD, ENVIRONMENT_FIELD, FORCING_FIELDS_FIELD, & - & WAVE2OCEAN_FIELD, INTGT_PARAM_FIELDS_FIELD, SOURCE_CONTRIBS_FIELD +USE FIELD_ASYNC_MODULE, ONLY : WAIT_FOR_ASYNC_QUEUE USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK @@ -69,9 +68,8 @@ SUBROUTINE WAMINTGR_LOKI_GPU(CDTPRA, CDATE, CDATEWH, CDTIMP, CDTIMPNEXT, & TYPE(FORCING_FIELDS), INTENT(IN) :: FF_NEXT ! DATA STRUCTURE WITH THE NEXT FORCING FIELDS TYPE(INTGT_PARAM_FIELDS), INTENT(INOUT) :: INTFLDS ! INTEGRATED/DERIVED PARAMETERS TYPE(WAVE2OCEAN), INTENT(INOUT) :: WAM2NEMO ! WAVE FIELDS PASSED TO NEMO -INTEGER(KIND=JWIM), DIMENSION(NPROMA_WAM, NCHNK), INTENT(INOUT) :: MIJ ! LAST FREQUENCY INDEX OF THE PROGNOSTIC RANGE -REAL(KIND=JWRB), DIMENSION(NPROMA_WAM, NANG, NFRE, NCHNK), INTENT(INOUT) :: FL1 -REAL(KIND=JWRB), DIMENSION(NPROMA_WAM, NANG, NFRE, NCHNK), INTENT(INOUT) :: XLLWS ! TOTAL WINDSEA MASK FROM INPUT SOURCE TERM +TYPE(MIJ_TYPE), INTENT(INOUT) :: MIJ +TYPE(TYPE_4D), INTENT(INOUT) :: VARS_4D REAL(KIND=JWRB) :: TIME0 @@ -80,73 +78,7 @@ SUBROUTINE WAMINTGR_LOKI_GPU(CDTPRA, CDATE, CDATEWH, CDTIMP, CDTIMPNEXT, & INTEGER(KIND=JWIM) :: ICHNK INTEGER(KIND=JWIM) :: IDELWH -! Objects to store fields -TYPE(FREQUENCY_FIELD) :: WVPRPT_FIELD -TYPE(ENVIRONMENT_FIELD) :: WVENVI_FIELD -TYPE(FORCING_FIELDS_FIELD) :: FF_NOW_FIELD -TYPE(WAVE2OCEAN_FIELD) :: WAM2NEMO_FIELD -TYPE(INTGT_PARAM_FIELDS_FIELD) :: INTFLDS_FIELD -TYPE(SOURCE_CONTRIBS_FIELD) :: SRC_CONTRIBS - -! DEVICE POINTERS -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: FL1_DPTR(:,:,:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: XLLWS_DPTR(:,:,:,:) => NULL() -INTEGER(KIND=JWIM), POINTER, CONTIGUOUS :: MIJ_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: WAVNUM_DPTR(:,:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: CGROUP_DPTR(:,:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: OMOSNH2KD_DPTR(:,:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: CIWA_DPTR(:,:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: CINV_DPTR(:,:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: XK2CG_DPTR(:,:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: STOKFAC_DPTR(:,:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: EMAXDPT_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: DEPTH_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: DELLAM1_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: COSPHM1_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: UCUR_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: VCUR_DPTR(:,:) => NULL() -INTEGER(KIND=JWIM), POINTER, CONTIGUOUS :: IOBND_DPTR(:,:) => NULL() -INTEGER(KIND=JWIM), POINTER, CONTIGUOUS :: IODP_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: CICOVER_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: WSWAVE_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: WDWAVE_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: AIRD_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: WSTAR_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: UFRIC_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: TAUW_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: TAUWDIR_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: Z0M_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: Z0B_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: CHRNCK_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: CITHICK_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: USTRA_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: VSTRA_DPTR(:,:) => NULL() -REAL(KIND=JWRO), POINTER, CONTIGUOUS :: NEMOUSTOKES_DPTR(:,:) => NULL() -REAL(KIND=JWRO), POINTER, CONTIGUOUS :: NEMOVSTOKES_DPTR(:,:) => NULL() -REAL(KIND=JWRO), POINTER, CONTIGUOUS :: NEMOSTRN_DPTR(:,:) => NULL() -REAL(KIND=JWRO), POINTER, CONTIGUOUS :: NPHIEPS_DPTR(:,:) => NULL() -REAL(KIND=JWRO), POINTER, CONTIGUOUS :: NTAUOC_DPTR(:,:) => NULL() -REAL(KIND=JWRO), POINTER, CONTIGUOUS :: NSWH_DPTR(:,:) => NULL() -REAL(KIND=JWRO), POINTER, CONTIGUOUS :: NMWP_DPTR(:,:) => NULL() -REAL(KIND=JWRO), POINTER, CONTIGUOUS :: NEMOTAUX_DPTR(:,:) => NULL() -REAL(KIND=JWRO), POINTER, CONTIGUOUS :: NEMOTAUY_DPTR(:,:) => NULL() -REAL(KIND=JWRO), POINTER, CONTIGUOUS :: NEMOWSWAVE_DPTR(:,:) => NULL() -REAL(KIND=JWRO), POINTER, CONTIGUOUS :: NEMOPHIF_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: WSEMEAN_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: WSFMEAN_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: USTOKES_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: VSTOKES_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: STRNMS_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: TAUXD_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: TAUYD_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: TAUOCXD_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: TAUOCYD_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: TAUOC_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: PHIOCD_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: PHIEPS_DPTR(:,:) => NULL() -REAL(KIND=JWRB), POINTER, CONTIGUOUS :: PHIAW_DPTR(:,:) => NULL() - -REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE, ZHOOK_HANDLE_IMPLSCH, ZHOOK_HANDLE_DATA_OFFLOAD LOGICAL, SAVE :: LLNEWFILE @@ -160,20 +92,26 @@ SUBROUTINE WAMINTGR_LOKI_GPU(CDTPRA, CDATE, CDATEWH, CDTIMP, CDTIMPNEXT, & !* PROPAGATION TIME ! ---------------- -TIME0=-WAM_USER_CLOCK() -CALL SRC_CONTRIBS%INIT(FL1=FL1) -CALL SRC_CONTRIBS%UPDATE_DEVICE(FL1=FL1_DPTR) -CALL WVPRPT_FIELD%INIT(WAVNUM=WVPRPT%WAVNUM, CGROUP=WVPRPT%CGROUP, OMOSNH2KD=WVPRPT%OMOSNH2KD) -CALL WVPRPT_FIELD%UPDATE_DEVICE(WAVNUM=WAVNUM_DPTR, CGROUP=CGROUP_DPTR, OMOSNH2KD=OMOSNH2KD_DPTR) -CALL WVENVI_FIELD%INIT(DEPTH=WVENVI%DEPTH, DELLAM1=WVENVI%DELLAM1, COSPHM1=WVENVI%COSPHM1, UCUR=WVENVI%UCUR, VCUR=WVENVI%VCUR) -CALL WVENVI_FIELD%UPDATE_DEVICE(DEPTH=DEPTH_DPTR, DELLAM1=DELLAM1_DPTR, COSPHM1=COSPHM1_DPTR, UCUR=UCUR_DPTR, VCUR=VCUR_DPTR) -TIME_OFFLOAD = TIME_OFFLOAD + (TIME0+WAM_USER_CLOCK())*1.E-06 -!$acc data present(FL1_DPTR, WAVNUM_DPTR, CGROUP_DPTR, OMOSNH2KD_DPTR, DEPTH_DPTR, DELLAM1_DPTR, COSPHM1_DPTR, UCUR_DPTR, VCUR_DPTR) +IF(LUPDATE_GPU_GLOBALS)THEN +!$loki update_device +ENDIF + +IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',0,ZHOOK_HANDLE_DATA_OFFLOAD) +CALL WAIT_FOR_ASYNC_QUEUE(QUEUE=0) +CALL VARS_4D%F_FL1%GET_DEVICE_DATA_RDWR(VARS_4D%FL1) +!$acc enter data attach(VARS_4D%FL1) +CALL WVPRPT%GET_DEVICE_DATA_RDWR() +CALL WVENVI%GET_DEVICE_DATA_RDWR(DEPTH=.TRUE., DELLAM1=.TRUE., COSPHM1=.TRUE., UCUR=.TRUE., VCUR=.TRUE., & +& EMAXDPT=.TRUE., IOBND=.TRUE., IODP=.TRUE.) +CALL BLK2GLO%GET_DEVICE_DATA_RDONLY() +IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',1,ZHOOK_HANDLE_DATA_OFFLOAD) + +!$acc data present(VARS_4D, WVPRPT, WVENVI, BLK2GLO) IF (CDATE == CDTPRA) THEN TIME0=-WAM_USER_CLOCK() - CALL PROPAG_WAM(BLK2GLO, WAVNUM_DPTR, CGROUP_DPTR, OMOSNH2KD_DPTR, FL1_DPTR,& -& DEPTH_DPTR, DELLAM1_DPTR, COSPHM1_DPTR, UCUR_DPTR, VCUR_DPTR) + CALL PROPAG_WAM(BLK2GLO, WVPRPT%WAVNUM, WVPRPT%CGROUP, WVPRPT%OMOSNH2KD, VARS_4D%FL1,& +& WVENVI%DEPTH, WVENVI%DELLAM1, WVENVI%COSPHM1, WVENVI%UCUR, WVENVI%VCUR) TIME_PROPAG = TIME_PROPAG + (TIME0+WAM_USER_CLOCK())*1.E-06 CDATE = CDTPRO ENDIF @@ -181,9 +119,19 @@ SUBROUTINE WAMINTGR_LOKI_GPU(CDTPRA, CDATE, CDATEWH, CDTIMP, CDTIMPNEXT, & !* RETRIEVING NEW FORCING FIELDS IF NEEDED. ! ---------------------------------------- +IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',0,ZHOOK_HANDLE_DATA_OFFLOAD) +CALL WAIT_FOR_ASYNC_QUEUE(QUEUE=1) +CALL FF_NOW%GET_DEVICE_DATA_RDWR(AIRD=.TRUE., WDWAVE=.TRUE., CICOVER=.TRUE., WSWAVE=.TRUE., & +& WSTAR=.TRUE., UFRIC=.TRUE., TAUW=.TRUE., TAUWDIR=.TRUE., Z0M=.TRUE., Z0B=.TRUE., & +& CHRNCK=.TRUE., CITHICK=.TRUE., USTRA=.TRUE., VSTRA=.TRUE.) +CALL FF_NEXT%GET_DEVICE_DATA_RDONLY(AIRD=.TRUE., WDWAVE=.TRUE., CICOVER=.TRUE., WSWAVE=.TRUE., & +& WSTAR=.TRUE., UFRIC=.TRUE., TAUW=.TRUE., TAUWDIR=.TRUE., Z0M=.TRUE., Z0B=.TRUE., & +& CHRNCK=.TRUE., CITHICK=.TRUE., USTRA=.TRUE., VSTRA=.TRUE.) +IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',1,ZHOOK_HANDLE_DATA_OFFLOAD) CALL NEWWIND(CDTIMP, CDATEWH, LLNEWFILE, & & WVPRPT, FF_NOW, FF_NEXT) + ! IT IS TIME TO INTEGRATE THE SOURCE TERMS ! ---------------------------------------- IF (CDATE >= CDTIMPNEXT) THEN @@ -191,102 +139,84 @@ SUBROUTINE WAMINTGR_LOKI_GPU(CDTPRA, CDATE, CDATEWH, CDTIMP, CDTIMPNEXT, & CALL GSTATS(1431,0) IF (LLSOURCE) THEN - TIME0=-WAM_USER_CLOCK() - CALL WVPRPT_FIELD%INIT(CIWA=WVPRPT%CIWA, CINV=WVPRPT%CINV, XK2CG=WVPRPT%XK2CG, & - & STOKFAC=WVPRPT%STOKFAC) - CALL WVENVI_FIELD%INIT(EMAXDPT=WVENVI%EMAXDPT, IOBND=WVENVI%IOBND, IODP=WVENVI%IODP) - CALL FF_NOW_FIELD%INIT(AIRD=FF_NOW%AIRD, WDWAVE=FF_NOW%WDWAVE, CICOVER=FF_NOW%CICOVER, WSWAVE=FF_NOW%WSWAVE, & -& WSTAR=FF_NOW%WSTAR, UFRIC=FF_NOW%UFRIC, TAUW=FF_NOW%TAUW, TAUWDIR=FF_NOW%TAUWDIR, & -& Z0M=FF_NOW%Z0M, Z0B=FF_NOW%Z0B, CHRNCK=FF_NOW%CHRNCK, CITHICK=FF_NOW%CITHICK, USTRA=FF_NOW%USTRA, & -& VSTRA=FF_NOW%VSTRA) - CALL WAM2NEMO_FIELD%INIT(NEMOUSTOKES=WAM2NEMO%NEMOUSTOKES, NEMOVSTOKES=WAM2NEMO%NEMOVSTOKES, NEMOSTRN=WAM2NEMO%NEMOSTRN, & -& NPHIEPS=WAM2NEMO%NPHIEPS, NTAUOC=WAM2NEMO%NTAUOC, NSWH=WAM2NEMO%NSWH, NMWP=WAM2NEMO%NMWP, & -& NEMOTAUX=WAM2NEMO%NEMOTAUX, NEMOTAUY=WAM2NEMO%NEMOTAUY, NEMOWSWAVE=WAM2NEMO%NEMOWSWAVE, & -& NEMOPHIF=WAM2NEMO%NEMOPHIF) - CALL INTFLDS_FIELD%INIT(WSEMEAN=INTFLDS%WSEMEAN, WSFMEAN=INTFLDS%WSFMEAN, USTOKES=INTFLDS%USTOKES, VSTOKES=INTFLDS%VSTOKES, & -& STRNMS=INTFLDS%STRNMS, TAUXD=INTFLDS%TAUXD, TAUYD=INTFLDS%TAUYD, TAUOCXD=INTFLDS%TAUOCXD, & -& TAUOCYD=INTFLDS%TAUOCYD, TAUOC=INTFLDS%TAUOC, PHIOCD=INTFLDS%PHIOCD, PHIEPS=INTFLDS%PHIEPS, & -& PHIAW=INTFLDS%PHIAW) - CALL SRC_CONTRIBS%INIT(XLLWS=XLLWS, MIJ=MIJ) - TIME_OFFLOAD = TIME_OFFLOAD + (TIME0+WAM_USER_CLOCK())*1.E-06 - -!$loki update_device - - CALL WVPRPT_FIELD%UPDATE_DEVICE(CIWA=CIWA_DPTR, CINV=CINV_DPTR, XK2CG=XK2CG_DPTR, & - & STOKFAC=STOKFAC_DPTR) - CALL WVENVI_FIELD%UPDATE_DEVICE(EMAXDPT=EMAXDPT_DPTR, IOBND=IOBND_DPTR, IODP=IODP_DPTR) - CALL FF_NOW_FIELD%UPDATE_DEVICE(AIRD=AIRD_DPTR, WDWAVE=WDWAVE_DPTR, CICOVER=CICOVER_DPTR, WSWAVE=WSWAVE_DPTR, & - & WSTAR=WSTAR_DPTR, UFRIC=UFRIC_DPTR, TAUW=TAUW_DPTR, TAUWDIR=TAUWDIR_DPTR, Z0M=Z0M_DPTR, Z0B=Z0B_DPTR, & - & CHRNCK=CHRNCK_DPTR, CITHICK=CITHICK_DPTR, USTRA=USTRA_DPTR, VSTRA=VSTRA_DPTR) - CALL WAM2NEMO_FIELD%UPDATE_DEVICE(NEMOUSTOKES=NEMOUSTOKES_DPTR, NEMOVSTOKES=NEMOVSTOKES_DPTR, NEMOSTRN=NEMOSTRN_DPTR, & - & NPHIEPS=NPHIEPS_DPTR, NTAUOC=NTAUOC_DPTR, NSWH=NSWH_DPTR, NMWP=NMWP_DPTR, NEMOTAUX=NEMOTAUX_DPTR, & - & NEMOTAUY=NEMOTAUY_DPTR, NEMOWSWAVE=NEMOWSWAVE_DPTR, NEMOPHIF=NEMOPHIF_DPTR) - CALL INTFLDS_FIELD%UPDATE_DEVICE(WSEMEAN=WSEMEAN_DPTR, WSFMEAN=WSFMEAN_DPTR, USTOKES=USTOKES_DPTR, & - & VSTOKES=VSTOKES_DPTR, STRNMS=STRNMS_DPTR, TAUXD=TAUXD_DPTR, TAUYD=TAUYD_DPTR, TAUOCXD=TAUOCXD_DPTR, & - & TAUOCYD=TAUOCYD_DPTR, TAUOC=TAUOC_DPTR, PHIOCD=PHIOCD_DPTR, PHIEPS=PHIEPS_DPTR, PHIAW=PHIAW_DPTR) - CALL SRC_CONTRIBS%UPDATE_DEVICE(XLLWS=XLLWS_DPTR, MIJ=MIJ_DPTR) - -!$loki data - + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',0,ZHOOK_HANDLE_DATA_OFFLOAD) + CALL WAIT_FOR_ASYNC_QUEUE(QUEUE=2) + CALL WAM2NEMO%GET_DEVICE_DATA_RDWR(NEMOUSTOKES=.TRUE., NEMOVSTOKES=.TRUE., NEMOSTRN=.TRUE., & + & NPHIEPS=.TRUE., NTAUOC=.TRUE., NSWH=.TRUE., NMWP=.TRUE., NEMOTAUX=.TRUE., & + & NEMOTAUY=.TRUE., NEMOWSWAVE=.TRUE., NEMOPHIF=.TRUE.) + CALL INTFLDS%GET_DEVICE_DATA_RDWR(WSEMEAN=.TRUE., WSFMEAN=.TRUE., USTOKES=.TRUE., & + & VSTOKES=.TRUE., STRNMS=.TRUE., TAUXD=.TRUE., TAUYD=.TRUE., TAUOCXD=.TRUE., & + & TAUOCYD=.TRUE., TAUOC=.TRUE., PHIOCD=.TRUE., PHIEPS=.TRUE., PHIAW=.TRUE.) + CALL VARS_4D%F_XLLWS%GET_DEVICE_DATA_RDWR(VARS_4D%XLLWS) + !$acc enter data attach(VARS_4D%XLLWS) + CALL MIJ%GET_DEVICE_DATA_RDWR() + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',1,ZHOOK_HANDLE_DATA_OFFLOAD) + + IF (LHOOK) CALL DR_HOOK('IMPLSCH',0,ZHOOK_HANDLE_IMPLSCH) TIME0=-WAM_USER_CLOCK() +!$acc data present(VARS_4D,WVPRPT,WVENVI,FF_NOW,WAM2NEMO,INTFLDS,MIJ) + DO ICHNK=1,NCHNK - CALL IMPLSCH(1, NPROMA_WAM, FL1_DPTR(:,:,:,ICHNK), WAVNUM_DPTR(:,:,ICHNK), & - & CGROUP_DPTR(:,:,ICHNK), CIWA_DPTR(:,:,ICHNK), CINV_DPTR(:,:,ICHNK), & - & XK2CG_DPTR(:,:,ICHNK), STOKFAC_DPTR(:,:,ICHNK), EMAXDPT_DPTR(:,ICHNK), & - & DEPTH_DPTR(:,ICHNK), IOBND_DPTR(:,ICHNK), & - & IODP_DPTR(:,ICHNK), AIRD_DPTR(:,ICHNK), WDWAVE_DPTR(:,ICHNK), & - & CICOVER_DPTR(:,ICHNK), WSWAVE_DPTR(:,ICHNK), WSTAR_DPTR(:,ICHNK), & - & USTRA_DPTR(:,ICHNK), VSTRA_DPTR(:,ICHNK), & - & UFRIC_DPTR(:,ICHNK), TAUW_DPTR(:,ICHNK), TAUWDIR_DPTR(:,ICHNK), & - & Z0M_DPTR(:,ICHNK), Z0B_DPTR(:,ICHNK), CHRNCK_DPTR(:,ICHNK), & - & CITHICK_DPTR(:,ICHNK), NEMOUSTOKES_DPTR(:,ICHNK), NEMOVSTOKES_DPTR(:,ICHNK), & - & NEMOSTRN_DPTR(:,ICHNK), NPHIEPS_DPTR(:,ICHNK), NTAUOC_DPTR(:,ICHNK), & - & NSWH_DPTR(:,ICHNK), NMWP_DPTR(:,ICHNK), NEMOTAUX_DPTR(:,ICHNK), & - & NEMOTAUY_DPTR(:,ICHNK), NEMOWSWAVE_DPTR(:,ICHNK), NEMOPHIF_DPTR(:,ICHNK), & - & WSEMEAN_DPTR(:,ICHNK), WSFMEAN_DPTR(:,ICHNK), USTOKES_DPTR(:,ICHNK), & - & VSTOKES_DPTR(:,ICHNK), STRNMS_DPTR(:,ICHNK), TAUXD_DPTR(:,ICHNK), & - & TAUYD_DPTR(:,ICHNK), TAUOCXD_DPTR(:,ICHNK), TAUOCYD_DPTR(:,ICHNK), & - & TAUOC_DPTR(:,ICHNK), PHIOCD_DPTR(:,ICHNK), PHIEPS_DPTR(:,ICHNK), & - & PHIAW_DPTR(:,ICHNK), MIJ_DPTR(:,ICHNK), XLLWS_DPTR(:,:,:,ICHNK)) + CALL IMPLSCH (1, NPROMA_WAM, VARS_4D%FL1(:,:,:,ICHNK), & + & WVPRPT%WAVNUM(:,:,ICHNK), WVPRPT%CGROUP(:,:,ICHNK), WVPRPT%CIWA(:,:,ICHNK), & + & WVPRPT%CINV(:,:,ICHNK), WVPRPT%XK2CG(:,:,ICHNK), WVPRPT%STOKFAC(:,:,ICHNK), & + & WVENVI%EMAXDPT(:,ICHNK), & + & WVENVI%DEPTH(:,ICHNK), WVENVI%IOBND(:,ICHNK), WVENVI%IODP(:,ICHNK), & + & FF_NOW%AIRD(:,ICHNK), FF_NOW%WDWAVE(:,ICHNK), FF_NOW%CICOVER(:,ICHNK), & + & FF_NOW%WSWAVE(:,ICHNK), FF_NOW%WSTAR(:,ICHNK), & + & FF_NOW%USTRA(:,ICHNK), FF_NOW%VSTRA(:,ICHNK), & + & FF_NOW%UFRIC(:,ICHNK), FF_NOW%TAUW(:,ICHNK), FF_NOW%TAUWDIR(:,ICHNK), & + & FF_NOW%Z0M(:,ICHNK), FF_NOW%Z0B(:,ICHNK), FF_NOW%CHRNCK(:,ICHNK), & + & FF_NOW%CITHICK(:,ICHNK), & + & WAM2NEMO%NEMOUSTOKES(:,ICHNK), WAM2NEMO%NEMOVSTOKES(:,ICHNK), WAM2NEMO%NEMOSTRN(:,ICHNK), & + & WAM2NEMO%NPHIEPS(:,ICHNK), WAM2NEMO%NTAUOC(:,ICHNK), WAM2NEMO%NSWH(:,ICHNK), & + & WAM2NEMO%NMWP(:,ICHNK), WAM2NEMO%NEMOTAUX(:,ICHNK), WAM2NEMO%NEMOTAUY(:,ICHNK), & + & WAM2NEMO%NEMOWSWAVE(:,ICHNK), WAM2NEMO%NEMOPHIF(:,ICHNK), & + & INTFLDS%WSEMEAN(:,ICHNK), INTFLDS%WSFMEAN(:,ICHNK), & + & INTFLDS%USTOKES(:,ICHNK), INTFLDS%VSTOKES(:,ICHNK), INTFLDS%STRNMS(:,ICHNK), & + & INTFLDS%TAUXD(:,ICHNK), INTFLDS%TAUYD(:,ICHNK), INTFLDS%TAUOCXD(:,ICHNK), & + & INTFLDS%TAUOCYD(:,ICHNK), INTFLDS%TAUOC(:,ICHNK), INTFLDS%PHIOCD(:,ICHNK), & + & INTFLDS%PHIEPS(:,ICHNK), INTFLDS%PHIAW(:,ICHNK), & + & MIJ%PTR(:,ICHNK), VARS_4D%XLLWS(:,:,:,ICHNK) ) END DO - TIME_PHYS = TIME_PHYS + (TIME0+WAM_USER_CLOCK())*1.E-06 +!$acc end data -!$loki end data + TIME_PHYS = TIME_PHYS + (TIME0+WAM_USER_CLOCK())*1.E-06 + IF (LHOOK) CALL DR_HOOK('IMPLSCH',1,ZHOOK_HANDLE_IMPLSCH) - TIME0=-WAM_USER_CLOCK() - CALL WVPRPT_FIELD%SYNC_HOST() - CALL WVENVI_FIELD%SYNC_HOST() - CALL FF_NOW_FIELD%SYNC_HOST() - CALL WAM2NEMO_FIELD%SYNC_HOST() - CALL INTFLDS_FIELD%SYNC_HOST() - CALL SRC_CONTRIBS%SYNC_HOST() - TIME_OFFLOAD = TIME_OFFLOAD + (TIME0+WAM_USER_CLOCK())*1.E-06 - -!$loki update_host - CALL WVPRPT_FIELD%FINAL() - CALL WVENVI_FIELD%FINAL() - CALL FF_NOW_FIELD%FINAL() - CALL WAM2NEMO_FIELD%FINAL() - CALL INTFLDS_FIELD%FINAL() - CALL SRC_CONTRIBS%FINAL() + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',0,ZHOOK_HANDLE_DATA_OFFLOAD) + CALL VARS_4D%F_FL1%SYNC_HOST_RDONLY(QUEUE=3) + CALL FF_NOW%SYNC_HOST_RDONLY(QUEUE=3) + CALL WVENVI%SYNC_HOST_RDONLY(QUEUE=4) + CALL WAM2NEMO%SYNC_HOST_RDONLY(QUEUE=5) + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',1,ZHOOK_HANDLE_DATA_OFFLOAD) IF (LWNEMOCOU) NEMONTAU = NEMONTAU + 1 ELSE ! NO SOURCE TERM CONTRIBUTION +#ifdef _OPENACC +!$acc kernels present(MIJ,VARS_4D) +#else !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(ICHNK) +#endif DO ICHNK = 1, NCHNK - MIJ(:,ICHNK) = NFRE - FL1(:,:,:,ICHNK) = MAX(FL1(:,:,:,ICHNK), EPSMIN) - XLLWS(:,:,:,ICHNK) = 0.0_JWRB + MIJ%PTR(:,ICHNK) = NFRE + VARS_4D%FL1(:,:,:,ICHNK) = MAX(VARS_4D%FL1(:,:,:,ICHNK), EPSMIN) + VARS_4D%XLLWS(:,:,:,ICHNK) = 0.0_JWRB ENDDO +#ifdef _OPENACC +!$acc end kernels +#else !$OMP END PARALLEL DO +#endif ENDIF CALL GSTATS(1431,1) + !* UPDATE FORCING FIELDS TIME COUNTER ! ---------------------------------- IF (LLNEWFILE) THEN diff --git a/src/ecwam/wamodel.F90 b/src/ecwam/wamodel.F90 index 77b80c784..a3ff01a68 100644 --- a/src/ecwam/wamodel.F90 +++ b/src/ecwam/wamodel.F90 @@ -9,7 +9,7 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & & WVENVI, WVPRPT, FF_NOW, FF_NEXT, INTFLDS, & - & WAM2NEMO, NEMO2WAM, FL1) + & WAM2NEMO, NEMO2WAM, VARS_4D) ! ---------------------------------------------------------------------- @@ -46,7 +46,8 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU USE YOWDRVTYPE , ONLY : WVGRIDGLO, ENVIRONMENT, FREQUENCY, FORCING_FIELDS, & - & INTGT_PARAM_FIELDS, WAVE2OCEAN, OCEAN2WAVE + & INTGT_PARAM_FIELDS, WAVE2OCEAN, OCEAN2WAVE, TYPE_4D, & + MIJ_TYPE USE YOWCPBO , ONLY : IBOUNC ,GBOUNC , IPOGBO , CBCPREF USE YOWCOUP , ONLY : LWCOU , & @@ -62,7 +63,7 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & & LRSTST0 ,LWAMANOUT USE YOWCURR , ONLY : CDTCUR USE YOWFPBO , ONLY : IBOUNF - USE YOWFRED , ONLY : FR ,TH + USE YOWFRED , ONLY : FR ,TH, WVPRPT_LAND USE YOWGRID , ONLY : NPROMA_WAM, NCHNK USE YOWICE , ONLY : LICERUN ,LMASKICE USE YOWMESPAS, ONLY : LFDBIOOUT, LGRIBOUT , LNOCDIN, LWAVEWIND @@ -73,8 +74,8 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & & IDELWI ,IREST ,IDELRES ,IDELINT , & & CDTBC ,IDELBC , & & IASSI ,MARSTYPE , & - & LLSOURCE ,LANAONLY ,LFRSTFLD ,IREFDATE - USE YOWSPEC, ONLY : NBLKS ,NBLKE + & LLSOURCE ,LANAONLY ,LFRSTFLD ,IREFDATE, LUPDATE_GPU_GLOBALS + USE YOWSPEC, ONLY : NBLKS ,NBLKE, MIJ USE YOWTEST , ONLY : IU06 USE YOWTEXT , ONLY : ICPLEN ,CPATH ,CWI ,LRESTARTED USE YOWUNIT , ONLY : IU02 ,IU19 ,IU20 @@ -85,6 +86,8 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & USE MPL_MODULE, ONLY : MPL_BARRIER USE WAM_MULTIO_MOD, ONLY : WAM_MULTIO_FLUSH USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK + USE YOWABORT , ONLY : WAM_ABORT + USE FIELD_ASYNC_MODULE, ONLY : WAIT_FOR_ASYNC_QUEUE ! ---------------------------------------------------------------------- @@ -101,7 +104,6 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & #include "iwam_get_unit.intfb.h" #include "incdate.intfb.h" #include "outbc.intfb.h" -#include "outbs.intfb.h" #include "outspec.intfb.h" #include "outstep0.intfb.h" #include "savspec.intfb.h" @@ -112,8 +114,10 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & #include "writsta.intfb.h" #ifdef WAM_GPU +#include "outbs_loki_gpu.intfb.h" #include "wamintgr_loki_gpu.intfb.h" #else +#include "outbs.intfb.h" #include "wamintgr.intfb.h" #endif @@ -127,7 +131,7 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & TYPE(INTGT_PARAM_FIELDS), INTENT(INOUT) :: INTFLDS TYPE(WAVE2OCEAN), INTENT(INOUT) :: WAM2NEMO TYPE(OCEAN2WAVE), INTENT(IN) :: NEMO2WAM - REAL(KIND=JWRB), DIMENSION(NPROMA_WAM, NANG, NFRE, NCHNK), INTENT(INOUT) :: FL1 + TYPE(TYPE_4D), INTENT(INOUT) :: VARS_4D INTEGER(KIND=JWIM) :: IJ, K, M, J, IRA, KADV, ICH @@ -135,11 +139,10 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & INTEGER(KIND=JWIM) :: ICHNK INTEGER(KIND=JWIM) :: JSTPNEMO, IDATE, ITIME INTEGER(KIND=JWIM) :: IU04 - INTEGER(KIND=JWIM), DIMENSION(NPROMA_WAM, NCHNK) :: MIJ - REAL(KIND=JPHOOK) :: ZHOOK_HANDLE - REAL(KIND=JWRB), DIMENSION(NPROMA_WAM, MAX(NIPRMOUT,1), NCHNK) :: BOUT - REAL(KIND=JWRB), DIMENSION(NPROMA_WAM, NANG, NFRE, NCHNK) :: XLLWS + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE, ZHOOK_HANDLE_DATA_OFFLOAD, & + & ZHOOK_HANDLE_ADVECTION_LOOP, ZHOOK_HANDLE_IO + REAL(KIND=JWRB), DIMENSION(NPROMA_WAM, NIPRMOUT, NCHNK) :: BOUT CHARACTER(LEN= 2) :: MARSTYPEBAK CHARACTER(LEN=14) :: CDATEWH, CZERO @@ -179,7 +182,7 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & !$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(ICHNK) DO ICHNK = 1, NCHNK CALL UNSETICE(1, NPROMA_WAM, WVENVI%DEPTH(:,ICHNK), WVENVI%EMAXDPT(:,ICHNK), FF_NOW%WDWAVE(:,ICHNK), & - & FF_NOW%WSWAVE(:,ICHNK), FF_NOW%CICOVER(:,ICHNK), FL1(:,:,:,ICHNK) ) + & FF_NOW%WSWAVE(:,ICHNK), FF_NOW%CICOVER(:,ICHNK), VARS_4D%FL1(:,:,:,ICHNK) ) ENDDO !$OMP END PARALLEL DO CALL GSTATS(1236,1) @@ -190,20 +193,44 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & ! ----------------------------------------------- IF (CDTPRO == CDATEA .OR. CDTPRO == CDATEF) THEN CALL OUTSTEP0 (WVENVI, WVPRPT, FF_NOW, INTFLDS, & - & WAM2NEMO, NEMO2WAM, FL1) + & WAM2NEMO, NEMO2WAM, VARS_4D%FL1) ENDIF - !* 1. ADVECTION/PHYSICS TIME LOOP. ! ---------------------------- + IF (LHOOK) CALL DR_HOOK('ADVECTION_LOOP',0,ZHOOK_HANDLE_ADVECTION_LOOP) +#ifdef WAM_GPU + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',0,ZHOOK_HANDLE_DATA_OFFLOAD) + CALL WVPRPT_LAND%SYNC_DEVICE_RDONLY(QUEUE=0) + CALL VARS_4D%F_FL1%SYNC_DEVICE_RDWR(QUEUE=0) + CALL BLK2GLO%SYNC_DEVICE_RDONLY(QUEUE=0) + CALL WVPRPT%SYNC_DEVICE_RDWR(QUEUE=0) + CALL WVENVI%SYNC_DEVICE_RDWR(DEPTH=.TRUE., DELLAM1=.TRUE., COSPHM1=.TRUE., UCUR=.TRUE., VCUR=.TRUE., & + & EMAXDPT=.TRUE., IOBND=.TRUE., IODP=.TRUE., QUEUE=0) + CALL FF_NOW%SYNC_DEVICE_RDWR(AIRD=.TRUE., WDWAVE=.TRUE., CICOVER=.TRUE., WSWAVE=.TRUE., & + & WSTAR=.TRUE., UFRIC=.TRUE., TAUW=.TRUE., TAUWDIR=.TRUE., Z0M=.TRUE., Z0B=.TRUE., & + & CHRNCK=.TRUE., CITHICK=.TRUE., USTRA=.TRUE., VSTRA=.TRUE., QUEUE=1) + CALL FF_NEXT%SYNC_DEVICE_RDONLY(AIRD=.TRUE., WDWAVE=.TRUE., CICOVER=.TRUE., WSWAVE=.TRUE., & + & WSTAR=.TRUE., UFRIC=.TRUE., TAUW=.TRUE., TAUWDIR=.TRUE., Z0M=.TRUE., Z0B=.TRUE., & + & CHRNCK=.TRUE., CITHICK=.TRUE., USTRA=.TRUE., VSTRA=.TRUE., QUEUE=1) + CALL WAM2NEMO%SYNC_DEVICE_RDWR(NEMOUSTOKES=.TRUE., NEMOVSTOKES=.TRUE., NEMOSTRN=.TRUE., & + & NPHIEPS=.TRUE., NTAUOC=.TRUE., NSWH=.TRUE., NMWP=.TRUE., NEMOTAUX=.TRUE., & + & NEMOTAUY=.TRUE., NEMOWSWAVE=.TRUE., NEMOPHIF=.TRUE., QUEUE=2) + CALL INTFLDS%SYNC_DEVICE_RDWR(WSEMEAN=.TRUE., WSFMEAN=.TRUE., USTOKES=.TRUE., & + & VSTOKES=.TRUE., STRNMS=.TRUE., TAUXD=.TRUE., TAUYD=.TRUE., TAUOCXD=.TRUE., & + & TAUOCYD=.TRUE., TAUOC=.TRUE., PHIOCD=.TRUE., PHIEPS=.TRUE., PHIAW=.TRUE., QUEUE=2) + CALL VARS_4D%F_XLLWS%SYNC_DEVICE_RDWR(QUEUE=2) + CALL MIJ%SYNC_DEVICE_RDWR(QUEUE=2) + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',1,ZHOOK_HANDLE_DATA_OFFLOAD) +#endif + ADVECTION : DO KADV = 1,NADV !* 1.1 FIX END DATE OF THIS PROPAGATION STEP AND OUTPUT TIMES. ! ------------------------------------------------------- - CDTPRA = CDTPRO CALL INCDATE(CDTPRO, IDELPRO) @@ -257,12 +284,12 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & CALL WAMINTGR_LOKI_GPU(CDTPRA, CDATE, CDATEWH, CDTIMP, CDTIMPNEXT, & & BLK2GLO, & & WVENVI, WVPRPT, FF_NOW, FF_NEXT, INTFLDS, & - & WAM2NEMO, MIJ, FL1, XLLWS) + & WAM2NEMO, MIJ, VARS_4D) #else CALL WAMINTGR (CDTPRA, CDATE, CDATEWH, CDTIMP, CDTIMPNEXT, & & BLK2GLO, & & WVENVI, WVPRPT, FF_NOW, FF_NEXT, INTFLDS, & - & WAM2NEMO, MIJ, FL1, XLLWS) + & WAM2NEMO, MIJ, VARS_4D) #endif ILOOP = ILOOP +1 ENDDO @@ -288,27 +315,49 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & !NEST (not used at ECMWF) !* 1.4.1 INPUT OF BOUNDARY VALUES. ! ------------------------- - IF (IBOUNF == 1) CALL BOUINPT (IU02, FL1, NBLKS, NBLKE) +#ifdef _OPENACC + IF(IBOUNF == 1)THEN + CALL WAM_ABORT("WAMODEL: IBOUNF==1 NOT SUPPORTED FOR GPU OFFLOAD") + ENDIF +#endif + IF (IBOUNF == 1) CALL BOUINPT (IU02, VARS_4D%FL1, NBLKS, NBLKE) !* 1.4.2 OUTPUT OF BOUNDARY POINTS. ! -------------------------- - IF (IBOUNC == 1) CALL OUTBC (FL1, BLK2GLO, IU19) + IF (IBOUNC == 1) CALL OUTBC (VARS_4D%FL1, BLK2GLO, IU19) !NEST +! 1.6 COMPUTE OUTPUT PARAMETERS FIELDS AND PRINT OUT NORMS +! ---------------------------------------------------- + IF ( (CDTINTT == CDTPRO .OR. LRST) .AND. NIPRMOUT > 0 ) THEN + +#ifdef WAM_GPU + CALL OUTBS_LOKI_GPU (MIJ%PTR, VARS_4D%FL1, VARS_4D%XLLWS, & + & WVPRPT, WVENVI, FF_NOW, INTFLDS, NEMO2WAM, & + & BOUT) +#else + CALL OUTBS (MIJ%PTR, VARS_4D%FL1, VARS_4D%XLLWS, & + & WVPRPT, WVENVI, FF_NOW, INTFLDS, NEMO2WAM, & + & BOUT) +#endif + + ENDIF !* 1.5 POINT OUTPUT (not usually used at ECMWF) ! ---------------------------------------- IF ( NGOUT > 0 .AND. (CDTINTT == CDTPRO .OR. LRST) ) THEN ! OUTPUT POINT SPECTRA (not usually used at ECMWF) - CALL OUTWPSP (FL1, FF_NOW) - ENDIF - +#ifdef WAM_GPU + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',0,ZHOOK_HANDLE_DATA_OFFLOAD) + CALL WAIT_FOR_ASYNC_QUEUE(QUEUE=3) + CALL VARS_4D%F_FL1%GET_HOST_DATA_RDONLY(VARS_4D%FL1) + !$acc exit data detach(VARS_4D%FL1) + CALL FF_NOW%GET_HOST_DATA_RDONLY(AIRD=.TRUE., WDWAVE=.TRUE., CICOVER=.TRUE., WSWAVE=.TRUE., & + & WSTAR=.TRUE., UFRIC=.TRUE., TAUW=.TRUE., TAUWDIR=.TRUE., Z0M=.TRUE., Z0B=.TRUE., & + & CHRNCK=.TRUE., CITHICK=.TRUE., USTRA=.TRUE., VSTRA=.TRUE.) + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',1,ZHOOK_HANDLE_DATA_OFFLOAD) +#endif -! 1.6 COMPUTE OUTPUT PARAMETERS FIELDS AND PRINT OUT NORMS -! ---------------------------------------------------- - IF ( (CDTINTT == CDTPRO .OR. LRST) .AND. NIPRMOUT > 0 ) THEN - CALL OUTBS (MIJ, FL1, XLLWS, & - & WVPRPT, WVENVI, FF_NOW, INTFLDS, NEMO2WAM, & - & BOUT) + CALL OUTWPSP (VARS_4D%FL1, FF_NOW) ENDIF @@ -359,7 +408,18 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & MARSTYPE='an' ENDIF - CALL OUTSPEC(FL1, FF_NOW) +#ifdef WAM_GPU + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',0,ZHOOK_HANDLE_DATA_OFFLOAD) + CALL WAIT_FOR_ASYNC_QUEUE(QUEUE=3) + CALL VARS_4D%F_FL1%GET_HOST_DATA_RDONLY(VARS_4D%FL1) + !$acc exit data detach(VARS_4D%FL1) + CALL FF_NOW%GET_HOST_DATA_RDONLY(AIRD=.TRUE., WDWAVE=.TRUE., CICOVER=.TRUE., WSWAVE=.TRUE., & + & WSTAR=.TRUE., UFRIC=.TRUE., TAUW=.TRUE., TAUWDIR=.TRUE., Z0M=.TRUE., Z0B=.TRUE., & + & CHRNCK=.TRUE., CITHICK=.TRUE., USTRA=.TRUE., VSTRA=.TRUE.) + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',1,ZHOOK_HANDLE_DATA_OFFLOAD) +#endif + + CALL OUTSPEC(VARS_4D%FL1, FF_NOW) LLFLUSH = .TRUE. MARSTYPE=MARSTYPEBAK @@ -372,16 +432,32 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & ! 1.8.2 SAVE RESTART FILES IN PURE BINARY FORM (in needed) ! -------------------------------------- IF ( .NOT.LGRIBOUT .OR. LDWRRE ) THEN +#ifdef WAM_GPU + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',0,ZHOOK_HANDLE_DATA_OFFLOAD) + CALL WAIT_FOR_ASYNC_QUEUE(QUEUE=3) + CALL WAIT_FOR_ASYNC_QUEUE(QUEUE=4) + + CALL VARS_4D%F_FL1%GET_HOST_DATA_RDONLY(VARS_4D%FL1) + !$acc exit data detach(VARS_4D%FL1) + CALL FF_NOW%GET_HOST_DATA_RDONLY(AIRD=.TRUE., WDWAVE=.TRUE., CICOVER=.TRUE., WSWAVE=.TRUE., & + & WSTAR=.TRUE., UFRIC=.TRUE., TAUW=.TRUE., TAUWDIR=.TRUE., Z0M=.TRUE., Z0B=.TRUE., & + & CHRNCK=.TRUE., CITHICK=.TRUE., USTRA=.TRUE., VSTRA=.TRUE.) + CALL WVENVI%GET_HOST_DATA_RDONLY(DEPTH=.TRUE., DELLAM1=.TRUE., COSPHM1=.TRUE., UCUR=.TRUE., VCUR=.TRUE., & + & EMAXDPT=.TRUE., IOBND=.TRUE., IODP=.TRUE.) + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',1,ZHOOK_HANDLE_DATA_OFFLOAD) +#endif + IF (LHOOK) CALL DR_HOOK('IO_TIME',0,ZHOOK_HANDLE_IO) CALL SAVSTRESS(WVENVI, FF_NOW, NBLKS, NBLKE, CDTPRO, CDATEF) WRITE(IU06,*) ' ' WRITE(IU06,*) ' BINARY STRESS FILE DISPOSED AT........ CDTPRO = ', CDTPRO WRITE(IU06,*) ' ' - CALL SAVSPEC(FL1, NBLKS, NBLKE, CDTPRO, CDATEF, CDATER) - WRITE(IU06,*) ' BINARY WAVE SPECTRA DISPOSED AT........ CDTPRO = ', CDTPRO + CALL SAVSPEC(VARS_4D%FL1, NBLKS, NBLKE, CDTPRO, CDATEF, CDATER) + WRITE(IU06,*) ' BINARY WAVE SPECTRA DISPOSED AT........ CDTPRO = ', CDTPRO WRITE(IU06,*) ' ' CALL FLUSH(IU06) + IF (LHOOK) CALL DR_HOOK('IO_TIME',1,ZHOOK_HANDLE_IO) ENDIF @@ -451,7 +527,9 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & MARSTYPE='an' ENDIF + IF (LHOOK) CALL DR_HOOK('IO_TIME',0,ZHOOK_HANDLE_IO) CALL OUTWINT(BOUT) + IF (LHOOK) CALL DR_HOOK('IO_TIME',1,ZHOOK_HANDLE_IO) LLFLUSH = .TRUE. MARSTYPE=MARSTYPEBAK @@ -462,6 +540,17 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & ENDIF +#ifdef WAM_GPU + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',0,ZHOOK_HANDLE_DATA_OFFLOAD) + CALL VARS_4D%F_FL1%SYNC_DEVICE_RDWR(QUEUE=0) + CALL WVENVI%SYNC_DEVICE_RDWR(DEPTH=.TRUE., DELLAM1=.TRUE., COSPHM1=.TRUE., UCUR=.TRUE., VCUR=.TRUE., & + & EMAXDPT=.TRUE., IOBND=.TRUE., IODP=.TRUE., QUEUE=0) + CALL FF_NOW%SYNC_DEVICE_RDWR(AIRD=.TRUE., WDWAVE=.TRUE., CICOVER=.TRUE., WSWAVE=.TRUE., & + & WSTAR=.TRUE., UFRIC=.TRUE., TAUW=.TRUE., TAUWDIR=.TRUE., Z0M=.TRUE., Z0B=.TRUE., & + & CHRNCK=.TRUE., CITHICK=.TRUE., USTRA=.TRUE., VSTRA=.TRUE., QUEUE=1) + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',1,ZHOOK_HANDLE_DATA_OFFLOAD) +#endif + !* 1.10 FLUSH FDB IF IT HAS BEEN USED AND IT IS NOT AN ANALYSIS (it will be done in *wamassi*) ! ------------------------------------------------------- @@ -510,6 +599,16 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & NEMOWSTEP=NEMOWSTEP+1 IF (MOD(NEMOWSTEP,NEMOFRCO) == 0) THEN + +#ifdef WAM_GPU + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',0,ZHOOK_HANDLE_DATA_OFFLOAD) + CALL WAIT_FOR_ASYNC_QUEUE(QUEUE=5) + CALL WAM2NEMO%GET_HOST_DATA_RDONLY(NEMOUSTOKES=.TRUE., NEMOVSTOKES=.TRUE., NEMOSTRN=.TRUE., & + & NPHIEPS=.TRUE., NTAUOC=.TRUE., NSWH=.TRUE., NMWP=.TRUE., NEMOTAUX=.TRUE., & + & NEMOTAUY=.TRUE., NEMOWSWAVE=.TRUE., NEMOPHIF=.TRUE.) + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',1,ZHOOK_HANDLE_DATA_OFFLOAD) +#endif + CALL UPDNEMOFIELDS CALL UPDNEMOSTRESS @@ -521,13 +620,49 @@ SUBROUTINE WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & ENDDO #endif NEMOCSTEP = NEMOCSTEP + NEMONSTEP + +#ifdef WAM_GPU + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',0,ZHOOK_HANDLE_DATA_OFFLOAD) + CALL WAM2NEMO%SYNC_DEVICE_RDWR(NEMOUSTOKES=.TRUE., NEMOVSTOKES=.TRUE., NEMOSTRN=.TRUE., & + & NPHIEPS=.TRUE., NTAUOC=.TRUE., NSWH=.TRUE., NMWP=.TRUE., NEMOTAUX=.TRUE., & + & NEMOTAUY=.TRUE., NEMOWSWAVE=.TRUE., NEMOPHIF=.TRUE., QUEUE=2) + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',1,ZHOOK_HANDLE_DATA_OFFLOAD) +#endif ENDIF ENDIF + LUPDATE_GPU_GLOBALS = .FALSE. !* BRANCHING BACK TO 1.0 FOR NEXT PROPAGATION STEP. ENDDO ADVECTION +#ifdef WAM_GPU + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',0,ZHOOK_HANDLE_DATA_OFFLOAD) + CALL WVPRPT_LAND%GET_HOST_DATA_RDWR() + CALL WVPRPT%GET_HOST_DATA_RDWR() + CALL WVENVI%GET_HOST_DATA_RDWR() + CALL FF_NOW%GET_HOST_DATA_RDWR() + CALL FF_NEXT%GET_HOST_DATA_RDWR() + CALL WAM2NEMO%GET_HOST_DATA_RDWR() + CALL INTFLDS%GET_HOST_DATA_RDWR() + CALL VARS_4D%GET_HOST_DATA_RDWR() + CALL MIJ%GET_HOST_DATA_RDWR() + CALL BLK2GLO%GET_HOST_DATA_RDWR() + + CALL WVPRPT_LAND%DELETE_DEVICE_DATA() + CALL WVPRPT%DELETE_DEVICE_DATA() + CALL WVENVI%DELETE_DEVICE_DATA() + CALL FF_NOW%DELETE_DEVICE_DATA() + CALL FF_NEXT%DELETE_DEVICE_DATA() + CALL WAM2NEMO%DELETE_DEVICE_DATA() + CALL INTFLDS%DELETE_DEVICE_DATA() + CALL VARS_4D%DELETE_DEVICE_DATA() + CALL MIJ%DELETE_DEVICE_DATA() + CALL BLK2GLO%DELETE_DEVICE_DATA() + IF (LHOOK) CALL DR_HOOK('DATA_OFFLOAD',1,ZHOOK_HANDLE_DATA_OFFLOAD) +#endif + IF (LHOOK) CALL DR_HOOK('ADVECTION_LOOP',1,ZHOOK_HANDLE_ADVECTION_LOOP) + IF (LHOOK) CALL DR_HOOK('WAMODEL',1,ZHOOK_HANDLE) END SUBROUTINE WAMODEL diff --git a/src/ecwam/wavemdl.F90 b/src/ecwam/wavemdl.F90 index 63371d55b..546820817 100644 --- a/src/ecwam/wavemdl.F90 +++ b/src/ecwam/wavemdl.F90 @@ -107,7 +107,7 @@ SUBROUTINE WAVEMDL (CBEGDAT, PSTEP, KSTOP, KSTPW, & USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU - USE YOWCOUT , ONLY : CASS ,NASS + USE YOWCOUT , ONLY : CASS ,NASS, LWAMANOUT USE YOWCOUP , ONLY : LWCOU, LWCOU2W, LWCOUHMF, LWFLUX, & & LWCOUNORMS, LLNORMWAMOUT_GLOBAL, LLNORMWAM2IFS, & & KCOUSTEP, LMASK_OUT_NOT_SET, LMASK_TASK_STR, & @@ -136,7 +136,7 @@ SUBROUTINE WAVEMDL (CBEGDAT, PSTEP, KSTOP, KSTPW, & USE YOWTEST , ONLY : IU06 USE YOWWNDG , ONLY : ICODE_CPL USE YOWTEXT , ONLY : LRESTARTED - USE YOWSPEC , ONLY : NSTART ,NEND ,FF_NOW ,FL1 + USE YOWSPEC , ONLY : NSTART ,NEND ,FF_NOW ,VARS_4D USE YOWWIND , ONLY : CDAWIFL ,IUNITW ,CDATEWO ,CDATEFL , & & FF_NEXT , & & NXFFS ,NXFFE ,NYFFS ,NYFFE, & @@ -468,7 +468,7 @@ SUBROUTINE WAVEMDL (CBEGDAT, PSTEP, KSTOP, KSTPW, & & IREAD, & & BLK2GLO, BLK2LOC, & & WVENVI, WVPRPT, FF_NOW, & - & FL1, & + & VARS_4D%FL1, & & NFIELDS, NGPTOTG, NC, NR, & & FIELDS, LWCUR, MASK_IN, PRPLRADI, & & NEMO2WAM) @@ -651,7 +651,7 @@ SUBROUTINE WAVEMDL (CBEGDAT, PSTEP, KSTOP, KSTPW, & CALL WAMODEL (NADV, LDSTOP, LDWRRE, BLK2GLO, & & WVENVI, WVPRPT, FF_NOW, FF_NEXT, INTFLDS, & - & WAM2NEMO, NEMO2WAM, FL1) + & WAM2NEMO, NEMO2WAM, VARS_4D) !* 2.2 DATA ASSIMILATION @@ -676,12 +676,12 @@ SUBROUTINE WAVEMDL (CBEGDAT, PSTEP, KSTOP, KSTPW, & IF ( CDTPRO == CDTASS ) THEN CALL WAMASSI (LDSTOP, LDWRRE, BLK2GLO, & & WVENVI, WVPRPT, FF_NOW, INTFLDS, & - & WAM2NEMO, NEMO2WAM, FL1) + & WAM2NEMO, NEMO2WAM, VARS_4D%FL1) ENDIF ELSEIF ( (.NOT.LWCOU .AND. CDTPRO <= CDATEF ) .OR. (LWCOU .AND. CDTPRO == CDATEF) ) THEN CALL WAMASSI (LDSTOP, LDWRRE, BLK2GLO, & & WVENVI, WVPRPT, FF_NOW, INTFLDS, & - & WAM2NEMO, NEMO2WAM, FL1) + & WAM2NEMO, NEMO2WAM, VARS_4D%FL1) ENDIF ENDIF @@ -1036,6 +1036,11 @@ SUBROUTINE WAVEMDL (CBEGDAT, PSTEP, KSTOP, KSTPW, & ! 4. END OF RUN ? ! ----------- IF (CDATEE == CDTPRO) THEN + IF(LWCOU) THEN + ! Prevent any further output until the namelist is read again. + LWAMANOUT = .FALSE. + WRITE(IU06,*) ' WAVEMDL: NORMAL END OF RUN. OUTPUT IS NOW DISABLED !' + ENDIF CALL MPL_BARRIER(CDSTRING='WAVEMDL: END') CALL FLUSH(IU06) ENDIF diff --git a/src/ecwam/wdirspread.F90 b/src/ecwam/wdirspread.F90 index fc3c4ba42..e80d71ce1 100644 --- a/src/ecwam/wdirspread.F90 +++ b/src/ecwam/wdirspread.F90 @@ -68,18 +68,18 @@ SUBROUTINE WDIRSPREAD (KIJS, KIJL, F, EMEAN, LLPEAKF, WDIRSPRD) #include "scosfl.intfb.h" INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE), INTENT(IN) :: F - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(IN) :: EMEAN + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE), INTENT(IN) :: F + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(IN) :: EMEAN LOGICAL, INTENT(IN) :: LLPEAKF - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: WDIRSPRD + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: WDIRSPRD INTEGER(KIND=JWIM) :: IJ, M - INTEGER(KIND=JWIM), DIMENSION(KIJS:KIJL) :: IFRINDEX + INTEGER(KIND=JWIM), DIMENSION(KIJL) :: IFRINDEX REAL(KIND=JWRB) :: COEF_FR, ONE REAL(KIND=JPHOOK) :: ZHOOK_HANDLE - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: TEMP - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NFRE) :: F1D + REAL(KIND=JWRB), DIMENSION(KIJL) :: TEMP + REAL(KIND=JWRB), DIMENSION(KIJL,NFRE) :: F1D LOGICAL :: LL_HALT_INVALID @@ -89,8 +89,10 @@ SUBROUTINE WDIRSPREAD (KIJS, KIJL, F, EMEAN, LLPEAKF, WDIRSPRD) ! Turn off Floating-Point-Exceptions in this scope to avoid FPE_INVALID in optimized code ! with branch prediction. It is safe to do so as DIV_BY_ZERO is protected. +#ifndef WAM_GPU CALL IEEE_GET_HALTING_MODE(IEEE_INVALID, LL_HALT_INVALID) IF (LL_HALT_INVALID) CALL IEEE_SET_HALTING_MODE(IEEE_INVALID, .FALSE.) +#endif !* 1. INITIALIZE ARRAYS ! ----------------- @@ -104,7 +106,9 @@ SUBROUTINE WDIRSPREAD (KIJS, KIJL, F, EMEAN, LLPEAKF, WDIRSPRD) IF(LLPEAKF) THEN ! COMPUTATION IS BASED ON THE PEAK FREQUENCY + !$loki inline CALL PEAKFRI (KIJS, KIJL, F, IFRINDEX, TEMP, F1D) + !$loki inline CALL SCOSFL (KIJS, KIJL, F, IFRINDEX, WDIRSPRD) DO IJ = KIJS,KIJL IF(TEMP(IJ) > 0.0_JWRB) THEN @@ -118,6 +122,7 @@ SUBROUTINE WDIRSPREAD (KIJS, KIJL, F, EMEAN, LLPEAKF, WDIRSPRD) ! COMPUTATION IS BASED ON THE WHOLE FREQUENCY RANGE DO M = 1,NFRE IFRINDEX=M + !$loki inline CALL SCOSFL (KIJS, KIJL, F, IFRINDEX, TEMP) DO IJ = KIJS,KIJL WDIRSPRD(IJ) = WDIRSPRD(IJ) + TEMP(IJ)*DFIM(M) @@ -148,7 +153,9 @@ SUBROUTINE WDIRSPREAD (KIJS, KIJL, F, EMEAN, LLPEAKF, WDIRSPRD) WDIRSPRD(IJ) = SQRT(2.0_JWRB*(ONE-WDIRSPRD(IJ))) ENDDO +#ifndef WAM_GPU IF (LL_HALT_INVALID) CALL IEEE_SET_HALTING_MODE(IEEE_INVALID, .TRUE.) +#endif IF (LHOOK) CALL DR_HOOK('WDIRSPREAD',1,ZHOOK_HANDLE) diff --git a/src/ecwam/weflux.F90 b/src/ecwam/weflux.F90 index 4b4ce12cc..e32eb7c2c 100644 --- a/src/ecwam/weflux.F90 +++ b/src/ecwam/weflux.F90 @@ -72,21 +72,21 @@ SUBROUTINE WEFLUX (KIJS, KIJL, FL1, CGROUP, & IMPLICIT NONE INTEGER(KIND=JWIM), INTENT(IN) :: KIJS, KIJL - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NANG,NFRE), INTENT(IN) :: FL1 - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL,NFRE), INTENT(IN) :: CGROUP + REAL(KIND=JWRB), DIMENSION(KIJL,NANG,NFRE), INTENT(IN) :: FL1 + REAL(KIND=JWRB), DIMENSION(KIJL,NFRE), INTENT(IN) :: CGROUP INTEGER(KIND=JWIM), INTENT(IN) :: NFRE, NANG REAL(KIND=JWRB), INTENT(IN) :: DELTH REAL(KIND=JWRB), DIMENSION(NFRE), INTENT(IN) :: DFIM REAL(KIND=JWRB), DIMENSION(NANG), INTENT(IN) :: COSTH, SINTH - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL), INTENT(OUT) :: WEFMAG, WEFDIR + REAL(KIND=JWRB), DIMENSION(KIJL), INTENT(OUT) :: WEFMAG, WEFDIR INTEGER(KIND=JWIM) :: IJ, M, K REAL(KIND=JWRB) :: ROG, FCG, DELT REAL(KIND=JPHOOK) :: ZHOOK_HANDLE - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: TEMP, TEMPX, TEMPY - REAL(KIND=JWRB), DIMENSION(KIJS:KIJL) :: WEFX, WEFY + REAL(KIND=JWRB), DIMENSION(KIJL) :: TEMP, TEMPX, TEMPY + REAL(KIND=JWRB), DIMENSION(KIJL) :: WEFX, WEFY ! ! ---------------------------------------------------------------------- diff --git a/src/ecwam/wnfluxes.F90 b/src/ecwam/wnfluxes.F90 index dcd5657b0..303fd78e4 100644 --- a/src/ecwam/wnfluxes.F90 +++ b/src/ecwam/wnfluxes.F90 @@ -112,7 +112,7 @@ SUBROUTINE WNFLUXES (KIJS, KIJL, & REAL(KIND=JWRB), PARAMETER :: C2 = 0.04E-3_JWRB REAL(KIND=JWRB), PARAMETER :: P1 = 1.48_JWRB REAL(KIND=JWRB), PARAMETER :: P2 = -0.21_JWRB - REAL(KIND=JWRB), PARAMETER :: CDMAX = 0.003_JWRB + REAL(KIND=JWRB), PARAMETER :: CDMAX_LOC = 0.003_JWRB REAL(KIND=JWRB), PARAMETER :: EFD_MIN = 0.0625_JWRB ! corresponds to min Hs=1m under sea ice REAL(KIND=JWRB), PARAMETER :: EFD_MAX = 6.25_JWRB ! corresponds to max Hs=10m under sea ice @@ -184,7 +184,7 @@ SUBROUTINE WNFLUXES (KIJS, KIJL, & OOVAL(IJ)=EXP(-MIN((CICOVER(IJ)*CITHRSH_INV)**4,10._JWRB)) ! ADJUST USTAR FOR THE PRESENCE OF SEA ICE U10P = MAX(WSWAVE(IJ),EPSU10) - CD_BULK = MIN((C1 + C2*U10P**P1)*U10P**P2, CDMAX) + CD_BULK = MIN((C1 + C2*U10P**P1)*U10P**P2, CDMAX_LOC) CD_WAVE = (UFRIC(IJ)/U10P)**2 CD_ICE = OOVAL(IJ)*CD_WAVE + (1.0_JWRB-OOVAL(IJ))*CD_BULK USTAR(IJ) = MAX(SQRT(CD_ICE)*U10P,EPSUS) diff --git a/src/ecwam/wsigstar.F90 b/src/ecwam/wsigstar.F90 index 4f05ec584..fca1c9efa 100644 --- a/src/ecwam/wsigstar.F90 +++ b/src/ecwam/wsigstar.F90 @@ -69,7 +69,6 @@ SUBROUTINE WSIGSTAR (KIJS, KIJL, WSWAVE, UFRIC, Z0M, WSTAR, SIG_N) REAL(KIND=JWRB), PARAMETER :: ONETHIRD = 1.0_JWRB/3.0_JWRB REAL(KIND=JWRB), PARAMETER :: SIG_NMAX = 0.9_JWRB ! MAX OF RELATIVE STANDARD DEVIATION OF USTAR - REAL(KIND=JWRB), PARAMETER :: LOG10 = LOG(10.0_JWRB) REAL(KIND=JWRB), PARAMETER :: C1 = 1.03E-3_JWRB REAL(KIND=JWRB), PARAMETER :: C2 = 0.04E-3_JWRB REAL(KIND=JWRB), PARAMETER :: P1 = 1.48_JWRB @@ -77,7 +76,7 @@ SUBROUTINE WSIGSTAR (KIJS, KIJL, WSWAVE, UFRIC, Z0M, WSTAR, SIG_N) REAL(KIND=JWRB) :: ZCHAR, C_D, DC_DDU, SIG_CONV REAL(KIND=JWRB) :: XKAPPAD, U10, C2U10P1, U10P2 - REAL(KIND=JWRB) :: BCD, U10M1, ZN, Z0VIS + REAL(KIND=JWRB) :: BCD_LOC, U10M1, ZN, Z0VIS REAL(KIND=JPHOOK) :: ZHOOK_HANDLE @@ -95,9 +94,9 @@ SUBROUTINE WSIGSTAR (KIJS, KIJL, WSWAVE, UFRIC, Z0M, WSTAR, SIG_N) ZCHAR=G*(Z0M(IJ)-Z0VIS)/MAX(UFRIC(IJ)**2,EPSUS) ZCHAR=MAX(MIN(ZCHAR,ALPHAMAX),ALPHAMIN) - BCD = BCDLIN*SQRT(ZCHAR) - C_D = ACDLIN + BCD * WSWAVE(IJ) - DC_DDU = BCD + BCD_LOC = BCDLIN*SQRT(ZCHAR) + C_D = ACDLIN + BCD_LOC * WSWAVE(IJ) + DC_DDU = BCD_LOC SIG_CONV = 1.0_JWRB + 0.5_JWRB*WSWAVE(IJ)/C_D * DC_DDU SIG_N(IJ) = MIN(SIG_NMAX, SIG_CONV * U10M1*(BG_GUST*UFRIC(IJ)**3 + & & 0.5_JWRB*XKAPPA*WSTAR(IJ)**3)**ONETHIRD ) @@ -115,7 +114,7 @@ SUBROUTINE WSIGSTAR (KIJS, KIJL, WSWAVE, UFRIC, Z0M, WSTAR, SIG_N) ! XKAPPAD=1.0_JWRB/XKAPPA DO IJ=KIJS,KIJL - U10 = UFRIC(IJ)*XKAPPAD*(LOG10-LOG(Z0M(IJ))) + U10 = UFRIC(IJ)*XKAPPAD*(LOG(10.0_JWRB)-LOG(Z0M(IJ))) U10 = MAX(U10,WSPMIN) U10M1=1.0_JWRB/U10 C2U10P1=C2*U10**P1 diff --git a/src/ecwam/wvalloc.F90 b/src/ecwam/wvalloc.F90 index 06d4f6c64..59f62eb29 100644 --- a/src/ecwam/wvalloc.F90 +++ b/src/ecwam/wvalloc.F90 @@ -22,12 +22,13 @@ SUBROUTINE WVALLOC USE YOWPARAM , ONLY : NANG ,NFRE USE YOWPCONS , ONLY : ZMISS USE YOWSHAL , ONLY : WVPRPT - USE YOWSPEC , ONLY : FF_NOW ,FL1 + USE YOWSPEC , ONLY : FF_NOW ,VARS_4D, MIJ USE YOWWIND , ONLY : FF_NEXT USE YOWNEMOFLDS , ONLY : WAM2NEMO, NEMO2WAM USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK + USE FIELD_DEFAULTS_MODULE, ONLY : INIT_PINNED_VALUE ! ---------------------------------------------------------------------- @@ -44,23 +45,31 @@ SUBROUTINE WVALLOC ! 1. ALLOCATE NECESSARY ARRAYS ! ------------------------- - IF (.NOT.ALLOCATED(WVPRPT%WAVNUM))THEN - CALL WVPRPT%ALLOC(NPROMA_WAM, NFRE, NCHNK) - ENDIF +#ifdef WAM_HAVE_CUDA +!.... Enable pinning of fields in page-locked memory + INIT_PINNED_VALUE=.TRUE. +#endif - IF (.NOT.ALLOCATED(FF_NOW%UWND)) THEN - CALL FF_NOW%ALLOC(NPROMA_WAM, NCHNK) + IF (.NOT. WVPRPT%LALLOC)THEN + CALL WVPRPT%ALLOC(UBOUNDS=[NPROMA_WAM, NFRE, NCHNK]) ENDIF - IF (.NOT.ALLOCATED(FL1)) THEN - ALLOCATE(FL1(NPROMA_WAM, NANG, NFRE, NCHNK)) - FL1(:,:,:,:) = 0.0_JWRB + IF (.NOT. FF_NOW%LALLOC) THEN + CALL FF_NOW%ALLOC(UBOUNDS=[NPROMA_WAM, NCHNK]) ENDIF + IF (.NOT. VARS_4D%LALLOC) THEN + CALL VARS_4D%ALLOC(UBOUNDS=[NPROMA_WAM, NANG, NFRE, NCHNK]) + VARS_4D%FL1(:,:,:,:) = 0.0_JWRB + ENDIF + IF(.NOT. MIJ%LALLOC)THEN + CALL MIJ%ALLOC(UBOUNDS=[NPROMA_WAM, NCHNK]) + MIJ%PTR(:,:) = 0.0_JWRB + ENDIF - IF (.NOT.ALLOCATED(INTFLDS%PHIEPS)) THEN - CALL INTFLDS%ALLOC(NPROMA_WAM, NCHNK) + IF (.NOT. INTFLDS%LALLOC) THEN + CALL INTFLDS%ALLOC(UBOUNDS=[NPROMA_WAM, NCHNK]) DO ICHNK=1,NCHNK INTFLDS%PHIEPS(:, ICHNK) = 0.0_JWRB INTFLDS%PHIAW(:, ICHNK) = 0.0_JWRB @@ -73,13 +82,13 @@ SUBROUTINE WVALLOC ENDIF - IF (.NOT.ALLOCATED(FF_NEXT%UWND)) THEN - CALL FF_NEXT%ALLOC(NPROMA_WAM,NCHNK) + IF (.NOT. FF_NEXT%LALLOC) THEN + CALL FF_NEXT%ALLOC(UBOUNDS=[NPROMA_WAM,NCHNK]) ENDIF - IF (.NOT.ALLOCATED(WAM2NEMO%NSWH)) THEN - CALL WAM2NEMO%ALLOC(NPROMA_WAM, NCHNK) + IF (.NOT. WAM2NEMO%LALLOC) THEN + CALL WAM2NEMO%ALLOC(UBOUNDS=[NPROMA_WAM, NCHNK]) DO ICHNK=1,NCHNK WAM2NEMO%NSWH(:,ICHNK) = 0.0_JWRO WAM2NEMO%NMWP(:,ICHNK) = 0.0_JWRO @@ -95,8 +104,8 @@ SUBROUTINE WVALLOC ENDDO ENDIF - IF (.NOT.ALLOCATED(NEMO2WAM%NEMOSST)) THEN - CALL NEMO2WAM%ALLOC(NPROMA_WAM, NCHNK) + IF (.NOT. NEMO2WAM%LALLOC) THEN + CALL NEMO2WAM%ALLOC(UBOUNDS=[NPROMA_WAM, NCHNK]) DO ICHNK=1,NCHNK NEMO2WAM%NEMOSST(:,ICHNK) = 0.0_JWRO NEMO2WAM%NEMOCICOVER(:,ICHNK) = 0.0_JWRO diff --git a/src/ecwam/wvdealloc.F90 b/src/ecwam/wvdealloc.F90 index 584b0d972..8c3c3a1cf 100644 --- a/src/ecwam/wvdealloc.F90 +++ b/src/ecwam/wvdealloc.F90 @@ -28,6 +28,9 @@ SUBROUTINE WVDEALLOC USE YOWMEAN , ONLY : INTFLDS USE YOWWIND , ONLY : FF_NEXT USE YOWGRID , ONLY : NCHNK + USE YOWSPEC , ONLY : FF_NOW ,VARS_4D, MIJ + USE YOWSHAL , ONLY : WVPRPT + USE YOWFRED , ONLY : WVPRPT_LAND USE YOWNEMOFLDS , ONLY : WAM2NEMO, NEMO2WAM @@ -46,23 +49,41 @@ SUBROUTINE WVDEALLOC ! 1. DEALLOCATE NECESSARY ARRAYS ! ------------------------- - IF (ALLOCATED(INTFLDS%PHIEPS)) THEN + IF (INTFLDS%LALLOC) THEN CALL INTFLDS%DEALLOC() ENDIF - IF (ALLOCATED(FF_NEXT%UWND)) THEN + IF (FF_NEXT%LALLOC) THEN CALL FF_NEXT%DEALLOC() ENDIF + IF (FF_NOW%LALLOC) THEN + CALL FF_NOW%DEALLOC() + ENDIF + + IF (VARS_4D%LALLOC) THEN + CALL VARS_4D%DEALLOC() + ENDIF + + IF (WVPRPT%LALLOC)THEN + CALL WVPRPT%DEALLOC() + ENDIF + + IF (WVPRPT_LAND%LALLOC)THEN + CALL WVPRPT_LAND%DEALLOC() + ENDIF + IF (.NOT. LWNEMOCOU) THEN - IF (ALLOCATED(WAM2NEMO%NSWH)) THEN + IF (WAM2NEMO%LALLOC) THEN CALL WAM2NEMO%DEALLOC() ENDIF - IF (ALLOCATED(NEMO2WAM%NEMOSST)) THEN + IF (NEMO2WAM%LALLOC) THEN CALL NEMO2WAM%DEALLOC() ENDIF ENDIF + IF(MIJ%LALLOC) CALL MIJ%DEALLOC() + IF (LHOOK) CALL DR_HOOK('WVDEALLOC',1,ZHOOK_HANDLE) END SUBROUTINE WVDEALLOC diff --git a/src/ecwam/wvwaminit.F90 b/src/ecwam/wvwaminit.F90 index 5a62ad5d0..9a23e3f50 100644 --- a/src/ecwam/wvwaminit.F90 +++ b/src/ecwam/wvwaminit.F90 @@ -44,8 +44,7 @@ SUBROUTINE WVWAMINIT (LLCOUPLED, IULOG, LLRNL, & USE YOWSTAT , ONLY : IPROPAGS USE MPL_MODULE, ONLY : MPL_MYRANK, MPL_NPROC - USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK - USE WAM_INIT_GPU_MOD, ONLY : WAM_INIT_GPU + USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK ! ---------------------------------------------------------------------- IMPLICIT NONE @@ -83,12 +82,6 @@ SUBROUTINE WVWAMINIT (LLCOUPLED, IULOG, LLRNL, & IRANK = MPL_MYRANK() NPROC = MPL_NPROC() -#if defined(WAM_GPU) - CALL WAM_INIT_GPU(IRANK) -#endif - - KTAG = 1 - ! STANDARD OUTPUT UNIT ! -------------------- diff --git a/src/ecwam/wvwaminit1.F90 b/src/ecwam/wvwaminit1.F90 index a2a8052a6..59ddfb5f8 100644 --- a/src/ecwam/wvwaminit1.F90 +++ b/src/ecwam/wvwaminit1.F90 @@ -15,8 +15,6 @@ SUBROUTINE WVWAMINIT1(LDWCOUIFS, LDWCOU2W, LDWCOURNW, LDWCOUHMF, LDWFLUX, LFDBOP ! ---------------------------------------------------------------------- - USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU - USE YOWCOUP , ONLY : LWCOU ,LWCOU2W ,LWCOURNW, LWCOUHMF, LWFLUX USE YOWCOUT , ONLY : LFDB USE YOWMESPAS, ONLY : LFDBIOOUT diff --git a/src/ecwam/yowdrvtype.F90 b/src/ecwam/yowdrvtype.F90 deleted file mode 100644 index 5bdcab16d..000000000 --- a/src/ecwam/yowdrvtype.F90 +++ /dev/null @@ -1,482 +0,0 @@ -! (C) Copyright 1989- ECMWF. -! -! This software is licensed under the terms of the Apache Licence Version 2.0 -! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -! In applying this licence, ECMWF does not waive the privileges and immunities -! granted to it by virtue of its status as an intergovernmental organisation -! nor does it submit to any jurisdiction. -! - - MODULE YOWDRVTYPE - -! DERIVED TYPES DEFINITION: - - USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU, JWRO - - IMPLICIT NONE - -!* ** *VARIABLES DEPENDENT ON GLOBAL GRID POINTS ON STRUCTURED GRID -!!! (ideally this be removed, but currently still need for the propagation halo, and the output of global fields -!!! but also for the wave DA. It should be possible to localise this...) - - TYPE WVGRIDGLO - INTEGER(KIND=JWIM), DIMENSION(:), ALLOCATABLE :: IXLG ! WEST-EAST INDEX FOR A GIVEN IJ - INTEGER(KIND=JWIM), DIMENSION(:), ALLOCATABLE :: KXLT ! NORTH-SOUTH INDEX FOR A GIVEN IJ - CONTAINS - PROCEDURE :: ALLOC=>WVGRIDGLO_ALLOC - PROCEDURE :: DEALLOC=>WVGRIDGLO_DEALLOC - END TYPE WVGRIDGLO - - -!* ** *VARIABLES DEPENDENT ON LOCAL GRID POINTS ON STRUCTURED GRID - - TYPE WVGRIDLOC - INTEGER(KIND=JWIM), DIMENSION(:,:), ALLOCATABLE :: IFROMIJ ! WEST-EAST INDEX FOR A GIVEN IJ (LOCAL VERSION OF IXLG) - INTEGER(KIND=JWIM), DIMENSION(:,:), ALLOCATABLE :: KFROMIJ ! SOUTH-NORTH INDEX FOR A GIVEN IJ (LOCAL VERSION OF KXLT) - INTEGER(KIND=JWIM), DIMENSION(:,:), ALLOCATABLE :: JFROMIJ ! NORTH-SOUTH INDEX FOR A GIVEN IJ (LOCAL VERSION OF NGY-KXLT+1) - CONTAINS - PROCEDURE :: ALLOC=>WVGRIDLOC_ALLOC - PROCEDURE :: DEALLOC=>WVGRIDLOC_DEALLOC - END TYPE WVGRIDLOC - - -!* ** *VARIABLES DEPENDENT ON EARTH GEOMETRY, DEPTH or CURRENTS (but not frequency or direction -! i.e. the environment in which the waves evolve - - TYPE ENVIRONMENT - INTEGER(KIND=JWIM), DIMENSION(:,:), ALLOCATABLE :: INDEP ! DEPTH INDEX FOR A BLOCK. - INTEGER(KIND=JWIM), DIMENSION(:,:), ALLOCATABLE :: IODP ! 0 OVER LAND, 1 OVER SEA. - INTEGER(KIND=JWIM), DIMENSION(:,:), ALLOCATABLE :: IOBND ! 0 OVER BOUNDARY POINTS, 1 OTHERWISE. - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: DELLAM1 ! 1./DELLAM AT BLOCK POINTS. - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: COSPHM1 ! 1./COSPH AT BLOCK POINTS. - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: DEPTH ! WATER DEPTH IN METRES. - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: EMAXDPT ! MAXIMUM WAVE VARIANCE ALLOWED FOR A GIVEN DEPTH - ! EMAXDPT=0.0625*(GAM_B_J*DEPTH)**2 - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: UCUR ! U-COMPONENT OF SURFACE CURRENT (m/s) - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: VCUR ! V-COMPONENT OF SURFACE CURRENT (m/s) - CONTAINS - PROCEDURE :: ALLOC=>ENVIRONMENT_ALLOC - PROCEDURE :: DEALLOC=>ENVIRONMENT_DEALLOC - END TYPE ENVIRONMENT - - -!* ** *VARIABLES DEPENDENT ON FREQUENCY (but not direction) -! i.e. wave properties dependent on water depth or sea ice - - TYPE FREQUENCY - REAL(KIND=JWRB), DIMENSION(:,:,:), ALLOCATABLE :: WAVNUM ! WAVE NUMBER - REAL(KIND=JWRB), DIMENSION(:,:,:), ALLOCATABLE :: CINV ! RECIPROCAL OF THE PHASE VELOCITY (1/c) - REAL(KIND=JWRB), DIMENSION(:,:,:), ALLOCATABLE :: CGROUP ! GROUP SPEED - REAL(KIND=JWRB), DIMENSION(:,:,:), ALLOCATABLE :: XK2CG ! (WAVE NUMBER)**2 * GROUP SPEED - REAL(KIND=JWRB), DIMENSION(:,:,:), ALLOCATABLE :: OMOSNH2KD ! OMEGA / SINH(2KD) - REAL(KIND=JWRB), DIMENSION(:,:,:), ALLOCATABLE :: STOKFAC ! FACTOR TO COMPUTE SURFACE STOKES DRIFT FROM SPECTRUM 2*G*K**2/(OMEGA*TANH(2KD)) - REAL(KIND=JWRB), DIMENSION(:,:,:), ALLOCATABLE :: CIWA ! SEA ICE WAVE ATTENUATION - CONTAINS - PROCEDURE :: ALLOC=>FREQUENCY_ALLOC - PROCEDURE :: DEALLOC=>FREQUENCY_DEALLOC - END TYPE FREQUENCY - - TYPE FREQUENCY_LAND - REAL(KIND=JWRB), DIMENSION(:), ALLOCATABLE :: WAVNUM ! WAVE NUMBER - REAL(KIND=JWRB), DIMENSION(:), ALLOCATABLE :: CINV ! RECIPROCAL OF THE PHASE VELOCITY (1/c) - REAL(KIND=JWRB), DIMENSION(:), ALLOCATABLE :: CGROUP ! GROUP SPEED - REAL(KIND=JWRB), DIMENSION(:), ALLOCATABLE :: XK2CG ! (WAVE NUMBER)**2 * GROUP SPEED - REAL(KIND=JWRB), DIMENSION(:), ALLOCATABLE :: OMOSNH2KD ! OMEGA / SINH(2KD) - REAL(KIND=JWRB), DIMENSION(:), ALLOCATABLE :: STOKFAC ! FACTOR TO COMPUTE SURFACE STOKES DRIFT FROM SPECTRUM 2*G*K**2/(OMEGA*TANH(2KD)) - REAL(KIND=JWRB), DIMENSION(:), ALLOCATABLE :: CIWA ! SEA ICE WAVE ATTENUATION - CONTAINS - PROCEDURE :: ALLOC=>FREQUENCY_LAND_ALLOC - PROCEDURE :: DEALLOC=>FREQUENCY_LAND_DEALLOC - END TYPE FREQUENCY_LAND - -!* ** *VARIABLES USED FOR FORCING INPUT AND COMPUTATIONS. -! See *INIT_FIELDG* for the initialisation - - TYPE FORCING_FIELDS - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: UWND ! U COMPONENT ON WAVE MODEL GRID of - ! 10m wind, or friction velocity or surfact stress - ! See ICODE and ICODE_CPL - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: VWND ! V COMPONENT ON WAVE MODEL GRID of - ! 10m wind, or friction velocity or surfact stress - ! See ICODE and ICODE_CPL - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: AIRD ! AIR DENSITY ON WAVE MODEL GRID - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: WSTAR ! CONVECTIVE VELOCITY ON WAVE MODEL GRID - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: CICOVER ! SEA ICE FRACTION ON WAVE MODEL GRID - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: CITHICK ! SEA ICE THICKNESS ON WAVE MODEL GRID - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: LKFR ! LAKE FRACTION ON WAVE MODEL GRID - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: USTRA ! U-COMPONENT OF THE ATMOSPHERIC STRESS OVER THE OCEAN - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: VSTRA ! V-COMPONENT OF THE ATMOSPHERIC STRESS OVER THE OCEAN - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: UCUR ! U COMPONENT OF CURRENT ON WAVE MODEL GRID - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: VCUR ! V COMPONENT OF CURRENT ON WAVE MODEL GRID - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: WSWAVE ! WIND SPEED (WAVE PARAMETER 245) ON WAVE MODEL GRID - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: WDWAVE ! WIND DIRECTION (WAVE PARAMETER 249) ON WAVE MODEL GRID - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: UFRIC ! FRICTION VELOCITY - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: TAUW ! WAVE INDUCED KINEMATIC STRESS MAGNITUDE - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: TAUWDIR ! WAVE INDUCED KINEMATIC STRESS DIRECTION - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: Z0M ! SURFACE ROUGHNESS LENGTH SCALE - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: Z0B ! BACKGROUND SURFACE ROUGHNESS LENGTH SCALE - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: CHRNCK ! CHARNOCK COEFFICIENT - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: XLON ! LONGITUDE OF FORCING_FIELDS DATA THAT ARE NEEDED (i.e. all local points only !) - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: YLAT ! LATITUDE OF FORCING_FIELDS DATA THAT ARE NEEDED (i.e. all local points only !) - CONTAINS - PROCEDURE :: ALLOC=>FORCING_FIELDS_ALLOC - PROCEDURE :: DEALLOC=>FORCING_FIELDS_DEALLOC - END TYPE FORCING_FIELDS - - -!* ** *VARIABLES USED FOR OUTPUT OF INTEGRATED/DERIVED 2D FIELDS -! SEE *WVALLOC* AND *WVDEALLOC* FOR THEIR MANAGEMENT - - TYPE INTGT_PARAM_FIELDS - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: WSEMEAN ! WINDSEA VARIANCE. - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: WSFMEAN ! WINDSEA MEAN FREQUENCY (1./MEAN PERIOD). - - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: USTOKES ! U-COMP SURFACE STOKES DRIFT. - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: VSTOKES ! V-COMP SURFACE STOKES DRIFT. - - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: PHIEPS ! NORMALIZED ENERGY FLUX TO OCEAN. - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: PHIOCD ! DIMENSIONAL TURBULENT ENERGY FLUX INTO OCEAN. - - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: PHIAW ! NORMALIZED ENERGY FLUX FROM WIND TO WAVES. - - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: TAUOC ! NORMALIZED MOMENTUM FLUX INTO OCEAN. - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: TAUXD ! DIMENSIONAL U-COMPONENT OF MOMENTUM FLUX FROM ATMOSPHERE. - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: TAUYD ! DIMENSIONAL V-COMPONENT OF MOMENTUM FLUX FROM ATMOSPHERE. - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: TAUOCXD ! DIMENSIONAL U-COMPONENT OF MOMENTUM FLUX INTO OCEAN. - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: TAUOCYD ! DIMENSIONAL V-COMPONENT OF MOMENTUM FLUX INTO OCEAN. - - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: STRNMS ! MEAN SQUARE STRAIN INTO THE SEA ICE. - - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: ALTWH ! ALTIMETER WAVE HEIGHT - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: CALTWH ! CORRECTED ALTIMETER WAVE HEIGHT - REAL(KIND=JWRB), DIMENSION(:,:), ALLOCATABLE :: RALTCOR ! ALTIMETER RANGE CORRECTION - CONTAINS - PROCEDURE :: ALLOC=>INTGT_PARAM_FIELDS_ALLOC - PROCEDURE :: DEALLOC=>INTGT_PARAM_FIELDS_DEALLOC - END TYPE INTGT_PARAM_FIELDS - - -!* ** *VARIABLES USED FOR COLLECTING FIELDS PASSED FROM THE WAVES TO THE OCEAN - - TYPE WAVE2OCEAN - REAL(KIND=JWRO), DIMENSION(:,:), ALLOCATABLE :: NSWH ! SIGNIFICANT WAVE HEIGHT - REAL(KIND=JWRO), DIMENSION(:,:), ALLOCATABLE :: NMWP ! MEAN WAVE PERIOD - REAL(KIND=JWRO), DIMENSION(:,:), ALLOCATABLE :: NPHIEPS ! NORMALIZED TURBULENT KINETIC ENERGY FLUX INTO OCEAN - REAL(KIND=JWRO), DIMENSION(:,:), ALLOCATABLE :: NEMOPHIF ! TURBULENT KINETIC ENERGY FLUX INTO THE OCEAN - REAL(KIND=JWRO), DIMENSION(:,:), ALLOCATABLE :: NTAUOC ! NORMALIZED MOMENTUM FLUX INTO OCEAN - REAL(KIND=JWRO), DIMENSION(:,:), ALLOCATABLE :: NEMOTAUX ! U-COMPONENT OF OCEAN STRESS (MOMENTUM FLUX) - REAL(KIND=JWRO), DIMENSION(:,:), ALLOCATABLE :: NEMOTAUY ! V-COMPONENT OF OCEAN STRESS (MOMENTUM FLUX) - REAL(KIND=JWRO), DIMENSION(:,:), ALLOCATABLE :: NEMOUSTOKES! U-COMPONENT OF SURFACE STOKES DRIFT - REAL(KIND=JWRO), DIMENSION(:,:), ALLOCATABLE :: NEMOVSTOKES! V-COMPONENT OF SURFACE STOKES DRIFT - REAL(KIND=JWRO), DIMENSION(:,:), ALLOCATABLE :: NEMOWSWAVE ! WIND SPEED USED TO GENERATE WAVES - REAL(KIND=JWRO), DIMENSION(:,:), ALLOCATABLE :: NEMOSTRN ! SEA ICE MEAN SQUARE WAVE STRAIN - CONTAINS - PROCEDURE :: ALLOC=>WAVE2OCEAN_ALLOC - PROCEDURE :: DEALLOC=>WAVE2OCEAN_DEALLOC - END TYPE WAVE2OCEAN - - -!* ** *VARIABLES USED FOR COLLECTING FIELDS PASSED FROM THE OCEAN TO THE WAVES - - TYPE OCEAN2WAVE - REAL(KIND=JWRO), DIMENSION(:,:), ALLOCATABLE :: NEMOSST ! SEA SURFACE TEMPERATURE - REAL(KIND=JWRO), DIMENSION(:,:), ALLOCATABLE :: NEMOCICOVER ! SEA ICE COVER - REAL(KIND=JWRO), DIMENSION(:,:), ALLOCATABLE :: NEMOCITHICK ! SEA ICE THICKNESS - REAL(KIND=JWRO), DIMENSION(:,:), ALLOCATABLE :: NEMOUCUR ! ZONAL CURRENT - REAL(KIND=JWRO), DIMENSION(:,:), ALLOCATABLE :: NEMOVCUR ! MERIDIONAL CURRENT - CONTAINS - PROCEDURE :: ALLOC=>OCEAN2WAVE_ALLOC - PROCEDURE :: DEALLOC=>OCEAN2WAVE_DEALLOC - END TYPE OCEAN2WAVE - -! ---------------------------------------------------------------------- - CONTAINS - SUBROUTINE WVGRIDGLO_ALLOC(SELF, NIBLO) - CLASS(WVGRIDGLO), INTENT(INOUT) :: SELF - INTEGER(KIND=JWIM), INTENT(IN) :: NIBLO - - ALLOCATE(SELF%IXLG(NIBLO)) - ALLOCATE(SELF%KXLT(NIBLO)) - END SUBROUTINE - - SUBROUTINE WVGRIDGLO_DEALLOC(SELF) - CLASS(WVGRIDGLO), INTENT(INOUT) :: SELF - - DEALLOCATE(SELF%IXLG) - DEALLOCATE(SELF%KXLT) - END SUBROUTINE - - SUBROUTINE WVGRIDLOC_ALLOC(SELF, NPROMA_WAM, NCHNK) - CLASS(WVGRIDLOC), INTENT(INOUT) :: SELF - INTEGER(KIND=JWIM), INTENT(IN) :: NPROMA_WAM, NCHNK - - ALLOCATE(SELF%IFROMIJ(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%JFROMIJ(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%KFROMIJ(NPROMA_WAM, NCHNK)) - END SUBROUTINE - - SUBROUTINE WVGRIDLOC_DEALLOC(SELF) - CLASS(WVGRIDLOC), INTENT(INOUT) :: SELF - - DEALLOCATE(SELF%IFROMIJ) - DEALLOCATE(SELF%JFROMIJ) - DEALLOCATE(SELF%KFROMIJ) - END SUBROUTINE - - SUBROUTINE ENVIRONMENT_ALLOC(SELF, NPROMA_WAM, NCHNK) - CLASS(ENVIRONMENT), INTENT(INOUT) :: SELF - INTEGER(KIND=JWIM), INTENT(IN) :: NPROMA_WAM, NCHNK - - ALLOCATE(SELF%INDEP(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%IODP(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%IOBND(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%DELLAM1(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%COSPHM1(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%DEPTH(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%EMAXDPT(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%UCUR(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%VCUR(NPROMA_WAM, NCHNK)) - END SUBROUTINE - - SUBROUTINE ENVIRONMENT_DEALLOC(SELF) - CLASS(ENVIRONMENT), INTENT(INOUT) :: SELF - - DEALLOCATE(SELF%INDEP) - DEALLOCATE(SELF%IODP) - DEALLOCATE(SELF%IOBND) - DEALLOCATE(SELF%DELLAM1) - DEALLOCATE(SELF%COSPHM1) - DEALLOCATE(SELF%DEPTH) - DEALLOCATE(SELF%EMAXDPT) - DEALLOCATE(SELF%UCUR) - DEALLOCATE(SELF%VCUR) - END SUBROUTINE - - SUBROUTINE FREQUENCY_LAND_ALLOC(SELF, NFRE) - CLASS(FREQUENCY_LAND), INTENT(INOUT) :: SELF - INTEGER(KIND=JWIM), INTENT(IN) :: NFRE - - ALLOCATE(SELF%WAVNUM(NFRE)) - ALLOCATE(SELF%CINV(NFRE)) - ALLOCATE(SELF%CGROUP(NFRE)) - ALLOCATE(SELF%XK2CG(NFRE)) - ALLOCATE(SELF%OMOSNH2KD(NFRE)) - ALLOCATE(SELF%STOKFAC(NFRE)) - ALLOCATE(SELF%CIWA(NFRE)) - END SUBROUTINE - - SUBROUTINE FREQUENCY_LAND_DEALLOC(SELF) - CLASS(FREQUENCY_LAND), INTENT(INOUT) :: SELF - - DEALLOCATE(SELF%WAVNUM) - DEALLOCATE(SELF%CINV) - DEALLOCATE(SELF%CGROUP) - DEALLOCATE(SELF%XK2CG) - DEALLOCATE(SELF%OMOSNH2KD) - DEALLOCATE(SELF%STOKFAC) - DEALLOCATE(SELF%CIWA) - END SUBROUTINE - - SUBROUTINE FREQUENCY_ALLOC(SELF, NPROMA_WAM, NFRE, NCHNK) - CLASS(FREQUENCY), INTENT(INOUT) :: SELF - INTEGER(KIND=JWIM), INTENT(IN) :: NPROMA_WAM, NFRE, NCHNK - - ALLOCATE(SELF%WAVNUM(NPROMA_WAM, NFRE, NCHNK)) - ALLOCATE(SELF%CINV(NPROMA_WAM, NFRE, NCHNK)) - ALLOCATE(SELF%CGROUP(NPROMA_WAM, NFRE, NCHNK)) - ALLOCATE(SELF%XK2CG(NPROMA_WAM, NFRE, NCHNK)) - ALLOCATE(SELF%OMOSNH2KD(NPROMA_WAM, NFRE, NCHNK)) - ALLOCATE(SELF%STOKFAC(NPROMA_WAM, NFRE, NCHNK)) - ALLOCATE(SELF%CIWA(NPROMA_WAM, NFRE, NCHNK)) - END SUBROUTINE - - SUBROUTINE FREQUENCY_DEALLOC(SELF) - CLASS(FREQUENCY), INTENT(INOUT) :: SELF - - DEALLOCATE(SELF%WAVNUM) - DEALLOCATE(SELF%CINV) - DEALLOCATE(SELF%CGROUP) - DEALLOCATE(SELF%XK2CG) - DEALLOCATE(SELF%OMOSNH2KD) - DEALLOCATE(SELF%STOKFAC) - DEALLOCATE(SELF%CIWA) - END SUBROUTINE - - SUBROUTINE FORCING_FIELDS_ALLOC(SELF, NPROMA_WAM, NCHNK, UBND0, UBND1) - CLASS(FORCING_FIELDS), INTENT(INOUT) :: SELF - INTEGER(KIND=JWIM), INTENT(IN) :: NPROMA_WAM, NCHNK - INTEGER(KIND=JWIM), INTENT(IN), OPTIONAL :: UBND0, UBND1 - - IF (PRESENT(UBND0)) THEN - IF (.NOT. PRESENT(UBND1))THEN - ERROR STOP - ENDIF - ALLOCATE(SELF%UWND(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%VWND(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%AIRD(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%WSTAR(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%CICOVER(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%CITHICK(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%LKFR(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%USTRA(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%VSTRA(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%UCUR(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%VCUR(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%WSWAVE(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%WDWAVE(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%UFRIC(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%TAUW(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%TAUWDIR(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%Z0M(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%Z0B(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%CHRNCK(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%XLON(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ALLOCATE(SELF%YLAT(NPROMA_WAM:UBND0, NCHNK:UBND1)) - ELSE - ALLOCATE(SELF%UWND(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%VWND(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%AIRD(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%WSTAR(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%CICOVER(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%CITHICK(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%LKFR(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%USTRA(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%VSTRA(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%UCUR(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%VCUR(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%WSWAVE(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%WDWAVE(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%UFRIC(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%TAUW(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%TAUWDIR(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%Z0M(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%Z0B(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%CHRNCK(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%XLON(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%YLAT(NPROMA_WAM, NCHNK)) - ENDIF - END SUBROUTINE FORCING_FIELDS_ALLOC - - SUBROUTINE FORCING_FIELDS_DEALLOC(SELF) - CLASS(FORCING_FIELDS), INTENT(INOUT) :: SELF - - DEALLOCATE(SELF%UWND) - DEALLOCATE(SELF%VWND) - DEALLOCATE(SELF%AIRD) - DEALLOCATE(SELF%WSTAR) - DEALLOCATE(SELF%CICOVER) - DEALLOCATE(SELF%CITHICK) - DEALLOCATE(SELF%LKFR) - DEALLOCATE(SELF%USTRA) - DEALLOCATE(SELF%VSTRA) - DEALLOCATE(SELF%UCUR) - DEALLOCATE(SELF%VCUR) - DEALLOCATE(SELF%WSWAVE) - DEALLOCATE(SELF%WDWAVE) - DEALLOCATE(SELF%UFRIC) - DEALLOCATE(SELF%TAUW) - DEALLOCATE(SELF%TAUWDIR) - DEALLOCATE(SELF%Z0M) - DEALLOCATE(SELF%Z0B) - DEALLOCATE(SELF%CHRNCK) - DEALLOCATE(SELF%XLON) - DEALLOCATE(SELF%YLAT) - END SUBROUTINE FORCING_FIELDS_DEALLOC - - SUBROUTINE INTGT_PARAM_FIELDS_ALLOC(SELF, NPROMA_WAM, NCHNK) - CLASS(INTGT_PARAM_FIELDS), INTENT(INOUT) :: SELF - INTEGER(KIND=JWIM), INTENT(IN) :: NPROMA_WAM, NCHNK - - ALLOCATE(SELF%WSEMEAN(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%WSFMEAN(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%USTOKES(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%VSTOKES(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%PHIEPS(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%PHIOCD(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%PHIAW(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%TAUOC(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%TAUXD(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%TAUYD(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%TAUOCXD(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%TAUOCYD(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%STRNMS(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%ALTWH(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%CALTWH(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%RALTCOR(NPROMA_WAM, NCHNK)) - END SUBROUTINE INTGT_PARAM_FIELDS_ALLOC - - SUBROUTINE INTGT_PARAM_FIELDS_DEALLOC(SELF) - CLASS(INTGT_PARAM_FIELDS), INTENT(INOUT) :: SELF - - DEALLOCATE(SELF%WSEMEAN) - DEALLOCATE(SELF%WSFMEAN) - DEALLOCATE(SELF%USTOKES) - DEALLOCATE(SELF%VSTOKES) - DEALLOCATE(SELF%PHIEPS) - DEALLOCATE(SELF%PHIOCD) - DEALLOCATE(SELF%PHIAW) - DEALLOCATE(SELF%TAUOC) - DEALLOCATE(SELF%TAUXD) - DEALLOCATE(SELF%TAUYD) - DEALLOCATE(SELF%TAUOCXD) - DEALLOCATE(SELF%TAUOCYD) - DEALLOCATE(SELF%STRNMS) - DEALLOCATE(SELF%ALTWH) - DEALLOCATE(SELF%CALTWH) - DEALLOCATE(SELF%RALTCOR) - END SUBROUTINE INTGT_PARAM_FIELDS_DEALLOC - - SUBROUTINE WAVE2OCEAN_ALLOC(SELF, NPROMA_WAM, NCHNK) - CLASS(WAVE2OCEAN), INTENT(INOUT) :: SELF - INTEGER(KIND=JWIM), INTENT(IN) :: NPROMA_WAM, NCHNK - - ALLOCATE(SELF%NSWH(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%NMWP(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%NPHIEPS(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%NEMOPHIF(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%NTAUOC(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%NEMOTAUX(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%NEMOTAUY(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%NEMOUSTOKES(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%NEMOVSTOKES(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%NEMOWSWAVE(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%NEMOSTRN(NPROMA_WAM, NCHNK)) - END SUBROUTINE WAVE2OCEAN_ALLOC - - SUBROUTINE WAVE2OCEAN_DEALLOC(SELF) - CLASS(WAVE2OCEAN), INTENT(INOUT) :: SELF - - DEALLOCATE(SELF%NSWH) - DEALLOCATE(SELF%NMWP) - DEALLOCATE(SELF%NPHIEPS) - DEALLOCATE(SELF%NEMOPHIF) - DEALLOCATE(SELF%NTAUOC) - DEALLOCATE(SELF%NEMOTAUX) - DEALLOCATE(SELF%NEMOTAUY) - DEALLOCATE(SELF%NEMOUSTOKES) - DEALLOCATE(SELF%NEMOVSTOKES) - DEALLOCATE(SELF%NEMOWSWAVE) - DEALLOCATE(SELF%NEMOSTRN) - END SUBROUTINE WAVE2OCEAN_DEALLOC - - SUBROUTINE OCEAN2WAVE_ALLOC(SELF, NPROMA_WAM, NCHNK) - CLASS(OCEAN2WAVE), INTENT(INOUT) :: SELF - INTEGER(KIND=JWIM), INTENT(IN) :: NPROMA_WAM, NCHNK - - ALLOCATE(SELF%NEMOSST(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%NEMOCICOVER(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%NEMOCITHICK(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%NEMOUCUR(NPROMA_WAM, NCHNK)) - ALLOCATE(SELF%NEMOVCUR(NPROMA_WAM, NCHNK)) - END SUBROUTINE OCEAN2WAVE_ALLOC - - SUBROUTINE OCEAN2WAVE_DEALLOC(SELF) - CLASS(OCEAN2WAVE), INTENT(INOUT) :: SELF - - DEALLOCATE(SELF%NEMOSST) - DEALLOCATE(SELF%NEMOCICOVER) - DEALLOCATE(SELF%NEMOCITHICK) - DEALLOCATE(SELF%NEMOUCUR) - DEALLOCATE(SELF%NEMOVCUR) - END SUBROUTINE OCEAN2WAVE_DEALLOC - END MODULE YOWDRVTYPE diff --git a/src/ecwam/yowdrvtype.fypp b/src/ecwam/yowdrvtype.fypp new file mode 100644 index 000000000..c0635550c --- /dev/null +++ b/src/ecwam/yowdrvtype.fypp @@ -0,0 +1,25 @@ +#! (C) Copyright 2022- ECMWF. +#! +#! This software is licensed under the terms of the Apache Licence Version 2.0 +#! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +#! In applying this licence, ECMWF does not waive the privileges and immunities +#! granted to it by virtue of its status as an intergovernmental organisation +#! nor does it submit to any jurisdiction. +#! +#! +#:mute +#:set f = io.open(os.path.dirname(_THIS_FILE_)+'/yowdrvtype_config.yml') +#:set ymlstring = f.read() +#:set input = ecwam_yaml_reader.yaml.safe_load(ymlstring) +#:set objtypes = input['objtypes'] +$:f.close() +#:endmute +#! +#! +MODULE YOWDRVTYPE + +#:for obj in objtypes + USE ${obj.upper()}$_TYPE_MOD, ONLY : ${obj.upper()}$ +#:endfor + +END MODULE YOWDRVTYPE diff --git a/src/ecwam/yowdrvtype_config.yml b/src/ecwam/yowdrvtype_config.yml new file mode 100644 index 000000000..039c6bf60 --- /dev/null +++ b/src/ecwam/yowdrvtype_config.yml @@ -0,0 +1,59 @@ +# (C) Copyright 2022- ECMWF. +# +# This software is licensed under the terms of the Apache Licence Version 2.0 +# which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +# In applying this licence, ECMWF does not waive the privileges and immunities +# granted to it by virtue of its status as an intergovernmental organisation +# nor does it submit to any jurisdiction. + + +# ecWam derived-types and definitions + +objtypes: + environment: + rank: 2 + types: [int, real] + vars: [[indep, iodp, iobnd], [dellam1, cosphm1, depth, emaxdpt, ucur, vcur]] + frequency: + rank: 3 + types: [real] + vars: [[wavnum, cinv, cgroup, xk2cg, omosnh2kd, stokfac, ciwa]] + forcing_fields: + rank: 2 + types: [real] + vars: [[uwnd, vwnd, aird, wstar, cicover, cithick, lkfr, ustra, vstra, ucur, vcur, wswave, wdwave, + ufric, tauw, tauwdir, z0m, z0b, chrnck, xlon, ylat]] + wave2ocean: + rank: 2 + types: [ocean] + vars: [[nswh, nmwp, nphieps, nemophif, ntauoc, nemotaux, nemotauy, nemoustokes, nemovstokes, + nemostrn, nemowswave]] + intgt_param_fields: + rank: 2 + types: [real] + vars: [[wsemean, wsfmean, ustokes, vstokes, phieps, phiocd, phiaw, tauoc, tauxd, tauyd, + tauocxd, tauocyd, strnms, altwh, caltwh, raltcor]] + wvgridglo: + rank: 1 + types: [int] + vars: [[ixlg, kxlt]] + wvgridloc: + rank: 2 + types: [int] + vars: [[ifromij, kfromij, jfromij]] + frequency_land: + rank: 1 + types: [real] + vars: [[wavnum, cinv, cgroup, xk2cg, omosnh2kd, stokfac, ciwa]] + ocean2wave: + rank: 2 + types: [ocean] + vars: [[nemosst, nemocicover, nemocithick, nemoucur, nemovcur]] + type_4d: + rank: 4 + types: [real] + vars: [[fl1, xllws]] + mij_type: + rank: 2 + types: [int] + vars: [[ptr]] \ No newline at end of file diff --git a/src/ecwam/yowfield_mod.fypp b/src/ecwam/yowfield_mod.fypp deleted file mode 100644 index f93dcf208..000000000 --- a/src/ecwam/yowfield_mod.fypp +++ /dev/null @@ -1,109 +0,0 @@ -#! (C) Copyright 2022- ECMWF. -#! -#! This software is licensed under the terms of the Apache Licence Version 2.0 -#! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -#! In applying this licence, ECMWF does not waive the privileges and immunities -#! granted to it by virtue of its status as an intergovernmental organisation -#! nor does it submit to any jurisdiction. -#! -#! -#:set f = io.open(os.path.dirname(_THIS_FILE_)+'/yowfield_mod_config.yaml') -#:set ymlstring = f.read() -#:set input = ecwam_yaml_reader.yaml.safe_load(ymlstring) -#:set objtypes = input['objtypes'] -#:set objdef = input['objdef'] -#! -#! -MODULE YOWFIELD_MOD - - USE PARKIND_WAVE, ONLY : JWRB, JWIM, JWRO - USE FIELD_MODULE, ONLY : FIELD_3RB, FIELD_2IM, FIELD_2RB, FIELD_3IM, FIELD_4RB, FIELD_4IM, FIELD_2RD, FIELD_2RM - USE FIELD_FACTORY_MODULE, ONLY : FIELD_NEW, FIELD_DELETE - IMPLICIT NONE - -#:for obj in objtypes - TYPE ${obj.upper()}$_FIELD -#ifndef WAM_GPU - #:for var, type, dim in objdef[obj] - #{if type == 'real'}#REAL(KIND=JWRB)#{elif type == 'ocean'}#REAL(KIND=JWRO)#{else}#INTEGER(KIND=JWIM)#{endif}#, DIMENSION(${','.join(':' for _ in range(dim-1))}$), POINTER :: ${var.upper()}$=>NULL() - #:endfor -#endif -#ifdef PARKIND1_SINGLE_NEMO - #:for var, type, dim in objdef[obj] - CLASS(FIELD_${dim}$#{if type == 'int'}#IM#{elif type == 'ocean'}#RM#{else}#RB#{endif}#), POINTER :: F_${var.upper()}$=>NULL() - #:endfor -#else - #:for var, type, dim in objdef[obj] - CLASS(FIELD_${dim}$#{if type == 'int'}#IM#{elif type == 'ocean'}#RD#{else}#RB#{endif}#), POINTER :: F_${var.upper()}$=>NULL() - #:endfor -#endif - CONTAINS - PROCEDURE :: INIT => ${obj.upper()}$_FIELD_INIT - PROCEDURE :: FINAL => ${obj.upper()}$_FINAL -#ifdef WAM_GPU - PROCEDURE :: UPDATE_DEVICE => ${obj.upper()}$_UPDATE_DEVICE - PROCEDURE :: SYNC_HOST => ${obj.upper()}$_SYNC_HOST -#else - PROCEDURE :: UPDATE_VIEW => ${obj.upper()}$_UPDATE_VIEW -#endif - END TYPE ${obj.upper()}$_FIELD - -#:endfor - CONTAINS -#:for obj in objtypes - SUBROUTINE ${obj.upper()}$_FIELD_INIT(SELF, ${', '.join(var[0].upper() for var in objdef[obj])}$) - CLASS(${obj.upper()}$_FIELD), INTENT(INOUT) :: SELF - #:for var, type, dim in objdef[obj] - #{if type == 'real'}#REAL(KIND=JWRB)#{elif type == 'ocean'}#REAL(KIND=JWRO)#{else}#INTEGER(KIND=JWIM)#{endif}#, DIMENSION(${','.join(':' for _ in range(dim))}$), INTENT(IN), OPTIONAL :: ${var.upper()}$ - #:endfor - - #:for var, type, dim in objdef[obj] - IF(PRESENT(${var.upper()}$)) CALL FIELD_NEW(SELF%F_${var.upper()}$, DATA=${var.upper()}$) - #:endfor - END SUBROUTINE ${obj.upper()}$_FIELD_INIT - -#ifdef WAM_GPU - SUBROUTINE ${obj.upper()}$_UPDATE_DEVICE(SELF, ${', '.join(var[0].upper() for var in objdef[obj])}$) - CLASS(${obj.upper()}$_FIELD), INTENT(INOUT) :: SELF - #:for var, type, dim in objdef[obj] - #{if type == 'real'}#REAL(KIND=JWRB)#{elif type == 'ocean'}#REAL(KIND=JWRO)#{else}#INTEGER(KIND=JWIM)#{endif}#, DIMENSION(${','.join(':' for _ in range(dim))}$), INTENT(OUT), POINTER, CONTIGUOUS, OPTIONAL :: ${var.upper()}$ - #:endfor - - #:for var, type, dim in objdef[obj] - IF(PRESENT(${var.upper()}$)) CALL SELF%F_${var.upper()}$%GET_DEVICE_DATA_RDWR(${var.upper()}$) - #:endfor - END SUBROUTINE ${obj.upper()}$_UPDATE_DEVICE - - SUBROUTINE ${obj.upper()}$_SYNC_HOST(SELF) - CLASS(${obj.upper()}$_FIELD), INTENT(INOUT) :: SELF - - #:for var, type, dim in objdef[obj] - IF(ASSOCIATED(SELF%F_${var.upper()}$)) CALL SELF%F_${var.upper()}$%SYNC_HOST_RDWR() - #:endfor - END SUBROUTINE ${obj.upper()}$_SYNC_HOST -#else - SUBROUTINE ${obj.upper()}$_UPDATE_VIEW(SELF, BLOCK_INDEX) - CLASS(${obj.upper()}$_FIELD), INTENT(INOUT) :: SELF - INTEGER(KIND=JWIM), INTENT(IN) :: BLOCK_INDEX - - #:for var, type, dim in objdef[obj] - IF(ASSOCIATED(SELF%F_${var.upper()}$)) SELF%${var.upper()}$ => SELF%F_${var.upper()}$%GET_VIEW(BLOCK_INDEX) - #:endfor - END SUBROUTINE ${obj.upper()}$_UPDATE_VIEW -#endif - - SUBROUTINE ${obj.upper()}$_FINAL(SELF) - CLASS(${obj.upper()}$_FIELD), INTENT(INOUT) :: SELF - - #:for var, type, dim in objdef[obj] - IF(ASSOCIATED(SELF%F_${var.upper()}$))THEN - CALL FIELD_DELETE(SELF%F_${var.upper()}$) - ENDIF - #:endfor - END SUBROUTINE ${obj.upper()}$_FINAL - -#:endfor -END MODULE YOWFIELD_MOD -#:mute -$:f.close() -#:endmute diff --git a/src/ecwam/yowfield_mod_config.yaml b/src/ecwam/yowfield_mod_config.yaml deleted file mode 100644 index 30b889009..000000000 --- a/src/ecwam/yowfield_mod_config.yaml +++ /dev/null @@ -1,93 +0,0 @@ -# (C) Copyright 2022- ECMWF. -# -# This software is licensed under the terms of the Apache Licence Version 2.0 -# which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -# In applying this licence, ECMWF does not waive the privileges and immunities -# granted to it by virtue of its status as an intergovernmental organisation -# nor does it submit to any jurisdiction. - - -# ecWam derived-types and definitions - -objtypes: - - frequency - - environment - - forcing_fields - - wave2ocean - - intgt_param_fields - - source_contribs - -objdef: - environment: - - [indep, int, 2] - - [iodp, int, 2] - - [iobnd, int, 2] - - [dellam1, real, 2] - - [cosphm1, real, 2] - - [depth, real, 2] - - [emaxdpt, real, 2] - - [ucur, real, 2] - - [vcur, real, 2] - frequency: - - [wavnum, real, 3] - - [cinv, real, 3] - - [cgroup, real, 3] - - [xk2cg, real, 3] - - [omosnh2kd, real, 3] - - [stokfac, real, 3] - - [ciwa, real, 3] - forcing_fields: - - [uwnd, real, 2] - - [vwnd, real, 2] - - [aird, real, 2] - - [wstar, real, 2] - - [cicover, real, 2] - - [cithick, real, 2] - - [lkfr, real, 2] - - [ustra, real, 2] - - [vstra, real, 2] - - [ucur, real, 2] - - [vcur, real, 2] - - [wswave, real, 2] - - [wdwave, real, 2] - - [ufric, real, 2] - - [tauw, real, 2] - - [tauwdir, real, 2] - - [z0m, real, 2] - - [z0b, real, 2] - - [chrnck, real, 2] - - [xlon, real, 2] - - [ylat, real, 2] - wave2ocean: - - [nswh, ocean, 2] - - [nmwp, ocean, 2] - - [nphieps, ocean, 2] - - [nemophif, ocean, 2] - - [ntauoc, ocean, 2] - - [nemotaux, ocean, 2] - - [nemotauy, ocean, 2] - - [nemoustokes, ocean, 2] - - [nemovstokes, ocean, 2] - - [nemostrn, ocean, 2] - - [nemowswave, ocean, 2] - intgt_param_fields: - - [wsemean, real, 2] - - [wsfmean, real, 2] - - [ustokes, real, 2] - - [vstokes, real, 2] - - [phieps, real, 2] - - [phiocd, real, 2] - - [phiaw, real, 2] - - [tauoc, real, 2] - - [tauxd, real, 2] - - [tauyd, real, 2] - - [tauocxd, real, 2] - - [tauocyd, real, 2] - - [strnms, real, 2] - - [altwh, real, 2] - - [caltwh, real, 2] - - [raltcor, real, 2] - source_contribs: - - [fl1, real, 4] - - [xllws, real, 4] - - [mij, int, 2] diff --git a/src/ecwam/yowparam.F90 b/src/ecwam/yowparam.F90 index 47e140f73..f8488a29e 100644 --- a/src/ecwam/yowparam.F90 +++ b/src/ecwam/yowparam.F90 @@ -64,6 +64,5 @@ MODULE YOWPARAM ! DONE IN LATITUNAL BANDS ! (like it used to be done). ! ---------------------------------------------------------------------- -!$acc declare create( nang ) !$acc declare create( nfre_red ) END MODULE YOWPARAM diff --git a/src/ecwam/yowpcons.F90 b/src/ecwam/yowpcons.F90 index ea5369f29..23b95d461 100644 --- a/src/ecwam/yowpcons.F90 +++ b/src/ecwam/yowpcons.F90 @@ -66,6 +66,7 @@ MODULE YOWPCONS REAL(KIND=JWRB), PARAMETER :: CDMAX=0.0025_JWRB REAL(KIND=JWRB), PARAMETER :: FM2FP=0.9_JWRB + INTEGER(KIND=JWIM), PARAMETER :: NPMAX=20 !* VARIABLE. TYPE. PURPOSE. ! --------- ------- -------- diff --git a/src/ecwam/yowspec.F90 b/src/ecwam/yowspec.F90 index 6d24c5192..718211f68 100644 --- a/src/ecwam/yowspec.F90 +++ b/src/ecwam/yowspec.F90 @@ -10,7 +10,7 @@ MODULE YOWSPEC USE PARKIND_WAVE, ONLY : JWIM, JWRB, JWRU - USE YOWDRVTYPE, ONLY : FORCING_FIELDS + USE YOWDRVTYPE, ONLY : FORCING_FIELDS, TYPE_4D, MIJ_TYPE IMPLICIT NONE @@ -33,8 +33,8 @@ MODULE YOWSPEC INTEGER(KIND=JWIM), ALLOCATABLE :: IJ2NEWIJ(:) TYPE(FORCING_FIELDS) :: FF_NOW - - REAL(KIND=JWRB), ALLOCATABLE, DIMENSION(:,:,:,:) :: FL1 + TYPE(TYPE_4D) :: VARS_4D + TYPE(MIJ_TYPE) :: MIJ ! *NSTART* INDEX OF THE FIRST POINT OF THE COMPUTATION SUB GRID DOMAIN ! *NEND* INDEX OF THE LAST POINT OF THE COMPUTATION SUB GRID DOMAIN diff --git a/src/ecwam/yowstat.F90 b/src/ecwam/yowstat.F90 index 76b88bd48..57f18e5bf 100644 --- a/src/ecwam/yowstat.F90 +++ b/src/ecwam/yowstat.F90 @@ -86,10 +86,10 @@ MODULE YOWSTAT LOGICAL :: LLSOURCE LOGICAL :: LNSESTART LOGICAL :: LSMSSIG_WAM + LOGICAL :: LUPDATE_GPU_GLOBALS = .TRUE. REAL(KIND=JWRB) :: TIME_PROPAG = 0._JWRB REAL(KIND=JWRB) :: TIME_PHYS = 0._JWRB - REAL(KIND=JWRB) :: TIME_OFFLOAD = 0._JWRB !* VARIABLE. TYPE. PURPOSE. ! --------- ------- -------- diff --git a/src/programs/CMakeLists.txt b/src/programs/CMakeLists.txt index 93e5eb3a6..bcbee52c1 100644 --- a/src/programs/CMakeLists.txt +++ b/src/programs/CMakeLists.txt @@ -22,7 +22,7 @@ foreach( program ecbuild_add_executable( TARGET ${PROJECT_NAME}-${program} SOURCES ${program}.F90 - LIBS ${PROJECT_NAME} ${OpenMP_Fortran_LIBRARIES} $<${HAVE_ACC}:OpenACC::OpenACC_Fortran> + LIBS ${PROJECT_NAME} ${OpenMP_Fortran_LIBRARIES} LINKER_LANGUAGE Fortran ) ecwam_target_compile_definitions_FILENAME(${PROJECT_NAME}-${program}) diff --git a/src/programs/preset.F90 b/src/programs/preset.F90 index fc59e891a..e5259c023 100644 --- a/src/programs/preset.F90 +++ b/src/programs/preset.F90 @@ -102,10 +102,10 @@ PROGRAM preset & IDELPRO ,IDELWI ,IDELWO , & & NENSFNB ,NTOTENS ,NSYSNB ,NMETNB , & & IREFDATE ,ISTREAM ,NLOCGRB ,IREFRA - USE YOWSPEC , ONLY : NSTART ,NEND ,FF_NOW ,FL1 , & + USE YOWSPEC , ONLY : NSTART ,NEND ,FF_NOW ,VARS_4D , & & NBLKS ,NBLKE USE YOWTABL , ONLY : FAC0 ,FAC1 ,FAC2 ,FAC3 , & - & FAK ,FRHF ,DFIMHF , OMEGA ,THH , & + & FAK ,FRHF ,DFIMHF , OMEGA ,THH , & & DFDTH ,IM_P ,IM_M ,TA ,TB , & & TC_QL ,TT_4M ,TT_4P ,TFAKH @@ -379,8 +379,8 @@ PROGRAM preset CALL MCHUNK - IF (ALLOCATED(BLK2LOC%IFROMIJ)) CALL BLK2LOC%DEALLOC() - CALL BLK2LOC%ALLOC(NPROMA_WAM,NCHNK) + IF (BLK2LOC%LALLOC) CALL BLK2LOC%DEALLOC() + CALL BLK2LOC%ALLOC(UBOUNDS=[NPROMA_WAM,NCHNK]) DO ICHNK = 1, NCHNK DO IPRM = 1, NPROMA_WAM @@ -418,8 +418,8 @@ PROGRAM preset CALL MCHUNK - IF (ALLOCATED(BLK2LOC%IFROMIJ)) CALL BLK2LOC%DEALLOC() - CALL BLK2LOC%ALLOC(NPROMA_WAM,NCHNK) + IF (BLK2LOC%LALLOC) CALL BLK2LOC%DEALLOC() + CALL BLK2LOC%ALLOC(UBOUNDS=[NPROMA_WAM,NCHNK]) DO ICHNK = 1, NCHNK DO IPRM = 1, NPROMA_WAM @@ -438,8 +438,8 @@ PROGRAM preset ENDIF - IF (ALLOCATED(WVENVI%UCUR)) CALL WVENVI%DEALLOC() - CALL WVENVI%ALLOC(NPROMA_WAM,NCHNK) + IF (WVENVI%LALLOC) CALL WVENVI%DEALLOC() + CALL WVENVI%ALLOC(UBOUNDS=[NPROMA_WAM,NCHNK]) DO ICHNK = 1, NCHNK DO IPRM = 1, NPROMA_WAM @@ -562,9 +562,9 @@ PROGRAM preset IREAD=1 - IF (.NOT.ALLOCATED(FL1)) ALLOCATE (FL1(NPROMA_WAM,NANG,NFRE,NCHNK)) + IF (.NOT. VARS_4D%LALLOC) CALL VARS_4D%ALLOC(UBOUNDS=[NPROMA_WAM,NANG,NFRE,NCHNK]) - IF (.NOT.ALLOCATED(FF_NOW%UWND)) CALL FF_NOW%ALLOC(NPROMA_WAM,NCHNK) + IF (.NOT. FF_NOW%LALLOC) CALL FF_NOW%ALLOC(UBOUNDS=[NPROMA_WAM,NCHNK]) WSPMIN = 0.0_JWRB DO ICHNK=1,NCHNK @@ -583,9 +583,9 @@ PROGRAM preset FF_NOW%CITHICK(:,ICHNK) = 0.0_JWRB ENDDO - IF (.NOT.ALLOCATED(FF_NEXT%UWND)) CALL FF_NEXT%ALLOC(NPROMA_WAM,NCHNK) + IF (.NOT. FF_NEXT%LALLOC) CALL FF_NEXT%ALLOC(UBOUNDS=[NPROMA_WAM,NCHNK]) - IF (.NOT.ALLOCATED(NEMO2WAM%NEMOSST)) CALL NEMO2WAM%ALLOC(NPROMA_WAM,NCHNK) + IF (.NOT. NEMO2WAM%LALLOC) CALL NEMO2WAM%ALLOC(UBOUNDS=[NPROMA_WAM,NCHNK]) IF (IOPTI > 0 .AND. IOPTI /= 3) THEN @@ -633,7 +633,7 @@ PROGRAM preset DO ICHNK = 1, NCHNK CALL MSTART (IOPTI, FETCH, FRMAX, THETAQ, & & FM, ALFA, GAMMA, SA, SB, & - & 1, NPROMA_WAM, FL1(:,:,:,ICHNK), & + & 1, NPROMA_WAM, VARS_4D%FL1(:,:,:,ICHNK), & & FF_NOW%WSWAVE(:,ICHNK), FF_NOW%WDWAVE(:,ICHNK)) ENDDO !$OMP END PARALLEL DO @@ -647,7 +647,7 @@ PROGRAM preset LLINIALL=.FALSE. LLOCAL=.TRUE. - CALL FIELDG%ALLOC(NXFFS, NYFFS, NXFFE, NYFFE) + IF(.NOT. FIELDG%LALLOC) CALL FIELDG%ALLOC(LBOUNDS=[NXFFS, NYFFS], UBOUNDS=[NXFFE, NYFFE]) CALL INIT_FIELDG(BLK2LOC, LLINIALL, LLOCAL, & & NXFFS, NXFFE, NYFFS, NYFFE, FIELDG) @@ -655,7 +655,7 @@ PROGRAM preset !$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(ICHNK) DO ICHNK = 1, NCHNK CALL MSWELL (1, NPROMA_WAM, BLK2LOC%IFROMIJ(:,ICHNK), BLK2LOC%JFROMIJ(:,ICHNK), NXFFS, NXFFE, NYFFS, & - & NYFFE, FIELDG, FL1(:,:,:,ICHNK) ) + & NYFFE, FIELDG, VARS_4D%FL1(:,:,:,ICHNK) ) ENDDO !$OMP END PARALLEL DO @@ -670,7 +670,7 @@ PROGRAM preset DO K=1,NANG DO IPRM = 1, KIJL4CHNK(ICHNK) IJ = IJFROMCHNK(IPRM, ICHNK) - FL1(IPRM, K, M, ICHNK) = FL1(IPRM, K, M, ICHNK) * IOBPD(K,IJ) + VARS_4D%FL1(IPRM, K, M, ICHNK) = VARS_4D%FL1(IPRM, K, M, ICHNK) * IOBPD(K,IJ) ENDDO ENDDO ENDDO @@ -697,10 +697,10 @@ PROGRAM preset IF (LGRIBOUT) THEN ! THE COLD START SPECTRA WILL BE SAVED AS GRIB FILES. CDTPRO = CDATEA - CALL OUTSPEC(FL1, FF_NOW) + CALL OUTSPEC(VARS_4D%FL1, FF_NOW) ELSE - CALL SAVSPEC(FL1, NBLKS, NBLKE, CDATEA, CDATEA, CDUM) + CALL SAVSPEC(VARS_4D%FL1, NBLKS, NBLKE, CDATEA, CDATEA, CDUM) ENDIF ! ---------------------------------------------------------------------- diff --git a/tests/etopo1_oper_an_fc_O320.yml b/tests/etopo1_oper_an_fc_O320.yml index 5fb504ba0..189dac7f8 100644 --- a/tests/etopo1_oper_an_fc_O320.yml +++ b/tests/etopo1_oper_an_fc_O320.yml @@ -16,7 +16,7 @@ forecast.end: 2023-01-01 06:00:00 begin: ${analysis.begin} end: ${forecast.end} -nproma: 128 +nproma: 64 forcings: file: data/forcings/oper_an_12h_fc_2023010100_36h_O320.grib diff --git a/tests/etopo1_oper_an_fc_O48_cy49r1.yml b/tests/etopo1_oper_an_fc_O48_cy49r1.yml index e3c291dd9..d2e72ee8f 100644 --- a/tests/etopo1_oper_an_fc_O48_cy49r1.yml +++ b/tests/etopo1_oper_an_fc_O48_cy49r1.yml @@ -65,26 +65,26 @@ validation: # initial forecast time - name: swh time: 2023-01-01 00:00:00 - average: 0.1549635093952383E+01 + average: 0.1549602967948428E+01 relative_tolerance: 1.e-14 - hashes: ['0x3FF8CB4E2B142663'] + hashes: ['0x3FF8CB2C7B51F7F3'] - # 6h into forcast + # 6h into forecast - name: swh time: 2023-01-01 06:00:00 - average: 0.1632534159910402E+01 + average: 0.1632571618407789E+01 relative_tolerance: 1.e-14 - hashes: ['0x3FFA1EDC23A6B02A'] + hashes: ['0x3FFA1F036AD70724'] - name: swh time: 2023-01-01 06:00:00 - minimum: 0.1923947545513470E-01 + minimum: 0.1923947543946081E-01 relative_tolerance: 1.e-14 - hashes: ['0x3F93B383577CED1D'] + hashes: ['0x3F93B3835737FDE2'] - name: swh time: 2023-01-01 06:00:00 - maximum: 0.6803348186094509E+01 + maximum: 0.6807117063672941E+01 relative_tolerance: 1.e-14 - hashes: ['0x401B36A0E82A4EAF'] + hashes: ['0x401B3A7CE5421349'] single_precision: @@ -98,16 +98,16 @@ validation: # initial forecast time - name: swh time: 2023-01-01 00:00:00 - average: 0.1549676537513733E+01 + average: 0.1549643278121948E+01 relative_tolerance: 1.e-6 - hashes: ['0x3FF8CB79A0000000'] + hashes: ['0x3FF8CB56C0000000'] - # 6h into forcast + # 6h into forecast - name: swh time: 2023-01-01 06:00:00 - average: 0.1632507443428040E+01 + average: 0.1632542133331299E+01 relative_tolerance: 1.e-6 - hashes: ['0x3FFA1EC020000000'] + hashes: ['0x3FFA1EE480000000'] - name: swh time: 2023-01-01 06:00:00 minimum: 0.1923948153853416E-01 @@ -115,6 +115,6 @@ validation: hashes: ['0x3F93B383C0000000'] - name: swh time: 2023-01-01 06:00:00 - maximum: 0.6803345680236816E+01 + maximum: 0.6807114124298096E+01 relative_tolerance: 1.e-6 - hashes: ['0x401B36A040000000'] + hashes: ['0x401B3A7C20000000']