diff --git a/.github/scripts/verify-targets.sh b/.github/scripts/verify-targets.sh index 240d0ace..24591797 100755 --- a/.github/scripts/verify-targets.sh +++ b/.github/scripts/verify-targets.sh @@ -9,6 +9,10 @@ exit_code=0 # targets=(dwarf-P-cloudMicrophysics-IFSScheme dwarf-cloudsc-fortran dwarf-cloudsc-c) +if [[ "$build_flags" == *"--with-field"* ]] +then + targets+=(dwarf-cloudsc-fortran-field) +fi if [[ "$build_flags" == *"--with-gpu"* ]] then @@ -18,6 +22,10 @@ then then targets+=(dwarf-cloudsc-gpu-claw) fi + if [[ "$build_flags" == *"--with-field"* ]] + then + targets+=(dwarf-cloudsc-gpu-scc-field) + fi if [[ "$build_flags" == *"--with-cuda"* ]] then targets+=(dwarf-cloudsc-gpu-scc-cuf dwarf-cloudsc-gpu-scc-cuf-k-caching) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 0bf31421..a3b4e6c9 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -36,6 +36,9 @@ jobs: - '--with-gpu --with-loki --with-atlas' # Enable Loki, Atlas, and GPU variants - '--with-gpu --with-loki --with-atlas --with-mpi' # Enable Loki, Atlas, and GPU variants with MPI - '--single-precision --with-gpu --with-loki --with-atlas --with-mpi' # Enable Loki, and GPU variants with MPI in a single-precision build + - '--with-field' # Enable Field API CPU variant + - '--with-field --with-mpi' # Enable Field API CPU variant with mpi + - '--single-precision --with-field --with-mpi' # Enable Field API CPU variant with mpi and single-precision pyiface_flag: [''] # Enable the pyiface variant @@ -70,6 +73,26 @@ jobs: io_library_flag: '--with-serialbox' build_flags: '--with-gpu --with-loki --with-cuda --with-atlas' ctest_exclude_pattern: '-gpu-|-scc-|-loki-c|-cuda' # GPU variants don't work on CPU runners, loki-c variant causes SIGFPE + - arch: nvhpc/21.9 + nvhpc_version: 21.9 + io_library_flag: '' + build_flags: '--single-precision --with-gpu --with-loki --with-cuda --with-field' + ctest_exclude_pattern: '-gpu-|-scc-|-loki-c|-cuda' # GPU variants don't work on CPU runners, loki-c variant causes SIGFPE + - arch: nvhpc/21.9 + nvhpc_version: 21.9 + io_library_flag: '--with-serialbox' + build_flags: '--with-gpu --with-loki --with-cuda --with-field' + ctest_exclude_pattern: '-gpu-|-scc-|-loki-c|-cuda' # GPU variants don't work on CPU runners, loki-c variant causes SIGFPE + - arch: nvhpc/21.9 + nvhpc_version: 21.9 + io_library_flag: '' + build_flags: '--single-precision --with-gpu --with-loki --with-cuda --with-field --without-mapped-fields' + ctest_exclude_pattern: '-gpu-|-scc-|-loki-c|-cuda' # GPU variants don't work on CPU runners, loki-c variant causes SIGFPE + - arch: nvhpc/21.9 + nvhpc_version: 21.9 + io_library_flag: '--with-serialbox' + build_flags: '--with-gpu --with-loki --with-cuda --with-field --without-mapped-fields' + ctest_exclude_pattern: '-gpu-|-scc-|-loki-c|-cuda' # GPU variants don't work on CPU runners, loki-c variant causes SIGFPE - arch: nvhpc/23.5 nvhpc_version: 23.5 @@ -91,6 +114,26 @@ jobs: io_library_flag: '--with-serialbox' build_flags: '--with-gpu --with-loki --with-cuda --with-atlas' ctest_exclude_pattern: '-gpu-|-scc-|-loki-c|-loki-sca|-cuda' # GPU variants don't work on CPU runners, loki-c and loki-sca variant causes SIGFPE + - arch: nvhpc/23.5 + nvhpc_version: 23.5 + io_library_flag: '' + build_flags: '--single-precision --with-gpu --with-loki --with-cuda --with-field' + ctest_exclude_pattern: '-gpu-|-scc-|-loki-c|-loki-sca|-cuda' # GPU variants don't work on CPU runners, loki-c and loki-sca variant causes SIGFPE + - arch: nvhpc/23.5 + nvhpc_version: 23.5 + io_library_flag: '--with-serialbox' + build_flags: '--with-gpu --with-loki --with-cuda --with-field' + ctest_exclude_pattern: '-gpu-|-scc-|-loki-c|-loki-sca|-cuda' # GPU variants don't work on CPU runners, loki-c and loki-sca variant causes SIGFPE + - arch: nvhpc/23.5 + nvhpc_version: 23.5 + io_library_flag: '' + build_flags: '--single-precision --with-gpu --with-loki --with-cuda --with-field --without-mapped-fields' + ctest_exclude_pattern: '-gpu-|-scc-|-loki-c|-loki-sca|-cuda' # GPU variants don't work on CPU runners, loki-c and loki-sca variant causes SIGFPE + - arch: nvhpc/23.5 + nvhpc_version: 23.5 + io_library_flag: '--with-serialbox' + build_flags: '--with-gpu --with-loki --with-cuda --with-field --without-mapped-fields' + ctest_exclude_pattern: '-gpu-|-scc-|-loki-c|-loki-sca|-cuda' # GPU variants don't work on CPU runners, loki-c and loki-sca variant causes SIGFPE # Steps represent a sequence of tasks that will be executed as part of the job steps: diff --git a/AUTHORS.md b/AUTHORS.md index e52d1ddc..4a5188f3 100644 --- a/AUTHORS.md +++ b/AUTHORS.md @@ -4,6 +4,7 @@ - P. Bechtold (ECMWF) - S. Brdar (ECMWF) - W. Deconinck (ECMWF) +- J. Ericsson (ECMWF) - R. Forbes (ECMWF) - C. Jakob (ECMWF) - J. Hague (ECMWF) diff --git a/CMakeLists.txt b/CMakeLists.txt index 0fae196c..e81a9366 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -111,12 +111,20 @@ endif() ecbuild_add_option( FEATURE FIELD_API DESCRIPTION "Use field_api to manage GPU data offload and copyback" REQUIRED_PACKAGES "field_api" - CONDITION HAVE_CUDA DEFAULT ON ) ecbuild_find_package( NAME loki ) ecbuild_find_package( NAME atlas ) +ecbuild_add_option( FEATURE FIELD_API_DISABLE_MAPPED_MEMORY + DESCRIPTION "Disable the use of ACC mapped memory in Field API objects" + CONDITION HAVE_FIELD_API AND field_api_HAVE_ACC AND field_api_HAVE_CUDA + DEFAULT OFF ) +if( HAVE_FIELD_API_DISABLE_MAPPED_MEMORY ) + list(APPEND CLOUDSC_DEFINITIONS FIELD_API_DISABLE_MAPPED_MEMORY) +endif() + + # Add option for single-precision builds ecbuild_add_option( FEATURE SINGLE_PRECISION DESCRIPTION "Build CLOUDSC in single precision" DEFAULT OFF diff --git a/README.md b/README.md index 53585853..dc2d48d4 100644 --- a/README.md +++ b/README.md @@ -28,6 +28,9 @@ Balthasar Reuter (balthasar.reuter@ecmwf.int) prototype that validates runs against platform and language-agnostic off-line reference data via HDF5 or the Serialbox package. The kernel code also is slightly cleaner than the original version. +- **dwarf-cloudsc-fortran-field**: A fortran version of CLOUDSC that uses Field API + for the data structures. The intent of this version is to show how + Field API is used in newer versions of the IFS. - **dwarf-cloudsc-c**: Standalone C version of the kernel that has been generated by ECMWF tools. This relies exclusively on the Serialbox validation mechanism. @@ -81,13 +84,18 @@ Balthasar Reuter (balthasar.reuter@ecmwf.int) - **dwarf-cloudsc-gpu-scc-field**: GPU-enabled and optimized version of CLOUDSC that uses the SCC loop layout, and uses [FIELD API](https://github.com/ecmwf-ifs/field_api) (a Fortran library purpose-built for IFS data-structures that facilitates the creation and management of field objects in scientific code) to perform device offload - and copyback. The intent is to demonstrate the explicit use of pinned host memory to speed-up - data transfers, as provided by the shipped prototype implmentation, and - investigate the effect of different data storage allocation layouts. + and copyback. + The field api variant supports modern features of the FIELD API such as *field gangs* that group + multiple fields and allocates them in one larger field, in order to reduce allocations and + data transfers. Field gang support can be enabled at runtime by setting the environment + variable `CLOUDSC_PACKED_STORAGE=ON`. If CUDA is available, then the field api variant also supports + the use of allocating fields in pinned memory. This is enabled by setting the + environemnt variable `CLOUDSC_FIELD_API_PINNED=ON` and will speed up data transfers between host and device. To enable this variant, a suitable CUDA installation is required and the `--with-cuda` flag needs to be passed at the build stage. This variant lets the CUDA runtime - manage temporary arrays and needs a large `NV_ACC_CUDA_HEAPSIZE` - (eg. `NV_ACC_CUDA_HEAPSIZE=8GB` for 160K columns.) + manage temporary arrays and needs a large `NV_ACC_CUDA_HEAPSIZE` (eg. `NV_ACC_CUDA_HEAPSIZE=8GB` for 160K columns.). + It is possible to disable Field API registering fields in the OpenACC data map, by passing the + `--without-mapped-fields` flag at build stage. - **cloudsc-pyiface.py**: a combination of the cloudsc/cloudsc-driver routines of cloudsc-fortran with the uppermost `dwarf` program replaced with a corresponding Python script capable of HDF5 data load and @@ -320,8 +328,9 @@ transfer overheads will dominate timings, and that most supported GPU variants aim to optimise compute kernel timings only. However, a dedicated variant `dwarf-cloudsc-gpu-scc-field` has been added to explore host-side memory pinning, which improves data transfer times -and alternative data layout strategies. By default, this will allocate -each array variable individually in pinned memory. A runtime flag +and alternative data layout strategies. By default, pinned memory is turned off +but can be turned on by setting the environment variable `CLOUDSC_FIELD_API_PINNED=ON`. +This will allocate each array variable individually in pinned memory. A runtime flag `CLOUDSC_PACKED_STORAGE=ON` can be used to enable "packed" storage, where multiple arrays are stored in a single base allocation, eg. diff --git a/bundle.yml b/bundle.yml index d5cfdd3d..2b258fb4 100644 --- a/bundle.yml +++ b/bundle.yml @@ -7,11 +7,12 @@ cmake : > CMAKE_LINK_DEPENDS_NO_SHARED=ON CMAKE_EXPORT_COMPILE_COMMANDS=ON BUILD_serialbox=OFF - BUILD_field_api=OFF BUILD_eckit=OFF BUILD_fckit=OFF BUILD_atlas=OFF + BUILD_field_api=OFF ENABLE_OMP=ON + ENABLE_CUDA=OFF ENABLE_SINGLE_PRECISION=OFF projects : @@ -52,10 +53,11 @@ projects : - field_api : git : https://github.com/ecmwf-ifs/field_api.git - version : v0.3.0 + version : v0.3.3 require : ecbuild cmake : > UTIL_MODULE_PATH=${CMAKE_SOURCE_DIR}/cloudsc-dwarf/src/common/module + FIELD_API_ENABLE_ACC=OFF - fckit : git : https://github.com/ecmwf/fckit @@ -79,7 +81,6 @@ projects : require : ecbuild serialbox loki field_api options : - - toolchain : help : Specify compiler options via supplied toolchain file cmake : CMAKE_TOOLCHAIN_FILE={{value}} @@ -92,9 +93,21 @@ options : ENABLE_DOUBLE_PRECISION=OFF FIELD_API_DEFINITIONS=SINGLE + - with-field-api : + help : Enable Field API variants to be built + cmake : > + BUILD_field_api=ON + ENABLE_CLOUDSC_FORTRAN_FIELD=ON + + - without-mapped-fields : + help : Disables automatic registering of Field API fields in ACC map. + cmake : > + ENABLE_FIELD_API_DISABLE_MAPPED_MEMORY=ON + - with-gpu : help : Enable GPU kernels cmake : > + FIELD_API_ENABLE_ACC=ON ENABLE_CLOUDSC_GPU_SCC=ON ENABLE_CLOUDSC_GPU_SCC_HOIST=ON ENABLE_CLOUDSC_GPU_SCC_K_CACHING=ON @@ -106,7 +119,6 @@ options : ENABLE_CUDA=ON ENABLE_CLOUDSC_GPU_SCC_CUF=ON ENABLE_CLOUDSC_GPU_SCC_CUF_K_CACHING=ON - BUILD_field_api=ON - with-hip : help: Enable GPU kernel variant based on HIP diff --git a/src/cloudsc_fortran/CMakeLists.txt b/src/cloudsc_fortran/CMakeLists.txt index 3719bcfc..9dfaccf0 100644 --- a/src/cloudsc_fortran/CMakeLists.txt +++ b/src/cloudsc_fortran/CMakeLists.txt @@ -12,6 +12,12 @@ ecbuild_add_option( FEATURE CLOUDSC_FORTRAN CONDITION Serialbox_FOUND OR HDF5_FOUND ) +# Define the cloudsc CPU variant +ecbuild_add_option( FEATURE CLOUDSC_FORTRAN_FIELD + DESCRIPTION "Build the field API Fortran version of CLOUDSC using Serialbox" DEFAULT ON + CONDITION HAVE_FIELD_API AND (Serialbox_FOUND OR HDF5_FOUND) +) + if( HAVE_CLOUDSC_FORTRAN ) # Define the binary build target for this variant @@ -73,3 +79,66 @@ if( HAVE_CLOUDSC_FORTRAN ) CONDITION HAVE_OMP AND HAVE_MPI ) endif() + +if( HAVE_CLOUDSC_FORTRAN_FIELD ) + + # Define the binary build target for this variant + ecbuild_add_executable( + TARGET dwarf-cloudsc-fortran-field + SOURCES + dwarf_cloudsc.F90 + cloudsc_driver_field_mod.F90 + cloudsc.F90 + LIBS + cloudsc-common-lib + DEFINITIONS ${CLOUDSC_DEFINITIONS} CLOUDSC_FIELD + ) + + # Create symlink for the input data + if( HAVE_SERIALBOX ) + execute_process(COMMAND ${CMAKE_COMMAND} -E create_symlink + ${CMAKE_CURRENT_SOURCE_DIR}/../../data ${CMAKE_CURRENT_BINARY_DIR}/../../../data ) + endif() + + if( HAVE_HDF5 ) + execute_process(COMMAND ${CMAKE_COMMAND} -E create_symlink + ${CMAKE_CURRENT_SOURCE_DIR}/../../config-files/input.h5 ${CMAKE_CURRENT_BINARY_DIR}/../../../input.h5 ) + execute_process(COMMAND ${CMAKE_COMMAND} -E create_symlink + ${CMAKE_CURRENT_SOURCE_DIR}/../../config-files/reference.h5 ${CMAKE_CURRENT_BINARY_DIR}/../../../reference.h5 ) + endif() + + ecbuild_add_test( + TARGET dwarf-cloudsc-fortran-field-serial + COMMAND bin/dwarf-cloudsc-fortran-field + ARGS 1 100 16 + WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/../../.. + OMP 1 + ) + ecbuild_add_test( + TARGET dwarf-cloudsc-fortran-field-omp + COMMAND bin/dwarf-cloudsc-fortran-field + ARGS 4 100 16 + WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/../../.. + OMP 4 + CONDITION HAVE_OMP + ) + ecbuild_add_test( + TARGET dwarf-cloudsc-fortran-field-mpi + COMMAND bin/dwarf-cloudsc-fortran-field + ARGS 1 100 16 + WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/../../.. + MPI 2 + OMP 1 + CONDITION HAVE_MPI + ) + ecbuild_add_test( + TARGET dwarf-cloudsc-fortran-field-mpi-omp + COMMAND bin/dwarf-cloudsc-fortran-field + ARGS 4 100 16 + WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/../../.. + MPI 2 + OMP 4 + CONDITION HAVE_OMP AND HAVE_MPI + ) +endif() + diff --git a/src/cloudsc_fortran/cloudsc.F90 b/src/cloudsc_fortran/cloudsc.F90 index 17f7144d..4894b630 100644 --- a/src/cloudsc_fortran/cloudsc.F90 +++ b/src/cloudsc_fortran/cloudsc.F90 @@ -11,7 +11,9 @@ SUBROUTINE CLOUDSC & !---input & (KIDIA, KFDIA, KLON, KLEV, & & PTSPHY,& - & PT, PQ, tendency_cml,tendency_tmp,tendency_loc, & + & PT, PQ, & + & PTENDENCY_TMP_T, PTENDENCY_TMP_Q, PTENDENCY_TMP_A, PTENDENCY_TMP_CLD, & + & PTENDENCY_LOC_T, PTENDENCY_LOC_Q, PTENDENCY_LOC_A, PTENDENCY_LOC_CLD, & & PVFA, PVFL, PVFI, PDYNA, PDYNL, PDYNI, & & PHRSW, PHRLW,& & PVERVEL, PAP, PAPH,& @@ -162,9 +164,14 @@ SUBROUTINE CLOUDSC & REAL(KIND=JPRB) ,INTENT(IN) :: PTSPHY ! Physics timestep REAL(KIND=JPRB) ,INTENT(IN) :: PT(KLON,KLEV) ! T at start of callpar REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KLON,KLEV) ! Q at start of callpar -TYPE (STATE_TYPE) , INTENT (IN) :: tendency_cml ! cumulative tendency used for final output -TYPE (STATE_TYPE) , INTENT (IN) :: tendency_tmp ! cumulative tendency used as input -TYPE (STATE_TYPE) , INTENT (OUT) :: tendency_loc ! local tendency from cloud scheme +REAL(KIND=JPRB) ,INTENT(IN) :: PTENDENCY_TMP_T(KLON,KLEV) ! T cumulative tendency +REAL(KIND=JPRB) ,INTENT(IN) :: PTENDENCY_TMP_Q(KLON,KLEV) ! Q cumulative tendency +REAL(KIND=JPRB) ,INTENT(IN) :: PTENDENCY_TMP_A(KLON,KLEV) ! A cumulative tendency +REAL(KIND=JPRB) ,INTENT(IN) :: PTENDENCY_TMP_CLD(KLON,KLEV,NCLV) ! CLD cumulative tendency +REAL(KIND=JPRB) ,INTENT(INOUT) :: PTENDENCY_LOC_T(KLON,KLEV) ! T local output tendency +REAL(KIND=JPRB) ,INTENT(INOUT) :: PTENDENCY_LOC_Q(KLON,KLEV) ! Q local output tendency +REAL(KIND=JPRB) ,INTENT(INOUT) :: PTENDENCY_LOC_A(KLON,KLEV) ! A local output tendency +REAL(KIND=JPRB) ,INTENT(INOUT) :: PTENDENCY_LOC_CLD(KLON,KLEV,NCLV) ! CLD local output tendency REAL(KIND=JPRB) ,INTENT(IN) :: PVFA(KLON,KLEV) ! CC from VDF scheme REAL(KIND=JPRB) ,INTENT(IN) :: PVFL(KLON,KLEV) ! Liq from VDF scheme REAL(KIND=JPRB) ,INTENT(IN) :: PVFI(KLON,KLEV) ! Ice from VDF scheme @@ -621,15 +628,15 @@ SUBROUTINE CLOUDSC & ! ----------------------------------------------- DO JK=1,KLEV DO JL=KIDIA,KFDIA - tendency_loc%T(JL,JK)=0.0_JPRB - tendency_loc%q(JL,JK)=0.0_JPRB - tendency_loc%a(JL,JK)=0.0_JPRB + PTENDENCY_LOC_T(JL,JK)=0.0_JPRB + PTENDENCY_LOC_Q(JL,JK)=0.0_JPRB + PTENDENCY_LOC_A(JL,JK)=0.0_JPRB ENDDO ENDDO DO JM=1,NCLV-1 DO JK=1,KLEV DO JL=KIDIA,KFDIA - tendency_loc%cld(JL,JK,JM)=0.0_JPRB + PTENDENCY_LOC_CLD(JL,JK,JM)=0.0_JPRB ENDDO ENDDO ENDDO @@ -661,11 +668,11 @@ SUBROUTINE CLOUDSC & ! ---------------------- DO JK=1,KLEV DO JL=KIDIA,KFDIA - ZTP1(JL,JK) = PT(JL,JK)+PTSPHY*tendency_tmp%T(JL,JK) - ZQX(JL,JK,NCLDQV) = PQ(JL,JK)+PTSPHY*tendency_tmp%q(JL,JK) - ZQX0(JL,JK,NCLDQV) = PQ(JL,JK)+PTSPHY*tendency_tmp%q(JL,JK) - ZA(JL,JK) = PA(JL,JK)+PTSPHY*tendency_tmp%a(JL,JK) - ZAORIG(JL,JK) = PA(JL,JK)+PTSPHY*tendency_tmp%a(JL,JK) + ZTP1(JL,JK) = PT(JL,JK)+PTSPHY*PTENDENCY_TMP_T(JL,JK) + ZQX(JL,JK,NCLDQV) = PQ(JL,JK)+PTSPHY*PTENDENCY_TMP_Q(JL,JK) + ZQX0(JL,JK,NCLDQV) = PQ(JL,JK)+PTSPHY*PTENDENCY_TMP_Q(JL,JK) + ZA(JL,JK) = PA(JL,JK)+PTSPHY*PTENDENCY_TMP_A(JL,JK) + ZAORIG(JL,JK) = PA(JL,JK)+PTSPHY*PTENDENCY_TMP_A(JL,JK) ENDDO ENDDO @@ -675,8 +682,8 @@ SUBROUTINE CLOUDSC & DO JM=1,NCLV-1 DO JK=1,KLEV DO JL=KIDIA,KFDIA - ZQX(JL,JK,JM) = PCLV(JL,JK,JM)+PTSPHY*tendency_tmp%cld(JL,JK,JM) - ZQX0(JL,JK,JM) = PCLV(JL,JK,JM)+PTSPHY*tendency_tmp%cld(JL,JK,JM) + ZQX(JL,JK,JM) = PCLV(JL,JK,JM)+PTSPHY*PTENDENCY_TMP_CLD(JL,JK,JM) + ZQX0(JL,JK,JM) = PCLV(JL,JK,JM)+PTSPHY*PTENDENCY_TMP_CLD(JL,JK,JM) ENDDO ENDDO ENDDO @@ -700,16 +707,16 @@ SUBROUTINE CLOUDSC & ! Evaporate small cloud liquid water amounts ZLNEG(JL,JK,NCLDQL) = ZLNEG(JL,JK,NCLDQL)+ZQX(JL,JK,NCLDQL) ZQADJ = ZQX(JL,JK,NCLDQL)*ZQTMST - tendency_loc%q(JL,JK) = tendency_loc%q(JL,JK)+ZQADJ - tendency_loc%T(JL,JK) = tendency_loc%T(JL,JK)-RALVDCP*ZQADJ + PTENDENCY_LOC_Q(JL,JK) = PTENDENCY_LOC_Q(JL,JK)+ZQADJ + PTENDENCY_LOC_T(JL,JK) = PTENDENCY_LOC_T(JL,JK)-RALVDCP*ZQADJ ZQX(JL,JK,NCLDQV) = ZQX(JL,JK,NCLDQV)+ZQX(JL,JK,NCLDQL) ZQX(JL,JK,NCLDQL) = 0.0_JPRB ! Evaporate small cloud ice water amounts ZLNEG(JL,JK,NCLDQI) = ZLNEG(JL,JK,NCLDQI)+ZQX(JL,JK,NCLDQI) ZQADJ = ZQX(JL,JK,NCLDQI)*ZQTMST - tendency_loc%q(JL,JK) = tendency_loc%q(JL,JK)+ZQADJ - tendency_loc%T(JL,JK) = tendency_loc%T(JL,JK)-RALSDCP*ZQADJ + PTENDENCY_LOC_Q(JL,JK) = PTENDENCY_LOC_Q(JL,JK)+ZQADJ + PTENDENCY_LOC_T(JL,JK) = PTENDENCY_LOC_T(JL,JK)-RALSDCP*ZQADJ ZQX(JL,JK,NCLDQV) = ZQX(JL,JK,NCLDQV)+ZQX(JL,JK,NCLDQI) ZQX(JL,JK,NCLDQI) = 0.0_JPRB @@ -732,9 +739,9 @@ SUBROUTINE CLOUDSC & IF (ZQX(JL,JK,JM) $<${HAVE_HDF5}:module/hdf5_file_mod.F90> $<${HAVE_FIELD_API}:module/cloudsc_field_state_mod.F90> + $<${HAVE_FIELD_API}:module/cloudsc_state_type_mod.F90> + $<${HAVE_FIELD_API}:module/cloudsc_aux_type_mod.F90> + $<${HAVE_FIELD_API}:module/cloudsc_flux_type_mod.F90> PRIVATE_INCLUDES $<${HAVE_HDF5}:${HDF5_Fortran_INCLUDE_DIRS}> PUBLIC_INCLUDES diff --git a/src/common/module/cloudsc_aux_type_mod.F90 b/src/common/module/cloudsc_aux_type_mod.F90 new file mode 100644 index 00000000..2c80f752 --- /dev/null +++ b/src/common/module/cloudsc_aux_type_mod.F90 @@ -0,0 +1,259 @@ +! (C) Copyright 1988- 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 CLOUDSC_AUX_TYPE_MOD + USE PARKIND1, ONLY : JPIM, JPRB + USE YOECLDP, ONLY : NCLV + + USE FIELD_MODULE, ONLY: FIELD_2RB, FIELD_3RB, FIELD_4RB, FIELD_2IM, FIELD_2LM, FIELD_3RB_PTR + USE FIELD_FACTORY_MODULE, ONLY: FIELD_NEW, FIELD_DELETE + + IMPLICIT NONE + + TYPE CLOUDSC_AUX_TYPE + + INTEGER(KIND=JPIM) :: NLEV + LOGICAL :: PACKED + ! 2D Fields + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PLSM(:) ! Land fraction (0-1) + LOGICAL, POINTER, CONTIGUOUS :: LDCUM(:) ! Convection active + INTEGER(KIND=JPIM), POINTER, CONTIGUOUS :: KTYPE(:) ! Convection type 0,1,2 + ! 3D Fields + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PLCRIT_AER(:,:) + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PICRIT_AER(:,:) + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PRE_ICE(:,:) + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PCCN(:,:) ! liquid cloud condensation nuclei + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PNICE(:,:) ! ice number concentration (cf. CCN) + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PT(:,:) ! T at start of callpar + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PQ(:,:) ! Q at start of callpar + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PVFA(:,:) ! CC from VDF scheme + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PVFL(:,:) ! Liq from VDF scheme + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PVFI(:,:) ! Ice from VDF scheme + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PDYNA(:,:) ! CC from Dynamics + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PDYNL(:,:) ! Liq from Dynamics + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PDYNI(:,:) ! Liq from Dynamics + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PHRSW(:,:) ! Short-wave heating rate + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PHRLW(:,:) ! Long-wave heating rate + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PVERVEL(:,:) ! Vertical velocity + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PAP(:,:) ! Pressure on full levels + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PAPH(:,:) ! Pressure on half levels + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PLU(:,:) ! Conv. condensate + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PLUDE(:,:) ! Conv. detrained water + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PSNDE(:,:) ! Conv. detrained snow + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PMFU(:,:) ! Conv. mass flux up + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PMFD(:,:) ! Conv. mass flux down + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PA(:,:) ! Original Cloud fraction (t) + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PEXTRA(:,:,:) ! extra fields + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PCLV(:,:,:) + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PSUPSAT(:,:) + ! Output fields used for validation + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PCOVPTOT(:,:) ! Precip fraction + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PRAINFRAC_TOPRFZ(:) + + ! field gang for 3D fields + CLASS(FIELD_4RB), POINTER :: DATA_RDONLY + ! Acces pointers for 3D fields in gang + TYPE(FIELD_3RB_PTR), PRIVATE, ALLOCATABLE :: FIELDS_RDONLY(:) + + CLASS(FIELD_2IM), POINTER :: F_KTYPE + CLASS(FIELD_2LM), POINTER :: F_LDCUM + CLASS(FIELD_2RB), POINTER :: F_PLSM, F_PRAINFRAC_TOPRFZ + CLASS(FIELD_3RB), POINTER :: F_PLCRIT_AER, F_PICRIT_AER, F_PRE_ICE, F_PCCN, & + F_PNICE, F_PT, F_PQ, F_PVFA, F_PVFL, F_PVFI, F_PDYNA, F_PDYNL, F_PDYNI, & + F_PHRSW, F_PHRLW, F_PVERVEL, F_PAP, F_PAPH, F_PLU, F_PLUDE, F_PSNDE, & + F_PMFU, F_PMFD, F_PA, F_PSUPSAT, F_PCOVPTOT + CLASS(FIELD_4RB), POINTER :: F_PEXTRA, F_PCLV + + CONTAINS + PROCEDURE :: INIT => AUX_TYPE_INIT + PROCEDURE :: UPDATE_VIEW => AUX_TYPE_UPDATE_VIEW + PROCEDURE :: SYNC_HOST => AUX_TYPE_SYNC_HOST + PROCEDURE :: FINAL => AUX_TYPE_FINAL + + END TYPE CLOUDSC_AUX_TYPE + +CONTAINS + + SUBROUTINE AUX_TYPE_INIT(SELF,NPROMA, NGPTOT, KLON, KLEV, KFLDX, NBLOCKS, NGPTOTG, USE_PACKED) + CLASS(CLOUDSC_AUX_TYPE) :: SELF + INTEGER(KIND=JPIM), INTENT(IN) :: NPROMA, NGPTOT, KLON, KLEV, KFLDX, NBLOCKS + INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: NGPTOTG + LOGICAL, INTENT(IN), OPTIONAL :: USE_PACKED + + INTEGER(KIND=JPIM), PARAMETER :: NFIELDS = 23 + + SELF%PACKED = .FALSE. + IF (PRESENT(USE_PACKED)) SELF%PACKED = USE_PACKED + + ! 2D Fields + CALL FIELD_NEW(SELF%F_PLSM, UBOUNDS=[NPROMA,NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_LDCUM, UBOUNDS=[NPROMA,NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_KTYPE, UBOUNDS=[NPROMA,NBLOCKS], PERSISTENT=.TRUE.) + ! 3D special fields + CALL FIELD_NEW(SELF%F_PLUDE, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) ! RDWR field + CALL FIELD_NEW(SELF%F_PAPH, UBOUNDS=[NPROMA, KLEV+1, NBLOCKS], PERSISTENT=.TRUE.) + ! 4D Fields + CALL FIELD_NEW(SELF%F_PEXTRA, UBOUNDS=[NPROMA,KLEV,NCLV,NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PCLV, UBOUNDS=[NPROMA,KLEV,NCLV,NBLOCKS], PERSISTENT=.TRUE.) + ! Validation Fields + CALL FIELD_NEW(SELF%F_PCOVPTOT, UBOUNDS=[NPROMA,KLEV,NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + CALL FIELD_NEW(SELF%F_PRAINFRAC_TOPRFZ, UBOUNDS=[NPROMA,NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + + ! 3D rdonly fields + IF (SELF%PACKED) THEN + CALL FIELD_NEW(SELF%DATA_RDONLY, SELF%FIELDS_RDONLY, UBOUNDS=[NPROMA, KLEV, NFIELDS, NBLOCKS], & + & PERSISTENT=.TRUE.) + SELF%F_PLCRIT_AER => SELF%FIELDS_RDONLY(1)%PTR + SELF%F_PICRIT_AER => SELF%FIELDS_RDONLY(2)%PTR + SELF%F_PRE_ICE => SELF%FIELDS_RDONLY(3)%PTR + SELF%F_PCCN => SELF%FIELDS_RDONLY(4)%PTR + SELF%F_PNICE => SELF%FIELDS_RDONLY(5)%PTR + SELF%F_PT => SELF%FIELDS_RDONLY(6)%PTR + SELF%F_PQ => SELF%FIELDS_RDONLY(7)%PTR + SELF%F_PVFA => SELF%FIELDS_RDONLY(8)%PTR + SELF%F_PVFL => SELF%FIELDS_RDONLY(9)%PTR + SELF%F_PVFI => SELF%FIELDS_RDONLY(10)%PTR + SELF%F_PDYNA => SELF%FIELDS_RDONLY(11)%PTR + SELF%F_PDYNL => SELF%FIELDS_RDONLY(12)%PTR + SELF%F_PDYNI => SELF%FIELDS_RDONLY(13)%PTR + SELF%F_PHRSW => SELF%FIELDS_RDONLY(14)%PTR + SELF%F_PHRLW => SELF%FIELDS_RDONLY(15)%PTR + SELF%F_PVERVEL => SELF%FIELDS_RDONLY(16)%PTR + SELF%F_PAP => SELF%FIELDS_RDONLY(17)%PTR + SELF%F_PLU => SELF%FIELDS_RDONLY(18)%PTR + SELF%F_PSNDE => SELF%FIELDS_RDONLY(19)%PTR + SELF%F_PMFU => SELF%FIELDS_RDONLY(20)%PTR + SELF%F_PMFD => SELF%FIELDS_RDONLY(21)%PTR + SELF%F_PA => SELF%FIELDS_RDONLY(22)%PTR + SELF%F_PSUPSAT => SELF%FIELDS_RDONLY(23)%PTR + ELSE + CALL FIELD_NEW(SELF%F_PLCRIT_AER, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PICRIT_AER, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PRE_ICE, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PCCN, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PNICE, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PT, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PQ, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PVFA, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PVFL, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PVFI, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PDYNA, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PDYNL, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PDYNI, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PHRSW, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PHRLW, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PVERVEL, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PAP, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PLU, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PSNDE, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PMFU, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PMFD, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PA, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + CALL FIELD_NEW(SELF%F_PSUPSAT, UBOUNDS=[NPROMA, KLEV, NBLOCKS], PERSISTENT=.TRUE.) + END IF + END SUBROUTINE AUX_TYPE_INIT + + SUBROUTINE AUX_TYPE_UPDATE_VIEW(SELF, BLOCK_INDEX) + CLASS(CLOUDSC_AUX_TYPE) :: SELF + INTEGER(KIND=JPIM), INTENT(IN) :: BLOCK_INDEX + + ! 2D fields + IF(ASSOCIATED(SELF%F_PLSM)) SELF%PLSM => SELF%F_PLSM%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_LDCUM)) SELF%LDCUM => SELF%F_LDCUM%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_KTYPE)) SELF%KTYPE => SELF%F_KTYPE%GET_VIEW(BLOCK_INDEX) + ! 3D Fields + IF(ASSOCIATED(SELF%F_PLCRIT_AER)) SELF%PLCRIT_AER => SELF%F_PLCRIT_AER%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PICRIT_AER)) SELF%PICRIT_AER => SELF%F_PICRIT_AER%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PRE_ICE)) SELF%PRE_ICE => SELF%F_PRE_ICE%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PCCN)) SELF%PCCN => SELF%F_PCCN%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PNICE)) SELF%PNICE => SELF%F_PNICE%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PT)) SELF%PT => SELF%F_PT%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PQ)) SELF%PQ => SELF%F_PQ%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PVFA)) SELF%PVFA => SELF%F_PVFA%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PVFL)) SELF%PVFL => SELF%F_PVFL%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PVFI)) SELF%PVFI => SELF%F_PVFI%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PDYNA)) SELF%PDYNA => SELF%F_PDYNA%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PDYNL)) SELF%PDYNL => SELF%F_PDYNL%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PDYNI)) SELF%PDYNI => SELF%F_PDYNI%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PHRSW)) SELF%PHRSW => SELF%F_PHRSW%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PHRLW)) SELF%PHRLW => SELF%F_PHRLW%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PVERVEL)) SELF%PVERVEL => SELF%F_PVERVEL%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PAP)) SELF%PAP => SELF%F_PAP%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PAPH)) SELF%PAPH => SELF%F_PAPH%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PLU)) SELF%PLU => SELF%F_PLU%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PLUDE)) SELF%PLUDE => SELF%F_PLUDE%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PSNDE)) SELF%PSNDE => SELF%F_PSNDE%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PMFU)) SELF%PMFU => SELF%F_PMFU%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PMFD)) SELF%PMFD => SELF%F_PMFD%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PA)) SELF%PA => SELF%F_PA%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PSUPSAT)) SELF%PSUPSAT => SELF%F_PSUPSAT%GET_VIEW(BLOCK_INDEX) + ! 4D fields + IF(ASSOCIATED(SELF%F_PEXTRA)) SELF%PEXTRA => SELF%F_PEXTRA%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PCLV)) SELF%PCLV => SELF%F_PCLV%GET_VIEW(BLOCK_INDEX) + ! validation Fields + IF(ASSOCIATED(SELF%F_PCOVPTOT)) SELF%PCOVPTOT => SELF%F_PCOVPTOT%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PRAINFRAC_TOPRFZ)) SELF%PRAINFRAC_TOPRFZ => SELF%F_PRAINFRAC_TOPRFZ%GET_VIEW(BLOCK_INDEX) + + END SUBROUTINE AUX_TYPE_UPDATE_VIEW + + SUBROUTINE AUX_TYPE_SYNC_HOST(SELF) + CLASS(CLOUDSC_AUX_TYPE) :: SELF + ! Validation Fields + CALL SELF%F_PLUDE%SYNC_HOST_RDWR() + CALL SELF%F_PCOVPTOT%SYNC_HOST_RDWR() + CALL SELF%F_PRAINFRAC_TOPRFZ%SYNC_HOST_RDWR() + END SUBROUTINE AUX_TYPE_SYNC_HOST + + SUBROUTINE AUX_TYPE_FINAL(SELF) + CLASS(CLOUDSC_AUX_TYPE) :: SELF + ! 2D Fields + CALL FIELD_DELETE(SELF%F_PLSM) + CALL FIELD_DELETE(SELF%F_LDCUM) + CALL FIELD_DELETE(SELF%F_KTYPE) + ! 3D special fields + CALL FIELD_DELETE(SELF%F_PLUDE) + CALL FIELD_DELETE(SELF%F_PAPH) + ! 4D Fields + CALL FIELD_DELETE(SELF%F_PEXTRA) + CALL FIELD_DELETE(SELF%F_PCLV) + ! Validation fields + CALL FIELD_DELETE(SELF%F_PCOVPTOT) + CALL FIELD_DELETE(SELF%F_PRAINFRAC_TOPRFZ) + ! 3D wronly fields + IF(SELF%PACKED) THEN + CALL FIELD_DELETE(SELF%DATA_RDONLY) + DEALLOCATE(SELF%FIELDS_RDONLY) + ELSE + CALL FIELD_DELETE(SELF%F_PLCRIT_AER) + CALL FIELD_DELETE(SELF%F_PICRIT_AER) + CALL FIELD_DELETE(SELF%F_PRE_ICE) + CALL FIELD_DELETE(SELF%F_PCCN) + CALL FIELD_DELETE(SELF%F_PNICE) + CALL FIELD_DELETE(SELF%F_PT) + CALL FIELD_DELETE(SELF%F_PQ) + CALL FIELD_DELETE(SELF%F_PVFA) + CALL FIELD_DELETE(SELF%F_PVFL) + CALL FIELD_DELETE(SELF%F_PVFI) + CALL FIELD_DELETE(SELF%F_PDYNA) + CALL FIELD_DELETE(SELF%F_PDYNL) + CALL FIELD_DELETE(SELF%F_PDYNI) + CALL FIELD_DELETE(SELF%F_PHRSW) + CALL FIELD_DELETE(SELF%F_PHRLW) + CALL FIELD_DELETE(SELF%F_PVERVEL) + CALL FIELD_DELETE(SELF%F_PAP) + CALL FIELD_DELETE(SELF%F_PLU) + CALL FIELD_DELETE(SELF%F_PSNDE) + CALL FIELD_DELETE(SELF%F_PMFU) + CALL FIELD_DELETE(SELF%F_PMFD) + CALL FIELD_DELETE(SELF%F_PA) + CALL FIELD_DELETE(SELF%F_PSUPSAT) + END IF + END SUBROUTINE AUX_TYPE_FINAL + +END MODULE CLOUDSC_AUX_TYPE_MOD diff --git a/src/common/module/cloudsc_field_state_mod.F90 b/src/common/module/cloudsc_field_state_mod.F90 index 02d2ce32..2a790f9f 100644 --- a/src/common/module/cloudsc_field_state_mod.F90 +++ b/src/common/module/cloudsc_field_state_mod.F90 @@ -16,6 +16,9 @@ MODULE CLOUDSC_FIELD_STATE_MOD USE YOETHF, ONLY : YOETHF_LOAD_PARAMETERS USE YOEPHLI , ONLY : YREPHLI, YREPHLI_LOAD_PARAMETERS + USE CLOUDSC_STATE_TYPE_MOD, ONLY: CLOUDSC_STATE_TYPE + USE CLOUDSC_AUX_TYPE_MOD, ONLY: CLOUDSC_AUX_TYPE + USE CLOUDSC_FLUX_TYPE_MOD, ONLY: CLOUDSC_FLUX_TYPE USE FILE_IO_MOD, ONLY: INPUT_INITIALIZE, INPUT_FINALIZE, LOAD_SCALAR, LOAD_ARRAY USE EXPAND_MOD, ONLY: EXPAND, LOAD_AND_EXPAND, LOAD_AND_EXPAND_STATE, GET_OFFSETS USE VALIDATE_MOD, ONLY: VALIDATE @@ -25,6 +28,7 @@ MODULE CLOUDSC_FIELD_STATE_MOD IMPLICIT NONE + TYPE CLOUDSC_FIELD_STATE INTEGER(KIND=JPIM) :: NPROMA, KLEV ! Grid points and vertical levels per block INTEGER(KIND=JPIM) :: NGPTOT, NBLOCKS ! Total number of grid points and blocks @@ -33,24 +37,14 @@ MODULE CLOUDSC_FIELD_STATE_MOD LOGICAL(KIND=JPLM) :: LDMAINCALL ! T if main call to cloudsc REAL(KIND=JPRB) :: PTSPHY ! Physics timestep - TYPE(STATE_TYPE) :: TENDENCY_LOC, TENDENCY_TMP - + TYPE(CLOUDSC_STATE_TYPE) :: TENDENCY_LOC, TENDENCY_TMP + TYPE(CLOUDSC_AUX_TYPE) :: AUX + TYPE(CLOUDSC_FLUX_TYPE) :: FLUX ! Underlying data buffers for AOSOA allcoated STATE_TYPE arrays REAL(KIND=JPRB), ALLOCATABLE :: B_TMP(:,:,:,:) REAL(KIND=JPRB), ALLOCATABLE :: B_LOC(:,:,:,:) - CLASS(FIELD_4RB), POINTER :: DATA_RDONLY - CLASS(FIELD_4RB), POINTER :: DATA_RWONLY - - ! Storage fields to provide thread-local views - CLASS(FIELD_2RB), POINTER :: F_PRAINFRAC_TOPRFZ, F_PLSM - CLASS(FIELD_2IM), POINTER :: F_KTYPE - CLASS(FIELD_2LM), POINTER :: F_LDCUM - CLASS(FIELD_3RB), POINTER :: F_PAPH, F_PCOVPTOT, F_PLUDE - CLASS(FIELD_4RB), POINTER :: F_PCLV - TYPE(FIELD_3RB_PTR), ALLOCATABLE :: FIELDS_RDONLY(:) - TYPE(FIELD_3RB_PTR), ALLOCATABLE :: FIELDS_RWONLY(:) CONTAINS PROCEDURE :: LOAD => CLOUDSC_FIELD_STATE_LOAD PROCEDURE :: VALIDATE => CLOUDSC_FIELD_STATE_VALIDATE @@ -196,7 +190,7 @@ SUBROUTINE FIELD_INIT_STATE(STATE, BUFFER, NPROMA, NLEV, NDIM, NBLOCKS) ! ! Note, the resulting AOSOA pattern is a pain to roll by hand in Fortran ! and could be done either via parameterized derived types or templating. - TYPE(STATE_TYPE), ALLOCATABLE, INTENT(INOUT) :: STATE(:) + TYPE(CLOUDSC_STATE_TYPE), ALLOCATABLE, INTENT(INOUT) :: STATE(:) REAL(KIND=JPRB), ALLOCATABLE, TARGET, INTENT(INOUT) :: BUFFER(:,:,:,:) INTEGER(KIND=JPIM), INTENT(IN) :: NPROMA, NLEV, NDIM, NBLOCKS INTEGER(KIND=JPIM) :: B, NFIELDS @@ -216,8 +210,7 @@ SUBROUTINE FIELD_INIT_STATE(STATE, BUFFER, NPROMA, NLEV, NDIM, NBLOCKS) END SUBROUTINE FIELD_INIT_STATE SUBROUTINE CLOUDSC_FIELD_STATE_LOAD(SELF, NPROMA, NGPTOT, NGPTOTG, USE_PACKED) - USE FIELD_DEFAULTS_MODULE, ONLY: INIT_PINNED_VALUE, INIT_MAP_DEVPTR - ! Load reference input data via serialbox + USE FIELD_DEFAULTS_MODULE, ONLY: INIT_MAP_DEVPTR CLASS(CLOUDSC_FIELD_STATE) :: SELF INTEGER(KIND=JPIM), INTENT(IN) :: NPROMA, NGPTOT INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: NGPTOTG @@ -229,145 +222,68 @@ SUBROUTINE CLOUDSC_FIELD_STATE_LOAD(SELF, NPROMA, NGPTOT, NGPTOTG, USE_PACKED) LOGICAL :: LLPACKED +#ifndef FIELD_API_DISABLE_MAPPED_MEMORY + INIT_MAP_DEVPTR = .TRUE. +#else + ! disables automatic registering of fields in OpenACC map + INIT_MAP_DEVPTR = .FALSE. +#endif + LLPACKED = .FALSE. IF (PRESENT(USE_PACKED)) LLPACKED = USE_PACKED - ! Set this flag to enable pinning of fields in page-locked memory - INIT_PINNED_VALUE = .TRUE. - ! Set this flag to disable host-mapped device pointers - INIT_MAP_DEVPTR = .FALSE. - CALL INPUT_INITIALIZE(NAME='input') SELF%NBLOCKS = (NGPTOT / NPROMA) + MIN(MOD(NGPTOT,NPROMA), 1) + CALL LOAD_SCALAR('KLON', KLON) CALL LOAD_SCALAR('KLEV', SELF%KLEV) CALL LOAD_SCALAR('KFLDX', SELF%KFLDX) CALL GET_OFFSETS(START, END, SIZE, KLON, SELF%KLEV, NCLV, NGPTOT, NGPTOTG) - - IF (LLPACKED) THEN - ! Allocate bulk buffers for read-only input 3D fields - NFIELDS = 23 - CALL FIELD_NEW(SELF%DATA_RDONLY, SELF%FIELDS_RDONLY, UBOUNDS=[NPROMA, SELF%KLEV, NFIELDS, SELF%NBLOCKS], & - & PERSISTENT=.TRUE.) - - ! This is a RDWR field, so does not belong in either of the buffers - CALL FIELD_NEW(SELF%F_PLUDE, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - - ! Custom fields that do not share shape or data type with the other blocks - CALL FIELD_NEW(SELF%F_PAPH, UBOUNDS=[NPROMA,SELF%KLEV+1,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%F_PLSM, UBOUNDS=[NPROMA,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%F_LDCUM, UBOUNDS=[NPROMA,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%F_KTYPE, UBOUNDS=[NPROMA,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%F_PCLV, UBOUNDS=[NPROMA,SELF%KLEV,NCLV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%F_PCOVPTOT, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - CALL FIELD_NEW(SELF%F_PRAINFRAC_TOPRFZ, UBOUNDS=[NPROMA,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - - ! Allocate bulk buffers for output 3D fields - NFIELDS = 14 - CALL FIELD_NEW(SELF%DATA_RWONLY, SELF%FIELDS_RWONLY, UBOUNDS=[NPROMA, SELF%KLEV+1, NFIELDS, SELF%NBLOCKS], & - & PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - - ELSE - ALLOCATE(SELF%FIELDS_RDONLY(23)) - ALLOCATE(SELF%FIELDS_RWONLY(14)) - - CALL FIELD_NEW(SELF%FIELDS_RDONLY(1)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(2)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(3)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(4)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(5)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(6)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(7)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(8)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(9)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(10)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(11)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(12)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(13)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(14)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(15)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(16)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(17)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(18)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(19)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(20)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(21)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(22)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%FIELDS_RDONLY(23)%PTR, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - - ! This is a RDWR field, so does not belong in either of the buffers - CALL FIELD_NEW(SELF%F_PLUDE, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - - ! Custom fields that do not share shape or data type with the other blocks - CALL FIELD_NEW(SELF%F_PAPH, UBOUNDS=[NPROMA,SELF%KLEV+1,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%F_PLSM, UBOUNDS=[NPROMA,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%F_LDCUM, UBOUNDS=[NPROMA,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%F_KTYPE, UBOUNDS=[NPROMA,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%F_PCLV, UBOUNDS=[NPROMA,SELF%KLEV,NCLV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%F_PCOVPTOT, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - CALL FIELD_NEW(SELF%F_PRAINFRAC_TOPRFZ, UBOUNDS=[NPROMA,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - - ! Allocate bulk buffers for output 3D fields - CALL FIELD_NEW(SELF%FIELDS_RWONLY(1)%PTR, UBOUNDS=[NPROMA,SELF%KLEV+1,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - CALL FIELD_NEW(SELF%FIELDS_RWONLY(2)%PTR, UBOUNDS=[NPROMA,SELF%KLEV+1,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - CALL FIELD_NEW(SELF%FIELDS_RWONLY(3)%PTR, UBOUNDS=[NPROMA,SELF%KLEV+1,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - CALL FIELD_NEW(SELF%FIELDS_RWONLY(4)%PTR, UBOUNDS=[NPROMA,SELF%KLEV+1,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - CALL FIELD_NEW(SELF%FIELDS_RWONLY(5)%PTR, UBOUNDS=[NPROMA,SELF%KLEV+1,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - CALL FIELD_NEW(SELF%FIELDS_RWONLY(6)%PTR, UBOUNDS=[NPROMA,SELF%KLEV+1,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - CALL FIELD_NEW(SELF%FIELDS_RWONLY(7)%PTR, UBOUNDS=[NPROMA,SELF%KLEV+1,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - CALL FIELD_NEW(SELF%FIELDS_RWONLY(8)%PTR, UBOUNDS=[NPROMA,SELF%KLEV+1,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - CALL FIELD_NEW(SELF%FIELDS_RWONLY(9)%PTR, UBOUNDS=[NPROMA,SELF%KLEV+1,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - CALL FIELD_NEW(SELF%FIELDS_RWONLY(10)%PTR, UBOUNDS=[NPROMA,SELF%KLEV+1,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - CALL FIELD_NEW(SELF%FIELDS_RWONLY(11)%PTR, UBOUNDS=[NPROMA,SELF%KLEV+1,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - CALL FIELD_NEW(SELF%FIELDS_RWONLY(12)%PTR, UBOUNDS=[NPROMA,SELF%KLEV+1,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - CALL FIELD_NEW(SELF%FIELDS_RWONLY(13)%PTR, UBOUNDS=[NPROMA,SELF%KLEV+1,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - CALL FIELD_NEW(SELF%FIELDS_RWONLY(14)%PTR, UBOUNDS=[NPROMA,SELF%KLEV+1,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - - END IF - - ! TODO: For now we treat all fields as single-allocations - CALL FIELD_NEW(SELF%TENDENCY_LOC%F_T, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - CALL FIELD_NEW(SELF%TENDENCY_LOC%F_A, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - CALL FIELD_NEW(SELF%TENDENCY_LOC%F_Q, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - CALL FIELD_NEW(SELF%TENDENCY_LOC%F_CLD, UBOUNDS=[NPROMA,SELF%KLEV,NCLV,SELF%NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - - CALL FIELD_NEW(SELF%TENDENCY_TMP%F_T, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%TENDENCY_TMP%F_A, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%TENDENCY_TMP%F_Q, UBOUNDS=[NPROMA,SELF%KLEV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - CALL FIELD_NEW(SELF%TENDENCY_TMP%F_CLD, UBOUNDS=[NPROMA,SELF%KLEV,NCLV,SELF%NBLOCKS], PERSISTENT=.TRUE.) - - CALL LOAD_AND_EXPAND_FIELD_3D('PLCRIT_AER', SELF%FIELDS_RDONLY(19)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PICRIT_AER', SELF%FIELDS_RDONLY(20)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PRE_ICE', SELF%FIELDS_RDONLY(21)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PCCN', SELF%FIELDS_RDONLY(22)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PNICE', SELF%FIELDS_RDONLY(23)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PT', SELF%FIELDS_RDONLY(1)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PQ', SELF%FIELDS_RDONLY(2)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PVFA', SELF%FIELDS_RDONLY(3)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PVFL', SELF%FIELDS_RDONLY(4)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PVFI', SELF%FIELDS_RDONLY(5)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PDYNA', SELF%FIELDS_RDONLY(6)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PDYNL', SELF%FIELDS_RDONLY(7)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PDYNI', SELF%FIELDS_RDONLY(8)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PHRSW', SELF%FIELDS_RDONLY(9)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PHRLW', SELF%FIELDS_RDONLY(10)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PVERVEL', SELF%FIELDS_RDONLY(11)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PAP', SELF%FIELDS_RDONLY(12)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PAPH', SELF%F_PAPH, KLON, SELF%KLEV+1, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_2D('PLSM', SELF%F_PLSM, KLON, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_LOG2D('LDCUM', SELF%F_LDCUM, KLON, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_INT2D('KTYPE', SELF%F_KTYPE, KLON, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PLU', SELF%FIELDS_RDONLY(13)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PLUDE', SELF%F_PLUDE, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PSNDE', SELF%FIELDS_RDONLY(14)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PMFU', SELF%FIELDS_RDONLY(15)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PMFD', SELF%FIELDS_RDONLY(16)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PA', SELF%FIELDS_RDONLY(17)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_4D('PCLV', SELF%F_PCLV, KLON, SELF%KLEV, NCLV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - CALL LOAD_AND_EXPAND_FIELD_3D('PSUPSAT', SELF%FIELDS_RDONLY(18)%PTR, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) - + + ! Initialize and load aux types + CALL SELF%AUX%INIT(NPROMA, NGPTOT, KLON, SELF%KLEV, SELF%KFLDX, SELF%NBLOCKS, NGPTOTG, USE_PACKED) + ! 2D Fields + CALL LOAD_AND_EXPAND_FIELD_2D('PLSM', SELF%AUX%F_PLSM, KLON, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_LOG2D('LDCUM', SELF%AUX%F_LDCUM, KLON, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_INT2D('KTYPE', SELF%AUX%F_KTYPE, KLON, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + ! 3D fields + CALL LOAD_AND_EXPAND_FIELD_3D('PLCRIT_AER', SELF%AUX%F_PLCRIT_AER, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PICRIT_AER', SELF%AUX%F_PICRIT_AER, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PRE_ICE', SELF%AUX%F_PRE_ICE, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PCCN', SELF%AUX%F_PCCN, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PNICE', SELF%AUX%F_PNICE, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PT', SELF%AUX%F_PT, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PQ', SELF%AUX%F_PQ, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PVFA', SELF%AUX%F_PVFA, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PVFL', SELF%AUX%F_PVFL, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PVFI', SELF%AUX%F_PVFI, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PDYNA', SELF%AUX%F_PDYNA, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PDYNL', SELF%AUX%F_PDYNL, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PDYNI', SELF%AUX%F_PDYNI, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PHRSW', SELF%AUX%F_PHRSW, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PHRLW', SELF%AUX%F_PHRLW, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PVERVEL', SELF%AUX%F_PVERVEL, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PAP', SELF%AUX%F_PAP, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PAPH', SELF%AUX%F_PAPH, KLON, SELF%KLEV+1, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PLU', SELF%AUX%F_PLU, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PLUDE', SELF%AUX%F_PLUDE, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PSNDE', SELF%AUX%F_PSNDE, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PMFU', SELF%AUX%F_PMFU, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PMFD', SELF%AUX%F_PMFD, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PA', SELF%AUX%F_PA, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + CALL LOAD_AND_EXPAND_FIELD_3D('PSUPSAT', SELF%AUX%F_PSUPSAT, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + ! 4D fields + CALL LOAD_AND_EXPAND_FIELD_4D('PCLV', SELF%AUX%F_PCLV, KLON, SELF%KLEV, NCLV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) + + ! Initialize and load fluxes + CALL SELF%FLUX%INIT(NPROMA, NGPTOT, KLON, SELF%KLEV, SELF%KFLDX, SELF%NBLOCKS, NGPTOTG, USE_PACKED) + + ! Initialize and load tendencies + CALL SELF%TENDENCY_LOC%INIT(NPROMA, NGPTOT, KLON, SELF%KLEV, SELF%KFLDX, SELF%NBLOCKS, NGPTOTG, USE_PACKED) + CALL SELF%TENDENCY_TMP%INIT(NPROMA, NGPTOT, KLON, SELF%KLEV, SELF%KFLDX, SELF%NBLOCKS, NGPTOTG, USE_PACKED) + ! LOAD TENDENCIES (we don't need to load TENDENCY_LOC) CALL LOAD_AND_EXPAND_FIELD_3D('TENDENCY_TMP_T', SELF%TENDENCY_TMP%F_T, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) CALL LOAD_AND_EXPAND_FIELD_3D('TENDENCY_TMP_A', SELF%TENDENCY_TMP%F_A, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) CALL LOAD_AND_EXPAND_FIELD_3D('TENDENCY_TMP_Q', SELF%TENDENCY_TMP%F_Q, KLON, SELF%KLEV, NPROMA, NGPTOT, SELF%NBLOCKS, NGPTOTG) @@ -450,23 +366,23 @@ SUBROUTINE CLOUDSC_FIELD_STATE_VALIDATE(SELF, NPROMA, NGPTOT, NGPTOTG) CALL INPUT_FINALIZE() ! Actual variable validation - CALL VALIDATE('PLUDE', PLUDE, SELF%F_PLUDE%PTR, NPROMA, SELF%KLEV, NGPTOT, NBLOCKS, NGPTOTG) - CALL VALIDATE('PCOVPTOT', PCOVPTOT, SELF%F_PCOVPTOT%PTR, NPROMA, SELF%KLEV, NGPTOT, NBLOCKS, NGPTOTG) - CALL VALIDATE('PRAINFRAC_TOPRFZ', PRAINFRAC_TOPRFZ, SELF%F_PRAINFRAC_TOPRFZ%PTR, NPROMA, NGPTOT, NBLOCKS, NGPTOTG) - CALL VALIDATE('PFSQLF', PFSQLF, SELF%FIELDS_RWONLY(1)%PTR%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) - CALL VALIDATE('PFSQIF', PFSQIF, SELF%FIELDS_RWONLY(2)%PTR%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) - CALL VALIDATE('PFCQLNG', PFCQLNG, SELF%FIELDS_RWONLY(3)%PTR%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) - CALL VALIDATE('PFCQNNG', PFCQNNG, SELF%FIELDS_RWONLY(4)%PTR%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) - CALL VALIDATE('PFSQRF', PFSQRF, SELF%FIELDS_RWONLY(5)%PTR%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) - CALL VALIDATE('PFSQSF', PFSQSF, SELF%FIELDS_RWONLY(6)%PTR%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) - CALL VALIDATE('PFCQRNG', PFCQRNG, SELF%FIELDS_RWONLY(7)%PTR%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) - CALL VALIDATE('PFCQSNG', PFCQSNG, SELF%FIELDS_RWONLY(8)%PTR%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) - CALL VALIDATE('PFSQLTUR', PFSQLTUR, SELF%FIELDS_RWONLY(9)%PTR%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) - CALL VALIDATE('PFSQITUR', PFSQITUR, SELF%FIELDS_RWONLY(10)%PTR%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) - CALL VALIDATE('PFPLSL', PFPLSL, SELF%FIELDS_RWONLY(11)%PTR%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) - CALL VALIDATE('PFPLSN', PFPLSN, SELF%FIELDS_RWONLY(12)%PTR%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) - CALL VALIDATE('PFHPSL', PFHPSL, SELF%FIELDS_RWONLY(13)%PTR%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) - CALL VALIDATE('PFHPSN', PFHPSN, SELF%FIELDS_RWONLY(14)%PTR%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) + CALL VALIDATE('PLUDE', PLUDE, SELF%AUX%F_PLUDE%PTR, NPROMA, SELF%KLEV, NGPTOT, NBLOCKS, NGPTOTG) + CALL VALIDATE('PCOVPTOT', PCOVPTOT, SELF%AUX%F_PCOVPTOT%PTR, NPROMA, SELF%KLEV, NGPTOT, NBLOCKS, NGPTOTG) + CALL VALIDATE('PRAINFRAC_TOPRFZ', PRAINFRAC_TOPRFZ, SELF%AUX%F_PRAINFRAC_TOPRFZ%PTR, NPROMA, NGPTOT, NBLOCKS, NGPTOTG) + CALL VALIDATE('PFSQLF', PFSQLF, SELF%FLUX%F_PFSQLF%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) + CALL VALIDATE('PFSQIF', PFSQIF, SELF%FLUX%F_PFSQIF%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) + CALL VALIDATE('PFCQLNG', PFCQLNG, SELF%FLUX%F_PFCQLNG%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) + CALL VALIDATE('PFCQNNG', PFCQNNG, SELF%FLUX%F_PFCQNNG%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) + CALL VALIDATE('PFSQRF', PFSQRF, SELF%FLUX%F_PFSQRF%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) + CALL VALIDATE('PFSQSF', PFSQSF, SELF%FLUX%F_PFSQSF%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) + CALL VALIDATE('PFCQRNG', PFCQRNG, SELF%FLUX%F_PFCQRNG%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) + CALL VALIDATE('PFCQSNG', PFCQSNG, SELF%FLUX%F_PFCQSNG%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) + CALL VALIDATE('PFSQLTUR', PFSQLTUR, SELF%FLUX%F_PFSQLTUR%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) + CALL VALIDATE('PFSQITUR', PFSQITUR, SELF%FLUX%F_PFSQITUR%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) + CALL VALIDATE('PFPLSL', PFPLSL, SELF%FLUX%F_PFPLSL%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) + CALL VALIDATE('PFPLSN', PFPLSN, SELF%FLUX%F_PFPLSN%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) + CALL VALIDATE('PFHPSL', PFHPSL, SELF%FLUX%F_PFHPSL%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) + CALL VALIDATE('PFHPSN', PFHPSN, SELF%FLUX%F_PFHPSN%PTR, NPROMA, SELF%KLEV+1, NGPTOT, NBLOCKS, NGPTOTG) CALL VALIDATE('TENDENCY_LOC%A', B_LOC(:,:,2,:), SELF%TENDENCY_LOC%F_A%PTR, NPROMA, SELF%KLEV, NGPTOT, NBLOCKS, NGPTOTG) CALL VALIDATE('TENDENCY_LOC%Q', B_LOC(:,:,3,:), SELF%TENDENCY_LOC%F_Q%PTR, NPROMA, SELF%KLEV, NGPTOT, NBLOCKS, NGPTOTG) @@ -475,48 +391,14 @@ SUBROUTINE CLOUDSC_FIELD_STATE_VALIDATE(SELF, NPROMA, NGPTOT, NGPTOTG) END SUBROUTINE CLOUDSC_FIELD_STATE_VALIDATE - SUBROUTINE CLOUDSC_FIELD_STATE_FINALIZE(SELF, USE_PACKED) - ! Validate the correctness of output against reference data + + SUBROUTINE CLOUDSC_FIELD_STATE_FINALIZE(SELF) CLASS(CLOUDSC_FIELD_STATE) :: SELF - ! Use this toggle to switch between standalone fields and bulk-allocated ones. - LOGICAL, INTENT(IN) :: USE_PACKED - INTEGER :: IFIELD - - IF(USE_PACKED)THEN - CALL FIELD_DELETE(SELF%DATA_RDONLY) - CALL FIELD_DELETE(SELF%DATA_RWONLY) - ELSE - DO IFIELD=1,23 - CALL FIELD_DELETE(SELF%FIELDS_RDONLY(IFIELD)%PTR) - ENDDO - - DO IFIELD=1,14 - CALL FIELD_DELETE(SELF%FIELDS_RWONLY(IFIELD)%PTR) - ENDDO - ENDIF - - CALL FIELD_DELETE(SELF%F_PLUDE) - CALL FIELD_DELETE(SELF%F_PAPH) - CALL FIELD_DELETE(SELF%F_PLSM) - CALL FIELD_DELETE(SELF%F_LDCUM) - CALL FIELD_DELETE(SELF%F_KTYPE) - CALL FIELD_DELETE(SELF%F_PCLV) - CALL FIELD_DELETE(SELF%F_PCOVPTOT) - CALL FIELD_DELETE(SELF%F_PRAINFRAC_TOPRFZ) - - CALL FIELD_DELETE(SELF%TENDENCY_LOC%F_T) - CALL FIELD_DELETE(SELF%TENDENCY_LOC%F_A) - CALL FIELD_DELETE(SELF%TENDENCY_LOC%F_Q) - CALL FIELD_DELETE(SELF%TENDENCY_LOC%F_CLD) - - CALL FIELD_DELETE(SELF%TENDENCY_TMP%F_T) - CALL FIELD_DELETE(SELF%TENDENCY_TMP%F_A) - CALL FIELD_DELETE(SELF%TENDENCY_TMP%F_Q) - CALL FIELD_DELETE(SELF%TENDENCY_TMP%F_CLD) - - DEALLOCATE(SELF%FIELDS_RDONLY) - DEALLOCATE(SELF%FIELDS_RWONLY) - + CALL SELF%AUX%FINAL() + CALL SELF%FLUX%FINAL() + CALL SELF%TENDENCY_LOC%FINAL() + CALL SELF%TENDENCY_TMP%FINAL() END SUBROUTINE CLOUDSC_FIELD_STATE_FINALIZE + END MODULE CLOUDSC_FIELD_STATE_MOD diff --git a/src/common/module/cloudsc_flux_type_mod.F90 b/src/common/module/cloudsc_flux_type_mod.F90 new file mode 100644 index 00000000..a911f46f --- /dev/null +++ b/src/common/module/cloudsc_flux_type_mod.F90 @@ -0,0 +1,171 @@ +! (C) Copyright 1988- 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 CLOUDSC_FLUX_TYPE_MOD + USE PARKIND1, ONLY : JPIM, JPRB + + USE FIELD_MODULE, ONLY: FIELD_3RB, FIELD_4RB, FIELD_3RB_PTR + USE FIELD_FACTORY_MODULE, ONLY: FIELD_NEW, FIELD_DELETE + + IMPLICIT NONE + + TYPE CLOUDSC_FLUX_TYPE + + INTEGER(KIND=JPIM) :: NLEV + LOGICAL :: PACKED + + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PFSQLF(:,:) ! Flux of liquid + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PFSQIF(:,:) ! Flux of ice + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PFCQLNG(:,:) ! -ve corr for liq + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PFCQNNG(:,:) ! -ve corr for ice + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PFSQRF(:,:) ! Flux diagnostics + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PFSQSF(:,:) ! for DDH, generic + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PFCQRNG(:,:) ! rain + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PFCQSNG(:,:) ! snow + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PFSQLTUR(:,:) ! liquid flux due to VDF + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PFSQITUR(:,:) ! ice flux due to VDF + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PFPLSL(:,:) ! liq+rain sedim flux + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PFPLSN(:,:) ! ice+snow sedim flux + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PFHPSL(:,:) ! Enthalpy flux for liq + REAL(KIND=JPRB), POINTER, CONTIGUOUS :: PFHPSN(:,:) ! Enthalp flux for ice + + CLASS(FIELD_3RB), POINTER :: F_PFSQLF, F_PFSQIF, F_PFCQLNG, F_PFCQNNG, F_PFSQRF, F_PFSQSF, & + & F_PFCQRNG, F_PFCQSNG, F_PFSQLTUR, F_PFSQITUR, F_PFPLSL, F_PFPLSN, F_PFHPSL, F_PFHPSN + + CLASS(FIELD_4RB), POINTER :: DATA_WRONLY ! ACTUAL FIELD storing data + TYPE(FIELD_3RB_PTR), PRIVATE, ALLOCATABLE :: FIELDS_WRONLY(:) ! Array of field pointers + + CONTAINS + PROCEDURE :: INIT => FLUX_TYPE_INIT + PROCEDURE :: UPDATE_VIEW => FLUX_TYPE_UPDATE_VIEW + PROCEDURE :: SYNC_HOST => FLUX_TYPE_SYNC_HOST + PROCEDURE :: FINAL => FLUX_TYPE_FINAL + + END TYPE CLOUDSC_FLUX_TYPE + +CONTAINS + + SUBROUTINE FLUX_TYPE_INIT(SELF,NPROMA, NGPTOT, KLON, KLEV, KFLDX, NBLOCKS, NGPTOTG, USE_PACKED) + CLASS(CLOUDSC_FLUX_TYPE) :: SELF + INTEGER(KIND=JPIM), INTENT(IN) :: NPROMA, NGPTOT, KLON, KLEV, KFLDX, NBLOCKS + INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: NGPTOTG + LOGICAL, INTENT(IN), OPTIONAL :: USE_PACKED + + INTEGER(KIND=JPIM), PARAMETER :: NFIELDS = 14 + + SELF%PACKED = .FALSE. + IF (PRESENT(USE_PACKED)) SELF%PACKED = USE_PACKED + + + IF (SELF%PACKED) THEN + CALL FIELD_NEW(SELF%DATA_WRONLY, SELF%FIELDS_WRONLY, UBOUNDS=[NPROMA, KLEV+1, NFIELDS, NBLOCKS], & + & PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + SELF%F_PFSQLF => SELF%FIELDS_WRONLY(1)%PTR + SELF%F_PFSQIF => SELF%FIELDS_WRONLY(2)%PTR + SELF%F_PFCQLNG => SELF%FIELDS_WRONLY(3)%PTR + SELF%F_PFCQNNG => SELF%FIELDS_WRONLY(4)%PTR + SELF%F_PFSQRF => SELF%FIELDS_WRONLY(5)%PTR + SELF%F_PFSQSF => SELF%FIELDS_WRONLY(6)%PTR + SELF%F_PFCQRNG => SELF%FIELDS_WRONLY(7)%PTR + SELF%F_PFCQSNG => SELF%FIELDS_WRONLY(8)%PTR + SELF%F_PFSQLTUR => SELF%FIELDS_WRONLY(9)%PTR + SELF%F_PFSQITUR => SELF%FIELDS_WRONLY(10)%PTR + SELF%F_PFPLSL => SELF%FIELDS_WRONLY(11)%PTR + SELF%F_PFPLSN => SELF%FIELDS_WRONLY(12)%PTR + SELF%F_PFHPSL => SELF%FIELDS_WRONLY(13)%PTR + SELF%F_PFHPSN => SELF%FIELDS_WRONLY(14)%PTR + ELSE + CALL FIELD_NEW(SELF%F_PFSQLF, UBOUNDS=[NPROMA, KLEV+1, NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + CALL FIELD_NEW(SELF%F_PFSQIF, UBOUNDS=[NPROMA, KLEV+1, NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + CALL FIELD_NEW(SELF%F_PFCQLNG, UBOUNDS=[NPROMA, KLEV+1, NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + CALL FIELD_NEW(SELF%F_PFCQNNG, UBOUNDS=[NPROMA, KLEV+1, NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + CALL FIELD_NEW(SELF%F_PFSQRF, UBOUNDS=[NPROMA, KLEV+1, NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + CALL FIELD_NEW(SELF%F_PFSQSF, UBOUNDS=[NPROMA, KLEV+1, NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + CALL FIELD_NEW(SELF%F_PFCQRNG, UBOUNDS=[NPROMA, KLEV+1, NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + CALL FIELD_NEW(SELF%F_PFCQSNG, UBOUNDS=[NPROMA, KLEV+1, NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + CALL FIELD_NEW(SELF%F_PFSQLTUR, UBOUNDS=[NPROMA, KLEV+1, NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + CALL FIELD_NEW(SELF%F_PFSQITUR, UBOUNDS=[NPROMA, KLEV+1, NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + CALL FIELD_NEW(SELF%F_PFPLSL, UBOUNDS=[NPROMA, KLEV+1, NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + CALL FIELD_NEW(SELF%F_PFPLSN, UBOUNDS=[NPROMA, KLEV+1, NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + CALL FIELD_NEW(SELF%F_PFHPSL, UBOUNDS=[NPROMA, KLEV+1, NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + CALL FIELD_NEW(SELF%F_PFHPSN, UBOUNDS=[NPROMA, KLEV+1, NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + END IF + + END SUBROUTINE FLUX_TYPE_INIT + + SUBROUTINE FLUX_TYPE_UPDATE_VIEW(SELF, BLOCK_INDEX) + CLASS(CLOUDSC_FLUX_TYPE) :: SELF + INTEGER(KIND=JPIM), INTENT(IN) :: BLOCK_INDEX + + IF(ASSOCIATED(SELF%F_PFSQLF)) SELF%PFSQLF => SELF%F_PFSQLF%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PFSQIF)) SELF%PFSQIF => SELF%F_PFSQIF%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PFCQLNG)) SELF%PFCQLNG => SELF%F_PFCQLNG%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PFCQNNG)) SELF%PFCQNNG => SELF%F_PFCQNNG%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PFSQRF)) SELF%PFSQRF => SELF%F_PFSQRF%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PFSQSF)) SELF%PFSQSF => SELF%F_PFSQSF%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PFCQRNG)) SELF%PFCQRNG => SELF%F_PFCQRNG%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PFCQSNG)) SELF%PFCQSNG => SELF%F_PFCQSNG%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PFSQLTUR)) SELF%PFSQLTUR => SELF%F_PFSQLTUR%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PFSQITUR)) SELF%PFSQITUR => SELF%F_PFSQITUR%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PFPLSL)) SELF%PFPLSL => SELF%F_PFPLSL%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PFPLSN)) SELF%PFPLSN => SELF%F_PFPLSN%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PFHPSL)) SELF%PFHPSL => SELF%F_PFHPSL%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_PFHPSN)) SELF%PFHPSN => SELF%F_PFHPSN%GET_VIEW(BLOCK_INDEX) + + END SUBROUTINE FLUX_TYPE_UPDATE_VIEW + + SUBROUTINE FLUX_TYPE_SYNC_HOST(SELF) + CLASS(CLOUDSC_FLUX_TYPE) :: SELF + + IF (SELF%PACKED) THEN + CALL SELF%DATA_WRONLY%SYNC_HOST_RDWR() + ELSE + CALL SELF%F_PFSQLF%SYNC_HOST_RDWR() + CALL SELF%F_PFSQIF%SYNC_HOST_RDWR() + CALL SELF%F_PFCQLNG%SYNC_HOST_RDWR() + CALL SELF%F_PFCQNNG%SYNC_HOST_RDWR() + CALL SELF%F_PFSQRF%SYNC_HOST_RDWR() + CALL SELF%F_PFSQSF%SYNC_HOST_RDWR() + CALL SELF%F_PFCQRNG%SYNC_HOST_RDWR() + CALL SELF%F_PFCQSNG%SYNC_HOST_RDWR() + CALL SELF%F_PFSQLTUR%SYNC_HOST_RDWR() + CALL SELF%F_PFSQITUR%SYNC_HOST_RDWR() + CALL SELF%F_PFPLSL%SYNC_HOST_RDWR() + CALL SELF%F_PFPLSN%SYNC_HOST_RDWR() + CALL SELF%F_PFHPSL%SYNC_HOST_RDWR() + CALL SELF%F_PFHPSN%SYNC_HOST_RDWR() + ENDIF + END SUBROUTINE FLUX_TYPE_SYNC_HOST + + SUBROUTINE FLUX_TYPE_FINAL(SELF) + CLASS(CLOUDSC_FLUX_TYPE) :: SELF + + IF (SELF%PACKED) THEN + CALL FIELD_DELETE(SELF%DATA_WRONLY) + DEALLOCATE(SELF%FIELDS_WRONLY) + ELSE + CALL FIELD_DELETE(SELF%F_PFSQLF) + CALL FIELD_DELETE(SELF%F_PFSQIF) + CALL FIELD_DELETE(SELF%F_PFCQLNG) + CALL FIELD_DELETE(SELF%F_PFCQNNG) + CALL FIELD_DELETE(SELF%F_PFSQRF) + CALL FIELD_DELETE(SELF%F_PFSQSF) + CALL FIELD_DELETE(SELF%F_PFCQRNG) + CALL FIELD_DELETE(SELF%F_PFCQSNG) + CALL FIELD_DELETE(SELF%F_PFSQLTUR) + CALL FIELD_DELETE(SELF%F_PFSQITUR) + CALL FIELD_DELETE(SELF%F_PFPLSL) + CALL FIELD_DELETE(SELF%F_PFPLSN) + CALL FIELD_DELETE(SELF%F_PFHPSL) + CALL FIELD_DELETE(SELF%F_PFHPSN) + ENDIF + END SUBROUTINE FLUX_TYPE_FINAL + +END MODULE CLOUDSC_FLUX_TYPE_MOD + diff --git a/src/common/module/cloudsc_state_type_mod.F90 b/src/common/module/cloudsc_state_type_mod.F90 new file mode 100644 index 00000000..804a15da --- /dev/null +++ b/src/common/module/cloudsc_state_type_mod.F90 @@ -0,0 +1,110 @@ +! (C) Copyright 1988- 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 CLOUDSC_STATE_TYPE_MOD + ! Driver module to manage the setup and teardown of the field-based state + USE PARKIND1, ONLY : JPIM, JPRB + USE YOECLDP, ONLY : NCLV + + USE FIELD_MODULE, ONLY: FIELD_2RB, FIELD_3RB, FIELD_4RB, FIELD_2IM, FIELD_2LM, FIELD_3RB_PTR + USE FIELD_FACTORY_MODULE, ONLY: FIELD_NEW, FIELD_DELETE + + IMPLICIT NONE + + + TYPE CLOUDSC_STATE_TYPE + + LOGICAL :: PACKED + REAL(KIND=JPRB), DIMENSION(:,:), POINTER :: T ! GMV FIELDS + REAL(KIND=JPRB), DIMENSION(:,:), POINTER :: Q, A ! GFL FIELDS + REAL(KIND=JPRB), DIMENSION(:,:,:), POINTER :: CLD ! COMPOSED CLOUD ARRAY + + CLASS(FIELD_3RB), POINTER :: F_T, F_A, F_Q + CLASS(FIELD_4RB), POINTER :: F_CLD + + CLASS(FIELD_4RB), POINTER :: FIELD_GANG + TYPE(FIELD_3RB_PTR), PRIVATE, ALLOCATABLE :: FIELD_PTRS(:) + + CONTAINS + PROCEDURE :: INIT => STATE_TYPE_INIT + PROCEDURE :: UPDATE_VIEW => STATE_TYPE_UPDATE_VIEW + PROCEDURE :: SYNC_HOST => STATE_TYPE_SYNC_HOST + PROCEDURE :: FINAL => STATE_TYPE_FINAL + + END TYPE CLOUDSC_STATE_TYPE + +CONTAINS + + SUBROUTINE STATE_TYPE_INIT(SELF,NPROMA, NGPTOT, KLON, KLEV, KFLDX, NBLOCKS, NGPTOTG, USE_PACKED) + CLASS(CLOUDSC_STATE_TYPE) :: SELF + INTEGER(KIND=JPIM), INTENT(IN) :: NPROMA, NGPTOT, KLON, KLEV, KFLDX, NBLOCKS + INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: NGPTOTG + LOGICAL, INTENT(IN), OPTIONAL :: USE_PACKED + + INTEGER(KIND=JPIM), PARAMETER :: NPACKED_FIELDS = 3 + + SELF%PACKED = .FALSE. + IF (PRESENT(USE_PACKED)) SELF%PACKED = USE_PACKED + + IF (SELF%PACKED) THEN + CALL FIELD_NEW(SELF%FIELD_GANG, SELF%FIELD_PTRS, UBOUNDS=[NPROMA,KLEV,NPACKED_FIELDS,NBLOCKS], & + & PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + SELF%F_T => SELF%FIELD_PTRS(1)%PTR + SELF%F_A => SELF%FIELD_PTRS(2)%PTR + SELF%F_Q => SELF%FIELD_PTRS(3)%PTR + ELSE + CALL FIELD_NEW(SELF%F_T, UBOUNDS=[NPROMA,KLEV,NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + CALL FIELD_NEW(SELF%F_A, UBOUNDS=[NPROMA,KLEV,NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + CALL FIELD_NEW(SELF%F_Q, UBOUNDS=[NPROMA,KLEV,NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + END IF + CALL FIELD_NEW(SELF%F_CLD, UBOUNDS=[NPROMA,KLEV,NCLV,NBLOCKS], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) + + END SUBROUTINE STATE_TYPE_INIT + + + SUBROUTINE STATE_TYPE_UPDATE_VIEW(SELF, BLOCK_INDEX) + CLASS(CLOUDSC_STATE_TYPE) :: SELF + INTEGER(KIND=JPIM), INTENT(IN) :: BLOCK_INDEX + + IF(ASSOCIATED(SELF%F_T)) SELF%T => SELF%F_T%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_Q)) SELF%Q => SELF%F_Q%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_A)) SELF%A => SELF%F_A%GET_VIEW(BLOCK_INDEX) + IF(ASSOCIATED(SELF%F_CLD)) SELF%CLD => SELF%F_CLD%GET_VIEW(BLOCK_INDEX) + + END SUBROUTINE STATE_TYPE_UPDATE_VIEW + + + SUBROUTINE STATE_TYPE_SYNC_HOST(SELF) + CLASS(CLOUDSC_STATE_TYPE) :: SELF + CALL SELF%F_T%SYNC_HOST_RDWR() + CALL SELF%F_Q%SYNC_HOST_RDWR() + CALL SELF%F_A%SYNC_HOST_RDWR() + CALL SELF%F_CLD%SYNC_HOST_RDWR() + ! Note , this deletion is done in the IFS, I am not sure, whether we wan't to do this in the cloudsc kernel + IF (ASSOCIATED(SELF%F_T)) CALL SELF%F_T%DELETE_DEVICE_DATA() + IF (ASSOCIATED(SELF%F_Q)) CALL SELF%F_Q%DELETE_DEVICE_DATA() + IF (ASSOCIATED(SELF%F_A)) CALL SELF%F_A%DELETE_DEVICE_DATA() + IF (ASSOCIATED(SELF%F_CLD)) CALL SELF%F_CLD%DELETE_DEVICE_DATA() + END SUBROUTINE STATE_TYPE_SYNC_HOST + + SUBROUTINE STATE_TYPE_FINAL(SELF) + CLASS(CLOUDSC_STATE_TYPE) :: SELF + IF (SELF%PACKED) THEN + CALL FIELD_DELETE(SELF%FIELD_GANG) + DEALLOCATE(SELF%FIELD_GANG) + ELSE + CALL FIELD_DELETE(SELF%F_T) + CALL FIELD_DELETE(SELF%F_Q) + CALL FIELD_DELETE(SELF%F_A) + END IF + CALL FIELD_DELETE(SELF%F_CLD) + END SUBROUTINE STATE_TYPE_FINAL + +END MODULE CLOUDSC_STATE_TYPE_MOD +