diff --git a/.github/workflows/build-hpc.yml b/.github/workflows/build-hpc.yml index 5b562422..6f082def 100644 --- a/.github/workflows/build-hpc.yml +++ b/.github/workflows/build-hpc.yml @@ -7,7 +7,7 @@ on: push: branches: - master-acc - - feature/master-acc-build-hpc + - feature/master-acc* tags-ignore: - '**' diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index a8e914ac..090416b7 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -31,24 +31,24 @@ jobs: matrix: build_type: [Release,Bit,Debug] name: - - linux gnu-12 - - linux nvhpc-24.3 + - linux gnu-13 + - linux nvhpc-25.9 - linux intel-classic - linux intel-llvm include: - - name: linux gnu-12 - os: ubuntu-22.04 - compiler: gnu-12 - compiler_cc: gcc-12 - compiler_cxx: g++-12 - compiler_fc: gfortran-12 + - name: linux gnu-13 + os: ubuntu-24.04 + compiler: gnu-13 + compiler_cc: gcc-13 + compiler_cxx: g++-13 + compiler_fc: gfortran-13 caching: true - - name: linux nvhpc-24.3 - os: ubuntu-22.04 - compiler: nvhpc-24.3 + - name: linux nvhpc-25.9 + os: ubuntu-24.04 + compiler: nvhpc compiler_cc: nvc compiler_cxx: nvc++ compiler_fc: nvfortran @@ -122,7 +122,7 @@ jobs: if: contains( matrix.compiler, 'nvhpc' ) shell: bash -eux {0} run: | - ${ECRAD_TOOLS}/install-nvhpc.sh --prefix /opt/nvhpc --version 24.3 + ${ECRAD_TOOLS}/install-nvhpc.sh --prefix /opt/nvhpc --version 25.9 source /opt/nvhpc/env.sh echo "${NVHPC_DIR}/compilers/bin" >> $GITHUB_PATH echo "NVHPC_ROOT=${NVHPC_DIR}" >> $GITHUB_ENV @@ -180,14 +180,41 @@ jobs: dependencies: | ecmwf/ecbuild ecmwf-ifs/fiat + ecmwf-ifs/field_api@refs/heads/main dependency_branch: develop dependency_cmake_options: | ecmwf-ifs/fiat: "-G Ninja -DCMAKE_BUILD_TYPE=${{ matrix.build_type }} -DENABLE_TESTS=OFF" + ecmwf-ifs/field_api: "-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_SINGLE_PRECISION=ON -DENABLE_BITIDENTITY_TESTING=ON -DENABLE_ACC=OFF" ctest_options: "--output-on-failure ${{ matrix.ctest_options }}" -# - name: Codecov Upload -# if: steps.build-test.outputs.coverage_file -# uses: codecov/codecov-action@v2 -# with: -# files: ${{ steps.build-test.outputs.coverage_file }} + make: + name: Makefile build + + strategy: + fail-fast: false # false: try to complete all jobs + + matrix: + name: + - linux gnu + + include: + + - name: linux gnu + os: ubuntu-24.04 + profile: gfortran + + runs-on: ${{ matrix.os }} + steps: + - name: Checkout Repository + uses: actions/checkout@v4 + + - name: Install dependencies + run: | + sudo apt-get update + sudo apt-get install libnetcdff-dev nco + + - name: Build & Test + run: | + make PROFILE=${{ matrix.profile }} -j + make test PROFILE=${{ matrix.profile }} diff --git a/.gitignore b/.gitignore index 606fae7f..2bf0533b 100644 --- a/.gitignore +++ b/.gitignore @@ -7,7 +7,7 @@ config_*.nam /mod /practical/data /practical/ecrad -/build +/build* *.mod /bin/ecrad /bin/ecrad_ifs diff --git a/CMakeLists.txt b/CMakeLists.txt index 0f0dc795..ad06422c 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -58,6 +58,21 @@ if( HAVE_FIAT AND fiat_HAVE_MPI ) list( APPEND ECRAD_COMPILE_DEFINITIONS EASY_NETCDF_READ_MPI ) endif() +ecbuild_add_option( + FEATURE FIELD_API + DEFAULT ON + DESCRIPTION "Enable FIELD_API-based driver variant" + REQUIRED_PACKAGES "field_api" +) + +find_program(FYPP fypp) +ecbuild_add_option( + FEATURE FYPP + DEFAULT OFF + DESCRIPTION "Use FYPP to re-generate Fortran code for FIELD_API-based driver variant" + CONDITION NOT FYPP-NOTFOUND +) + ecbuild_add_option( FEATURE OMP DEFAULT ON diff --git a/driver/CMakeLists.txt b/driver/CMakeLists.txt index 7c291b89..7958d8e8 100644 --- a/driver/CMakeLists.txt +++ b/driver/CMakeLists.txt @@ -17,11 +17,17 @@ ecbuild_add_library( PUBLIC_DEFINITIONS $<$:NO_OPENMP> ${GPU_OFFLOAD}GPU + PUBLIC_INCLUDES + "$" PUBLIC_LIBS ecrad.${PREC} ecrad_base.${PREC} $<${HAVE_OMP}:OpenMP::OpenMP_Fortran> ) +set_target_properties( driver_lib.${PREC} + PROPERTIES + Fortran_MODULE_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}/module_driver_lib" +) ecbuild_add_executable( TARGET ecrad_${PREC} @@ -48,7 +54,6 @@ ecbuild_add_executable( TARGET ecrad_ifs_blocked_${PREC} SOURCES ecrad_ifs_driver_blocked.F90 - ifs_blocking.F90 LIBS ifs.${PREC} driver_lib.${PREC} @@ -81,24 +86,38 @@ if( CMAKE_BUILD_TYPE MATCHES "Debug" ) endif() endif() +if( HAVE_FIELD_API ) + ecbuild_add_executable( + TARGET ecrad_ifs_field_api_${PREC} + SOURCES + ecrad_ifs_driver_field_api.F90 + LIBS + ifs_field_api.${PREC} + driver_lib.${PREC} + LINKER_LANGUAGE Fortran + ) +endif() + # Create a symlink for each driver without the precision suffix. # The default is to link to the double precision version if it is built, # and single precision otherwise. if ( "${PREC}" STREQUAL "dp" OR NOT HAVE_DOUBLE_PRECISION ) - foreach( tgt ecrad ecrad_ifs ecrad_ifs_blocked ) - add_custom_command( - TARGET ${tgt}_${PREC} - POST_BUILD - COMMAND - "${CMAKE_COMMAND}" -E create_symlink ${tgt}_${PREC} ${tgt} - BYPRODUCTS ${tgt} - WORKING_DIRECTORY - "${CMAKE_BINARY_DIR}/bin" - COMMENT "Creating symbolic link from ${tgt} to ${tgt}_${PREC}" - ) - install( - FILES ${CMAKE_BINARY_DIR}/bin/${tgt} - DESTINATION bin - ) + foreach( tgt ecrad ecrad_ifs ecrad_ifs_blocked ecrad_ifs_field_api ) + if( TARGET ${tgt}_${PREC} ) + add_custom_command( + TARGET ${tgt}_${PREC} + POST_BUILD + COMMAND + "${CMAKE_COMMAND}" -E create_symlink ${tgt}_${PREC} ${tgt} + BYPRODUCTS ${tgt} + WORKING_DIRECTORY + "${CMAKE_BINARY_DIR}/bin" + COMMENT "Creating symbolic link from ${tgt} to ${tgt}_${PREC}" + ) + install( + FILES ${CMAKE_BINARY_DIR}/bin/${tgt} + DESTINATION bin + ) + endif() endforeach() endif() diff --git a/driver/Makefile b/driver/Makefile index 83a39b5c..50cbfbd7 100644 --- a/driver/Makefile +++ b/driver/Makefile @@ -28,7 +28,7 @@ $(IFS_EXECUTABLE): $(OBJECTS) ../lib/*.a ecrad_ifs_driver.o $(FC) $(FCFLAGS) ecrad_ifs_driver.o $(OBJECTS) -lifs $(LIBS) -o $(IFS_EXECUTABLE) $(IFS_BLOCKED_EXECUTABLE): $(OBJECTS) ../lib/*.a ecrad_ifs_driver_blocked.o - $(FC) $(FCFLAGS) ifs_blocking.o ecrad_ifs_driver_blocked.o $(OBJECTS) -lifs $(LIBS) -o $(IFS_BLOCKED_EXECUTABLE) + $(FC) $(FCFLAGS) ecrad_ifs_driver_blocked.o $(OBJECTS) -lifs $(LIBS) -o $(IFS_BLOCKED_EXECUTABLE) test_%: test_%.F90 ../lib/*.a $(FC) $(FCFLAGS) $< $(LIBS) -o $@ diff --git a/driver/Makefile_deps b/driver/Makefile_deps index cac881d2..87afff45 100644 --- a/driver/Makefile_deps +++ b/driver/Makefile_deps @@ -1,5 +1,4 @@ ecrad_driver.o: ecrad_driver_config.o ecrad_driver_read_input.o ecrad_driver_read_input.o: ecrad_driver_config.o -ecrad_ifs_driver_blocked.o: ecrad_driver_config.o ecrad_driver_read_input.o ifs_blocking.o +ecrad_ifs_driver_blocked.o: ecrad_driver_config.o ecrad_driver_read_input.o ecrad_ifs_driver.o: ecrad_driver_config.o ecrad_driver_read_input.o -ifs_blocking.o: ecrad_driver_config.o diff --git a/driver/ecrad_driver.F90 b/driver/ecrad_driver.F90 index 076915fd..f81f518f 100644 --- a/driver/ecrad_driver.F90 +++ b/driver/ecrad_driver.F90 @@ -54,7 +54,7 @@ program ecrad_driver use ecrad_driver_config, only : driver_config_type use ecrad_driver_read_input, only : read_input use easy_netcdf - use print_matrix_mod, only : print_matrix + ! use print_matrix_mod, only : print_matrix implicit none @@ -96,7 +96,7 @@ program ecrad_driver integer, external :: omp_get_thread_num real(kind=jprd), external :: omp_get_wtime ! Start/stop time in seconds - real(kind=jprd) :: tstart, tstop, t0 + real(kind=jprd) :: tstart=0.0, tstop, t0 #endif ! For demonstration of get_sw_weights later on diff --git a/driver/ecrad_ifs_driver.F90 b/driver/ecrad_ifs_driver.F90 index 327767c0..117b2abb 100644 --- a/driver/ecrad_ifs_driver.F90 +++ b/driver/ecrad_ifs_driver.F90 @@ -197,6 +197,10 @@ program ecrad_ifs_driver call yradiation%rad_config%read(file_name=file_name) +#ifdef _OPENACC + yradiation%yrerad%lecrad_on_gpu = .true. +#endif + ! Setup aerosols if (yradiation%rad_config%use_aerosols) then yradiation%yrerad%naermacc = 1 ! MACC-derived aerosol climatology on a NMCLAT x NMCLON grid @@ -482,7 +486,7 @@ program ecrad_ifs_driver & pcloud_overlap=cloud%overlap_param, & & iseed=single_level%iseed & #endif - & ) + & ,lacc=yradiation%yrerad%lecrad_on_gpu) end do #ifndef _OPENACC !$OMP END PARALLEL DO diff --git a/driver/ecrad_ifs_driver_blocked.F90 b/driver/ecrad_ifs_driver_blocked.F90 index 345c131f..f657e7a3 100644 --- a/driver/ecrad_ifs_driver_blocked.F90 +++ b/driver/ecrad_ifs_driver_blocked.F90 @@ -67,8 +67,9 @@ program ecrad_ifs_driver use radiation_constants, only : Pi use ecrad_driver_config, only : driver_config_type use ecrad_driver_read_input, only : read_input + use radintg_zrgp_mod, only : radintg_zrgp_type + use ifs_blocking, only : ifs_copy_inputs_to_blocked, ifs_copy_fluxes_from_blocked use easy_netcdf - use ifs_blocking #ifdef HAVE_NVTX use nvtx #endif @@ -97,14 +98,14 @@ program ecrad_ifs_driver type(flux_type) :: flux ! Additional arrays passed to radiation_scheme - real(jprb), allocatable, dimension(:) :: ccn_land, ccn_sea, sin_latitude, longitude_rad, land_frac + real(jprb), allocatable, dimension(:) :: sin_latitude, longitude_rad, land_frac real(jprb), allocatable, dimension(:,:) :: pressure_fl, temperature_fl real(jprb), allocatable, dimension(:) :: flux_sw_direct_normal, flux_uv, flux_par, flux_par_clear, & & emissivity_out real(jprb), allocatable, dimension(:,:) :: flux_diffuse_band, flux_direct_band ! Bespoke data types to set-up the blocked memory layout - type(ifs_config_type) :: ifs_config + type(radintg_zrgp_type) :: zrgp_fields real(kind=jprb), allocatable :: zrgp(:,:,:) ! monolithic IFS data structure #ifdef BITIDENTITY_TESTING integer, allocatable :: iseed(:,:) ! Seed for random number generator @@ -216,6 +217,10 @@ program ecrad_ifs_driver call yradiation%rad_config%read(file_name=file_name) +#ifdef _OPENACC + yradiation%yrerad%lecrad_on_gpu = .true. +#endif + ! Setup aerosols if (yradiation%rad_config%use_aerosols) then yradiation%yrerad%naermacc = 1 ! MACC-derived aerosol climatology on a NMCLAT x NMCLON grid @@ -354,8 +359,6 @@ program ecrad_ifs_driver flux%lw_derivatives(:,:) = 0._jprb ! Allocate memory for additional arrays - allocate(ccn_land(ncol)) - allocate(ccn_sea(ncol)) allocate(land_frac(ncol)) allocate(pressure_fl(ncol,nlev)) allocate(temperature_fl(ncol,nlev)) @@ -367,8 +370,6 @@ program ecrad_ifs_driver allocate(flux_diffuse_band(ncol,yradiation%yrerad%nsw)) allocate(flux_direct_band(ncol,yradiation%yrerad%nsw)) - ccn_land = yradiation%yrerad%rccnlnd - ccn_sea = yradiation%yrerad%rccnsea pressure_fl = 0.5_jprb * (thermodynamics%pressure_hl(:,1:nlev)+thermodynamics%pressure_hl(:,2:nlev+1)) temperature_fl = 0.5_jprb * (thermodynamics%temperature_hl(:,1:nlev)+thermodynamics%temperature_hl(:,2:nlev+1)) @@ -376,9 +377,16 @@ program ecrad_ifs_driver ! Section 4a: Reshuffle into blocked memory layout ! -------------------------------------------------------- - call ifs_setup_indices(driver_config, ifs_config, yradiation, nlev) - call ifs_copy_inputs_to_blocked(driver_config, ifs_config, yradiation,& - & ncol, nlev, single_level, thermodynamics, gas, cloud, aerosol,& + call zrgp_fields%setup(nlev, & + & yradiation%yrerad%nlwemiss, yradiation%yrerad%nlwout, & + & yradiation%yrerad%nsw, 0, 0, 0, & + & yradiation%rad_config%n_aerosol_types, & + & driver_config%iverbose>4, .false., .false., & + & yradiation%yrerad%lapproxlwupdate, yradiation%yrerad%lapproxswupdate, & + & .false., yradiation%yrerad%ldiagforcing) + + call ifs_copy_inputs_to_blocked(zrgp_fields, yradiation,& + & ncol, nlev, nproma, single_level, thermodynamics, gas, cloud, aerosol,& & sin_latitude, longitude_rad, land_frac, pressure_fl, temperature_fl,& & zrgp & #ifdef BITIDENTITY_TESTING @@ -409,8 +417,8 @@ program ecrad_ifs_driver !$acc& async(2) next_il = min(nproma,ncol) - !$acc update device(zrgp(:,ifs_config%iinbeg:ifs_config%iinend,1), & - !$acc& zrgp(:,ifs_config%ioutend+1:ifs_config%ifldstot,1)) async(2) + !$acc update device(zrgp(:,zrgp_fields%iinbeg:zrgp_fields%iinend,1), & + !$acc& zrgp(:,zrgp_fields%ioutend+1:zrgp_fields%ifldstot,1)) async(2) #endif #ifndef NO_OPENMP @@ -450,8 +458,8 @@ program ecrad_ifs_driver !$acc& async(2) wait(2) next_il = min(iend+nproma,ncol) - (ibeg+nproma) + 1 - !$acc update device(zrgp(:,ifs_config%iinbeg:ifs_config%iinend,ib+1), & - !$acc& zrgp(:,ifs_config%ioutend+1:ifs_config%ifldstot,ib+1)) async(2) + !$acc update device(zrgp(:,zrgp_fields%iinbeg:zrgp_fields%iinend,ib+1), & + !$acc& zrgp(:,zrgp_fields%ioutend+1:zrgp_fields%ifldstot,ib+1)) async(2) endif #else /* COPY_ASYNC */ @@ -462,8 +470,14 @@ program ecrad_ifs_driver #endif !$acc& - !$acc update device(zrgp(1:il,ifs_config%iinbeg:ifs_config%iinend,ib), & - !$acc& zrgp(1:il,ifs_config%ioutend+1:ifs_config%ifldstot,ib)) & + !$acc update device(zrgp(1:il,zrgp_fields%iinbeg:zrgp_fields%iinend,ib), & + !$acc& zrgp(1:il,zrgp_fields%ioutend+1:zrgp_fields%ifldstot,ib)) & + !$acc& async(1) + + ! iaero is an input and output variable but only listed as an output variable in zrgp_fields; + ! to work around this, we explicitly offload it here + !$acc update device( & + !$acc& zrgp(1:il,zrgp_fields%iaero:zrgp_fields%iaero+yradiation%rad_config%n_aerosol_types*nlev,ib)) & !$acc& async(1) #endif /* COPY_ASYNC */ @@ -474,48 +488,48 @@ program ecrad_ifs_driver & nlev, size(aerosol%mixing_ratio,3), & ! nlev, naerosols & single_level%solar_irradiance, & ! solar_irrad ! array inputs - & zrgp(:,ifs_config%iamu0,ib), zrgp(:,ifs_config%its,ib), & ! mu0, skintemp - & zrgp(:,ifs_config%iald,ib) , zrgp(:,ifs_config%ialp,ib), & ! albedo_dif, albedo_dir - & zrgp(:,ifs_config%iemiss,ib), & ! spectral emissivity - & zrgp(:,ifs_config%iccnl,ib), zrgp(:,ifs_config%iccno,ib) ,& ! CCN concentration, land and sea - & zrgp(:,ifs_config%igelam,ib),zrgp(:,ifs_config%igemu,ib), & ! longitude, sine of latitude - & zrgp(:,ifs_config%islm,ib), & ! land sea mask - & zrgp(:,ifs_config%ipr,ib), zrgp(:,ifs_config%iti,ib), & ! full level pressure and temperature - & zrgp(:,ifs_config%iaprs,ib), zrgp(:,ifs_config%ihti,ib), & ! half-level pressure and temperature - & zrgp(:,ifs_config%iwv,ib), zrgp(:,ifs_config%iico2,ib), & - & zrgp(:,ifs_config%iich4,ib), zrgp(:,ifs_config%iin2o,ib), & - & zrgp(:,ifs_config%ino2,ib), zrgp(:,ifs_config%ic11,ib), & - & zrgp(:,ifs_config%ic12,ib), zrgp(:,ifs_config%ic22,ib), & - & zrgp(:,ifs_config%icl4,ib), zrgp(:,ifs_config%ioz,ib), & - & zrgp(:,ifs_config%iclc,ib), zrgp(:,ifs_config%ilwa,ib), & - & zrgp(:,ifs_config%iiwa,ib), zrgp(:,ifs_config%irwa,ib), & - & zrgp(:,ifs_config%iswa,ib), & - & zrgp(:,ifs_config%iaer,ib), zrgp(:,ifs_config%iaero,ib), & + & zrgp(:,zrgp_fields%iamu0,ib), zrgp(:,zrgp_fields%its,ib), & ! mu0, skintemp + & zrgp(:,zrgp_fields%iald,ib) , zrgp(:,zrgp_fields%ialp,ib), & ! albedo_dif, albedo_dir + & zrgp(:,zrgp_fields%iemiss,ib), & ! spectral emissivity + & zrgp(:,zrgp_fields%iccnl,ib), zrgp(:,zrgp_fields%iccno,ib) ,& ! CCN concentration, land and sea + & zrgp(:,zrgp_fields%igelam,ib),zrgp(:,zrgp_fields%igemu,ib), & ! longitude, sine of latitude + & zrgp(:,zrgp_fields%islm,ib), & ! land sea mask + & zrgp(:,zrgp_fields%ipr,ib), zrgp(:,zrgp_fields%iti,ib), & ! full level pressure and temperature + & zrgp(:,zrgp_fields%iaprs,ib), zrgp(:,zrgp_fields%ihti,ib), & ! half-level pressure and temperature + & zrgp(:,zrgp_fields%iwv,ib), zrgp(:,zrgp_fields%iico2,ib), & + & zrgp(:,zrgp_fields%iich4,ib), zrgp(:,zrgp_fields%iin2o,ib), & + & zrgp(:,zrgp_fields%ino2,ib), zrgp(:,zrgp_fields%ic11,ib), & + & zrgp(:,zrgp_fields%ic12,ib), zrgp(:,zrgp_fields%ic22,ib), & + & zrgp(:,zrgp_fields%icl4,ib), zrgp(:,zrgp_fields%ioz,ib), & + & zrgp(:,zrgp_fields%iclc,ib), zrgp(:,zrgp_fields%ilwa,ib), & + & zrgp(:,zrgp_fields%iiwa,ib), zrgp(:,zrgp_fields%irwa,ib), & + & zrgp(:,zrgp_fields%iswa,ib), & + & zrgp(:,zrgp_fields%iaer,ib), zrgp(:,zrgp_fields%iaero,ib), & ! flux outputs - & zrgp(:,ifs_config%ifrso,ib), zrgp(:,ifs_config%ifrth,ib), & - & zrgp(:,ifs_config%iswfc,ib), zrgp(:,ifs_config%ilwfc,ib),& - & zrgp(:,ifs_config%ifrsod,ib),zrgp(:,ifs_config%ifrted,ib), & - & zrgp(:,ifs_config%ifrsodc,ib),zrgp(:,ifs_config%ifrtedc,ib),& - & zrgp(:,ifs_config%ifdir,ib), zrgp(:,ifs_config%icdir,ib), & - & zrgp(:,ifs_config%isudu,ib), & - & zrgp(:,ifs_config%iuvdf,ib), zrgp(:,ifs_config%iparf,ib), & - & zrgp(:,ifs_config%iparcf,ib),zrgp(:,ifs_config%itincf,ib), & - & zrgp(:,ifs_config%iemit,ib) ,zrgp(:,ifs_config%ilwderivative,ib), & - & zrgp(:,ifs_config%iswdiffuseband,ib), zrgp(:,ifs_config%iswdirectband,ib)& + & zrgp(:,zrgp_fields%ifrso,ib), zrgp(:,zrgp_fields%ifrth,ib), & + & zrgp(:,zrgp_fields%iswfc,ib), zrgp(:,zrgp_fields%ilwfc,ib),& + & zrgp(:,zrgp_fields%ifrsod,ib),zrgp(:,zrgp_fields%ifrted,ib), & + & zrgp(:,zrgp_fields%ifrsodc,ib),zrgp(:,zrgp_fields%ifrtedc,ib),& + & zrgp(:,zrgp_fields%ifdir,ib), zrgp(:,zrgp_fields%icdir,ib), & + & zrgp(:,zrgp_fields%isudu,ib), & + & zrgp(:,zrgp_fields%iuvdf,ib), zrgp(:,zrgp_fields%iparf,ib), & + & zrgp(:,zrgp_fields%iparcf,ib),zrgp(:,zrgp_fields%itincf,ib), & + & zrgp(:,zrgp_fields%iemit,ib) ,zrgp(:,zrgp_fields%ilwderivative,ib), & + & zrgp(:,zrgp_fields%iswdiffuseband,ib), zrgp(:,zrgp_fields%iswdirectband,ib)& #ifdef BITIDENTITY_TESTING ! To validate results against standalone ecrad, we overwrite effective ! radii, cloud overlap and seed with input values - & ,pre_liq=zrgp(:,ifs_config%ire_liq,ib), & - & pre_ice=zrgp(:,ifs_config%ire_ice,ib), & - & pcloud_overlap=zrgp(:,ifs_config%ioverlap,ib), & + & ,pre_liq=zrgp(:,zrgp_fields%ire_liq,ib), & + & pre_ice=zrgp(:,zrgp_fields%ire_ice,ib), & + & pcloud_overlap=zrgp(:,zrgp_fields%ioverlap,ib), & & iseed=iseed(:,ib) & #endif - & ) + & ,lacc=yradiation%yrerad%lecrad_on_gpu) #ifdef COPY_ASYNC - !$acc update host(zrgp(:,ifs_config%ioutbeg:ifs_config%ioutend,ib)) async(3) wait(1) + !$acc update host(zrgp(:,zrgp_fields%ioutbeg:zrgp_fields%ioutend,ib)) async(3) wait(1) !$acc exit data delete(zrgp(:,:,ib)) async(3) #else - !$acc update host(zrgp(1:il,ifs_config%ioutbeg:ifs_config%ioutend,ib)) async(1) + !$acc update host(zrgp(1:il,zrgp_fields%ioutbeg:zrgp_fields%ioutend,ib)) async(1) !$acc end data #endif end do @@ -556,7 +570,7 @@ program ecrad_ifs_driver ! Section 4c: Copy fluxes from blocked memory data ! -------------------------------------------------------- - call ifs_copy_fluxes_from_blocked(driver_config, ifs_config, yradiation, ncol, nlev,& + call ifs_copy_fluxes_from_blocked(zrgp_fields, yradiation, ncol, nlev, nproma, & & zrgp, flux, flux_sw_direct_normal, flux_uv, flux_par, flux_par_clear, & & emissivity_out, flux_diffuse_band, flux_direct_band) diff --git a/driver/ecrad_ifs_driver_field_api.F90 b/driver/ecrad_ifs_driver_field_api.F90 new file mode 100644 index 00000000..dd690400 --- /dev/null +++ b/driver/ecrad_ifs_driver_field_api.F90 @@ -0,0 +1,491 @@ +! ecrad_ifs_driver_field_api.F90 - Driver for offline ECRAD radiation scheme +! +! (C) Copyright 2014- 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. +! +! Author: Robin Hogan +! Email: r.j.hogan@ecmwf.int +! +! ECRAD is the radiation scheme used in the ECMWF Integrated +! Forecasting System in cycle 43R3 and later. Several solvers are +! available, including McICA, Tripleclouds and SPARTACUS (the Speedy +! Algorithm for Radiative Transfer through Cloud Sides, a modification +! of the two-stream formulation of shortwave and longwave radiative +! transfer to account for 3D radiative effects). Gas optical +! properties are provided by the RRTM-G gas optics scheme. + +! This program takes three arguments: +! 1) Namelist file to configure the radiation calculation, but note +! that only the radiation_config group is read +! 2) Name of a NetCDF file containing one or more atmospheric profiles +! 3) Name of output NetCDF file +! +! This version uses the infrastructure of the IFS, such as computing +! effective radius and cloud overlap from latitude and other +! variables. To configure ecRad in this version you need to edit +! ifs/yoerad.F90 in the ecRad package, but these options can be +! overridden with the "radiation" namelist. This file requires the +! input data to have compatible settings, e.g. the right number of +! aerosol variables, and surface albedo/emissivity bands; a test file +! satisfying this requirement is test/ifs/ecrad_meridian.nc in the +! ecRad package. +! +! Note that the purpose of this file is simply to demonstrate the use +! of the setup_radiation_scheme and radiation_scheme routines as well +! as the use of a blocked memory layout to improve cache efficiency; +! all the rest is using the offline ecRad driver containers to read +! a NetCDF file to memory and pass it into these routines. + +program ecrad_ifs_driver + + ! -------------------------------------------------------- + ! Section 1: Declarations + ! -------------------------------------------------------- + use parkind1, only : jprb, jprd ! Working/double precision + use yomhook, only : dr_hook_init +#ifdef HAVE_FIAT + use mpl_module, only : mpl_init, mpl_end +#endif + + use radiation_io, only : nulout + use radiation_single_level, only : single_level_type + use radiation_thermodynamics, only : thermodynamics_type + use radiation_gas, only : gas_type, IMassMixingRatio, & + & IH2O, ICO2, IO3, IN2O, INO2, ICO, ICH4, IO2, ICFC11, ICFC12, & + & IHCFC22, ICCl4 + use radiation_cloud, only : cloud_type + use radiation_aerosol, only : aerosol_type + use radiation_flux, only : flux_type + use radiation_save, only : save_net_fluxes + use radiation_setup, only : tradiation, setup_radiation_scheme + use radiation_constants, only : Pi + use ecrad_driver_config, only : driver_config_type + use ecrad_driver_read_input, only : read_input + use radintg_zrgp_mod, only : radintg_zrgp_type + use ifs_blocking, only : ifs_copy_inputs_to_blocked, ifs_copy_fluxes_from_blocked + use radiation_scheme_layer_mod, only : radiation_scheme_layer + use easy_netcdf + + implicit none + +#include "radiation_scheme.intfb.h" + + ! The NetCDF file containing the input profiles + type(netcdf_file) :: file + + ! Configuration for the radiation scheme, IFS style + type(tradiation) :: yradiation + + ! Derived types for the inputs to the radiation scheme + type(single_level_type) :: single_level + type(thermodynamics_type) :: thermodynamics + type(gas_type) :: gas + type(cloud_type) :: cloud + type(aerosol_type) :: aerosol + + ! Configuration specific to this driver + type(driver_config_type) :: driver_config + + ! Derived type containing outputs from the radiation scheme + type(flux_type) :: flux + + ! Additional arrays passed to radiation_scheme + real(jprb), allocatable, dimension(:) :: sin_latitude, longitude_rad, land_frac + real(jprb), allocatable, dimension(:,:) :: pressure_fl, temperature_fl + real(jprb), allocatable, dimension(:) :: flux_sw_direct_normal, flux_uv, flux_par, flux_par_clear, & + & emissivity_out + real(jprb), allocatable, dimension(:,:) :: flux_diffuse_band, flux_direct_band + + ! Bespoke data types to set-up the blocked memory layout + type(radintg_zrgp_type) :: zrgp_fields + ! type(ifs_config_type) :: ifs_config + real(kind=jprb), allocatable :: zrgp(:,:,:) ! monolithic IFS data structure +#ifdef BITIDENTITY_TESTING + integer, allocatable :: iseed(:,:) ! Seed for random number generator +#endif + + integer :: ncol, nlev ! Number of columns and levels + integer :: nproma ! block size + + ! Name of file names specified on command line + character(len=512) :: file_name + integer :: istatus ! Result of command_argument_count + +#ifndef NO_OPENMP + ! OpenMP functions + integer, external :: omp_get_thread_num + real(kind=jprd), external :: omp_get_wtime + ! Start/stop time in seconds + real(kind=jprd) :: tstart, tstop +#endif + + ! For demonstration of get_sw_weights later on + ! Ultraviolet weightings + !integer :: nweight_uv + !integer :: iband_uv(100) + !real(jprb) :: weight_uv(100) + ! Photosynthetically active radiation weightings + !integer :: nweight_par + !integer :: iband_par(100) + !real(jprb) :: weight_par(100) + + ! Loop index for repeats (for benchmarking) + integer :: jrepeat + + ! Loop index + integer :: jrl, ibeg, iend, il, ib + + ! Are any variables out of bounds? + logical :: is_out_of_bounds + +! integer :: iband(20), nweights +! real(jprb) :: weight(20) + + ! Initialise MPI if not done yet +#ifdef HAVE_FIAT + call mpl_init +#endif + + call dr_hook_init() + + ! -------------------------------------------------------- + ! Section 2: Configure + ! -------------------------------------------------------- + + ! Check program called with correct number of arguments + if (command_argument_count() < 3) then + stop 'Usage: ecrad config.nam input_file.nc output_file.nc' + end if + + ! Use namelist to configure the radiation calculation + call get_command_argument(1, file_name, status=istatus) + if (istatus /= 0) then + stop 'Failed to read name of namelist file as string of length < 512' + end if + + ! Read "radiation_driver" namelist into radiation driver config type + call driver_config%read(file_name) + nproma = driver_config%nblocksize + + if (driver_config%iverbose >= 2) then + write(nulout,'(a)') '-------------------------- OFFLINE ECRAD RADIATION SCHEME --------------------------' + write(nulout,'(a)') 'Copyright (C) 2014- ECMWF' + write(nulout,'(a)') 'Contact: Robin Hogan (r.j.hogan@ecmwf.int)' +#ifdef PARKIND1_SINGLE + write(nulout,'(a)') 'Floating-point precision: single' +#else + write(nulout,'(a)') 'Floating-point precision: double' +#endif + end if + + ! Albedo/emissivity intervals may be specified like this + !call config%define_sw_albedo_intervals(6, & + ! & [0.25e-6_jprb, 0.44e-6_jprb, 0.69e-6_jprb, & + ! & 1.19_jprb, 2.38e-6_jprb], [1,2,3,4,5,6], & + ! & do_nearest=.false.) + !call config%define_lw_emiss_intervals(3, & + ! & [8.0e-6_jprb, 13.0e-6_jprb], [1,2,1], & + ! & do_nearest=.false.) + + ! If monochromatic aerosol properties are required, then the + ! wavelengths can be specified (in metres) as follows - these can be + ! whatever you like for the general aerosol optics, but must match + ! the monochromatic values in the aerosol input file for the older + ! aerosol optics + !call config%set_aerosol_wavelength_mono( & + ! & [3.4e-07_jprb, 3.55e-07_jprb, 3.8e-07_jprb, 4.0e-07_jprb, 4.4e-07_jprb, & + ! & 4.69e-07_jprb, 5.0e-07_jprb, 5.32e-07_jprb, 5.5e-07_jprb, 6.45e-07_jprb, & + ! & 6.7e-07_jprb, 8.0e-07_jprb, 8.58e-07_jprb, 8.65e-07_jprb, 1.02e-06_jprb, & + ! & 1.064e-06_jprb, 1.24e-06_jprb, 1.64e-06_jprb, 2.13e-06_jprb, 1.0e-05_jprb]) + + call yradiation%rad_config%read(file_name=file_name) + +#ifdef _OPENACC + yradiation%yrerad%lecrad_on_gpu = .true. +#endif + + ! Setup aerosols + if (yradiation%rad_config%use_aerosols) then + yradiation%yrerad%naermacc = 1 ! MACC-derived aerosol climatology on a NMCLAT x NMCLON grid + else + yradiation%yrerad%naermacc = 0 + endif + + ! Setup the radiation scheme: load the coefficients for gas and + ! cloud optics, currently from RRTMG + call setup_radiation_scheme(yradiation, .true., file_name=file_name) + ! Or call without specifying the namelist filename, in which case + ! the default settings are from yoerad.F90 + !call setup_radiation_scheme(yradiation, .true.) + + ! Demonstration of how to get weights for UV and PAR fluxes + !if (config%do_sw) then + ! call config%get_sw_weights(0.2e-6_jprb, 0.4415e-6_jprb,& + ! & nweight_uv, iband_uv, weight_uv,& + ! & 'ultraviolet') + ! call config%get_sw_weights(0.4e-6_jprb, 0.7e-6_jprb,& + ! & nweight_par, iband_par, weight_par,& + ! & 'photosynthetically active radiation, PAR') + !end if + + ! -------------------------------------------------------- + ! Section 3: Read input data file + ! -------------------------------------------------------- + + ! Get NetCDF input file name + call get_command_argument(2, file_name, status=istatus) + if (istatus /= 0) then + stop 'Failed to read name of input NetCDF file as string of length < 512' + end if + + ! Open the file and configure the way it is read + call file%open(trim(file_name), iverbose=driver_config%iverbose) + + ! Get NetCDF output file name + call get_command_argument(3, file_name, status=istatus) + if (istatus /= 0) then + stop 'Failed to read name of output NetCDF file as string of length < 512' + end if + + ! 2D arrays are assumed to be stored in the file with height varying + ! more rapidly than column index. Specifying "true" here transposes + ! all 2D arrays so that the column index varies fastest within the + ! program. + call file%transpose_matrices(.true.) + + ! Read input variables from NetCDF file, noting that cloud overlap + ! and effective radius are ignored + call read_input(file, yradiation%rad_config, driver_config, ncol, nlev, & + & single_level, thermodynamics, & + & gas, cloud, aerosol) + + ! Latitude is used for cloud overlap and ice effective radius + if (file%exists('lat')) then + call file%get('lat', sin_latitude) + sin_latitude = sin(sin_latitude * Pi/180.0_jprb) + else + allocate(sin_latitude(ncol)) + sin_latitude = 0.0_jprb + end if + + if (file%exists('lon')) then + call file%get('lon', longitude_rad) + longitude_rad = longitude_rad * Pi/180.0_jprb + else + allocate(longitude_rad(ncol)) + longitude_rad = 0.0_jprb + end if + + ! Close input file + call file%close() + + ! Convert gas units to mass-mixing ratio + call gas%set_units(IMassMixingRatio) + + ! Compute seed from skin temperature residual + ! single_level%iseed = int(1.0e9*(single_level%skin_temperature & + ! & -int(single_level%skin_temperature))) + + ! Set first and last columns to process + if (driver_config%iendcol < 1 .or. driver_config%iendcol > ncol) then + driver_config%iendcol = ncol + end if + + if (driver_config%istartcol > driver_config%iendcol) then + write(nulout,'(a,i0,a,i0,a,i0,a)') '*** Error: requested column range (', & + & driver_config%istartcol, & + & ' to ', driver_config%iendcol, ') is out of the range in the data (1 to ', & + & ncol, ')' + stop 1 + end if + + ! -------------------------------------------------------- + ! Section 4: Call radiation scheme + ! -------------------------------------------------------- + + ! Compute saturation with respect to liquid (needed for aerosol + ! hydration) call + ! call thermodynamics%calc_saturation_wrt_liquid(driver_config%istartcol,driver_config%iendcol) + + ! Check inputs are within physical bounds, printing message if not + is_out_of_bounds = gas%out_of_physical_bounds(driver_config%istartcol, driver_config%iendcol, & + & driver_config%do_correct_unphysical_inputs) & + & .or. single_level%out_of_physical_bounds(driver_config%istartcol, driver_config%iendcol, & + & driver_config%do_correct_unphysical_inputs) & + & .or. thermodynamics%out_of_physical_bounds(driver_config%istartcol, driver_config%iendcol, & + & driver_config%do_correct_unphysical_inputs) & + & .or. cloud%out_of_physical_bounds(driver_config%istartcol, driver_config%iendcol, & + & driver_config%do_correct_unphysical_inputs) & + & .or. aerosol%out_of_physical_bounds(driver_config%istartcol, driver_config%iendcol, & + & driver_config%do_correct_unphysical_inputs) + + ! Allocate memory for the flux profiles, which may include arrays + ! of dimension n_bands_sw/n_bands_lw, so must be called after + ! setup_radiation + call flux%allocate(yradiation%rad_config, 1, ncol, nlev) + + ! set relevant fluxes to zero + if(allocated(flux%lw_up)) flux%lw_up(:,:) = 0._jprb + if(allocated(flux%lw_dn)) flux%lw_dn(:,:) = 0._jprb + if(allocated(flux%sw_up)) flux%sw_up(:,:) = 0._jprb + if(allocated(flux%sw_dn)) flux%sw_dn(:,:) = 0._jprb + if(allocated(flux%sw_dn_direct)) flux%sw_dn_direct(:,:) = 0._jprb + if(allocated(flux%lw_up_clear)) flux%lw_up_clear(:,:) = 0._jprb + if(allocated(flux%lw_dn_clear)) flux%lw_dn_clear(:,:) = 0._jprb + if(allocated(flux%sw_up_clear)) flux%sw_up_clear(:,:) = 0._jprb + if(allocated(flux%sw_dn_clear)) flux%sw_dn_clear(:,:) = 0._jprb + if(allocated(flux%sw_dn_direct_clear)) flux%sw_dn_direct_clear(:,:) = 0._jprb + + if(allocated(flux%lw_dn_surf_canopy)) flux%lw_dn_surf_canopy(:,:) = 0._jprb + if(allocated(flux%sw_dn_diffuse_surf_canopy)) flux%sw_dn_diffuse_surf_canopy(:,:) = 0._jprb + if(allocated(flux%sw_dn_direct_surf_canopy)) flux%sw_dn_direct_surf_canopy(:,:) = 0._jprb + if(allocated(flux%lw_derivatives)) flux%lw_derivatives(:,:) = 0._jprb + + ! Allocate memory for additional arrays + allocate(land_frac(ncol)) + allocate(pressure_fl(ncol,nlev)) + allocate(temperature_fl(ncol,nlev)) + allocate(flux_sw_direct_normal(ncol)) + allocate(flux_uv(ncol)) + allocate(flux_par(ncol)) + allocate(flux_par_clear(ncol)) + allocate(emissivity_out(ncol)) + allocate(flux_diffuse_band(ncol,yradiation%yrerad%nsw)) + allocate(flux_direct_band(ncol,yradiation%yrerad%nsw)) + + pressure_fl = 0.5_jprb * (thermodynamics%pressure_hl(:,1:nlev)+thermodynamics%pressure_hl(:,2:nlev+1)) + temperature_fl = 0.5_jprb * (thermodynamics%temperature_hl(:,1:nlev)+thermodynamics%temperature_hl(:,2:nlev+1)) + + ! -------------------------------------------------------- + ! Section 4a: Reshuffle into blocked memory layout + ! -------------------------------------------------------- + + call zrgp_fields%setup(nlev, & + & yradiation%yrerad%nlwemiss, yradiation%yrerad%nlwout, & + & yradiation%yrerad%nsw, 0, 0, 0, & + & yradiation%rad_config%n_aerosol_types, & + & driver_config%iverbose>4, .false., .false., & + & yradiation%yrerad%lapproxlwupdate, yradiation%yrerad%lapproxswupdate, & + & .false., yradiation%yrerad%ldiagforcing) + + call ifs_copy_inputs_to_blocked(zrgp_fields, yradiation,& + & ncol, nlev, nproma, single_level, thermodynamics, gas, cloud, aerosol,& + & sin_latitude, longitude_rad, land_frac, pressure_fl, temperature_fl,& + & zrgp & +#ifdef BITIDENTITY_TESTING + &, iseed=iseed & +#endif + & ) + + call zrgp_fields%setup_field(zrgp, nlev, & + & yradiation%yrerad%nlwemiss, yradiation%yrerad%nlwout, & + & yradiation%yrerad%nsw, 0, 0, 0, & + & yradiation%rad_config%n_aerosol_types, & + & driver_config%iverbose>4, .false., .false., & + & yradiation%yrerad%lapproxlwupdate, yradiation%yrerad%lapproxswupdate, & + & .false., yradiation%yrerad%ldiagforcing) + + ! -------------------------------------------------------- + ! Section 4b: Call radiation_scheme with blocked memory data + ! -------------------------------------------------------- + + if (driver_config%iverbose >= 2) then + write(nulout,'(a)') 'Performing radiative transfer calculations' + end if + + ! Option of repeating calculation multiple time for more accurate + ! profiling +#ifndef NO_OPENMP + tstart = omp_get_wtime() +#endif + do jrepeat = 1,driver_config%nrepeat + + call radiation_scheme_layer(yradiation, zrgp_fields, & + & ncol, nproma, nlev, 0, & + & yradiation%rad_config%n_aerosol_types, & + & single_level%solar_irradiance & +#ifdef BITIDENTITY_TESTING + & , iseed=iseed & +#endif + & ) + + end do + +#ifndef NO_OPENMP + tstop = omp_get_wtime() + write(nulout, '(a,g12.5,a)') 'Time elapsed in radiative transfer: ', tstop-tstart, ' seconds' +#endif + + ! -------------------------------------------------------- + ! Section 4c: Copy fluxes from blocked memory data + ! -------------------------------------------------------- + + call ifs_copy_fluxes_from_blocked(zrgp_fields, yradiation, ncol, nlev, nproma, & + & zrgp, flux, flux_sw_direct_normal, flux_uv, flux_par, flux_par_clear, & + & emissivity_out, flux_diffuse_band, flux_direct_band) + + ! "up" fluxes are actually net fluxes at this point - we modify the + ! upwelling flux so that net=dn-up, while the TOA and surface + ! downwelling fluxes are correct. + if(yradiation%rad_config%do_sw) then + flux%sw_up = -flux%sw_up + flux%sw_up(:,1) = flux%sw_up(:,1)+flux%sw_dn(:,1) + flux%sw_up(:,nlev+1) = flux%sw_up(:,nlev+1)+flux%sw_dn(:,nlev+1) + if(yradiation%rad_config%do_clear) then + flux%sw_up_clear = -flux%sw_up_clear + flux%sw_up_clear(:,1) = flux%sw_up_clear(:,1)+flux%sw_dn_clear(:,1) + flux%sw_up_clear(:,nlev+1) = flux%sw_up_clear(:,nlev+1)+flux%sw_dn_clear(:,nlev+1) + endif + + endif + + if(yradiation%rad_config%do_lw) then + flux%lw_up = -flux%lw_up + flux%lw_up(:,1) = flux%lw_up(:,1)+flux%lw_dn(:,1) + flux%lw_up(:,nlev+1) = flux%lw_up(:,nlev+1)+flux%lw_dn(:,nlev+1) + if(yradiation%rad_config%do_clear) then + flux%lw_up_clear = -flux%lw_up_clear + flux%lw_up_clear(:,1) = flux%lw_up_clear(:,1)+flux%lw_dn_clear(:,1) + flux%lw_up_clear(:,nlev+1) = flux%lw_up_clear(:,nlev+1)+flux%lw_dn_clear(:,nlev+1) + endif + endif + + ! -------------------------------------------------------- + ! Section 5: Check and save output + ! -------------------------------------------------------- + + ! This is unreliable because only the net fluxes are valid: + !is_out_of_bounds = flux%out_of_physical_bounds(driver_config%istartcol, driver_config%iendcol) + + ! Store the fluxes in the output file + yradiation%rad_config%do_surface_sw_spectral_flux = .false. + yradiation%rad_config%do_canopy_fluxes_sw = .false. + yradiation%rad_config%do_canopy_fluxes_lw = .false. + + call save_net_fluxes(file_name, yradiation%rad_config, thermodynamics, flux, & + & iverbose=driver_config%iverbose, is_hdf5_file=driver_config%do_write_hdf5, & + & experiment_name=driver_config%experiment_name, & + & is_double_precision=driver_config%do_write_double_precision) + + if (driver_config%iverbose >= 2) then + write(nulout,'(a)') '------------------------------------------------------------------------------------' + end if + +#ifndef __GFORTRAN__ + ! FIXME: GFortran fails with a not understood double free error, which occurs + ! already when simply extracting fields and view pointers from the stack + call zrgp_fields%delete_field() +#endif + + ! Finalise MPI if not done yet +#ifdef HAVE_FIAT + call mpl_end(ldmeminfo=.false.) +#endif + +end program ecrad_ifs_driver diff --git a/ifs/CMakeLists.txt b/ifs/CMakeLists.txt index 3745a41d..122d6e67 100644 --- a/ifs/CMakeLists.txt +++ b/ifs/CMakeLists.txt @@ -19,12 +19,42 @@ set( ifs_SOURCES yoe_spectral_planck.F90 cloud_overlap_decorr_len.F90 yoerad.F90 + ifs_blocking.F90 + ${CMAKE_CURRENT_BINARY_DIR}/radintg_zrgp_mod.F90 ) +macro( ecrad_ifs_process_fypp fypp_file ) + # If FYPP has been enabled, regenerate the F90 source files otherwise simply link + # or copy commited versions + if( HAVE_FYPP ) + add_custom_command( + OUTPUT + ${CMAKE_CURRENT_BINARY_DIR}/${fypp_file}.F90 + COMMAND + ${FYPP} -m os -m field_config -M ${CMAKE_CURRENT_SOURCE_DIR} + ${CMAKE_CURRENT_SOURCE_DIR}/${fypp_file}.fypp + ${CMAKE_CURRENT_BINARY_DIR}/${fypp_file}.F90 + DEPENDS + ${CMAKE_CURRENT_SOURCE_DIR}/${fypp_file}.fypp + ${CMAKE_CURRENT_SOURCE_DIR}/radiation_fields_config.yaml + ) + else() + file( CREATE_LINK + ${CMAKE_CURRENT_SOURCE_DIR}/${fypp_file}.F90 + ${CMAKE_CURRENT_BINARY_DIR}/${fypp_file}.F90 + SYMBOLIC COPY_ON_ERROR + ) + endif() +endmacro() + +ecrad_ifs_process_fypp( radintg_zrgp_mod ) + ecbuild_add_library( TARGET ifs.${PREC} TYPE OBJECT SOURCES ${ifs_SOURCES} + PUBLIC_INCLUDES + "$" PRIVATE_LIBS ecrad.${PREC} ecrad_base.${PREC} @@ -34,3 +64,37 @@ ecbuild_add_library( $<${HAVE_ROCTX}:${ROCTX_LIBRARIES}> PRIVATE_DEFINITIONS ${GPU_OFFLOAD}GPU ) +set_target_properties( ifs.${PREC} + PROPERTIES + Fortran_MODULE_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}/module_ifs" +) + +if( HAVE_FIELD_API ) + + ecrad_ifs_process_fypp( radiation_scheme_layer_mod ) + + ecbuild_add_library( + TARGET ifs_field_api.${PREC} + TYPE OBJECT + SOURCES + ${ifs_SOURCES} + ${CMAKE_CURRENT_BINARY_DIR}/radiation_scheme_layer_mod.F90 + PUBLIC_DEFINITIONS + HAVE_FIELD_API + PUBLIC_INCLUDES + "$" + PRIVATE_LIBS + ecrad.${PREC} + ecrad_base.${PREC} + PUBLIC_LIBS + field_api_${PREC} + $<${HAVE_OMP}:OpenMP::OpenMP_Fortran> + $<${HAVE_NVTX}:${NVTX_TARGET}> + ) + + set_target_properties( ifs_field_api.${PREC} + PROPERTIES + Fortran_MODULE_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}/module_ifs_field_api" + ) + +endif() diff --git a/ifs/Makefile b/ifs/Makefile index 455d2b05..f0de08f5 100644 --- a/ifs/Makefile +++ b/ifs/Makefile @@ -1,7 +1,8 @@ SOURCES = ice_effective_radius.F90 liquid_effective_radius.F90 \ radiation_scheme.F90 radiation_setup.F90 yoerdu.F90 \ yomrip.F90 yoephy.F90 yoecld.F90 yoe_spectral_planck.F90 \ - cloud_overlap_decorr_len.F90 yoerad.F90 yoethf.F90 satur.F90 + cloud_overlap_decorr_len.F90 yoerad.F90 yoethf.F90 satur.F90 \ + ifs_blocking.F90 radintg_zrgp_mod.F90 OBJECTS := $(SOURCES:.F90=.o) LIBIFS = ../lib/libifs.a diff --git a/ifs/Makefile_deps b/ifs/Makefile_deps index cb7c9452..26ea5c42 100644 --- a/ifs/Makefile_deps +++ b/ifs/Makefile_deps @@ -1,8 +1,10 @@ cloud_overlap_decorr_len.o: yoecld.o cos_sza.o: yoerad.o yomrip.o ice_effective_radius.o: yoerad.o +ifs_blocking.o: radiation_setup.o radintg_zrgp_mod.o liquid_effective_radius.o: yoerad.o yoerdu.o radiation_scheme.o: radiation_setup.o +radiation_scheme_layer_mod.o: radiation_setup.o radintg_zrgp_mod.o radiation_setup.o: yoephy.o yoerad.o yoe_spectral_planck.o satur.o: yoethf.o yoerad.o: yoe_spectral_planck.o diff --git a/ifs/field_config.py b/ifs/field_config.py new file mode 100644 index 00000000..dba03b74 --- /dev/null +++ b/ifs/field_config.py @@ -0,0 +1,71 @@ +""" +A module providing configuration utilities for complex field and +variable data type hierachies. + +This module is intended to be used with the Fypp preprocesser to +concisely define ``Variable`` objects from which templated Fortran +type hierarchies can be created through templating. +""" +from fckit_yaml_reader import YAML +yaml = YAML() + +__all__ = ['Variable', 'VariableGroup', 'VariableConfiguration'] + + +class Variable(object): + """ + Object representing a single variable containing one or more fields. + """ + + def __init__(self, **kwargs): + self.name = kwargs.get('name') + self.dim = kwargs.get('dim', 3) + self.comment = kwargs.get('comment', '') + self.condition = kwargs.get('condition', '.true.') + + # Indicates multi-dimensional array of Variable objects. + # Note that ``self.array`` normalizes to the variable array + # rank so scalar variables have ``array==0``. + self.array = int(kwargs.get('array', False)) + + def __repr__(self): + return self.name + + +class VariableGroup(object): + """ + Group of ``Variable`` objects with common dimension and metadata. + """ + + def __init__(self, **kwargs): + if not kwargs['type'].lower() == 'group': + raise RuntimeError('Error creating VariableGroup: wrong schema %s' % kwargs) + + # Need a clever way to auto-set attrs + self.name = kwargs.get('name') + self.short = kwargs.get('short', self.name) + self.comment = kwargs.get('comment', '') + self.dimension = kwargs.get('dimension') + self.variables = [Variable(**({'dim': self.dimension} | v)) for v in kwargs['variables']] + + def __repr__(self): + return 'Group<%sD>::%s (%s):: %s' % (self.dimension, self.name, self.short, self.variables) + + +class VariableConfiguration(object): + """ + Utility class to read a configuration of field variables from .yaml file. + """ + + def __init__(self, filename): + + with open(filename, 'r') as stream: + self.schema = yaml.safe_load(stream) + + @property + def groups(self): + """ + Get a ``VariableGroup`` from the locally stored variable configuration. + """ + groups = [VariableGroup(**group) for group in self.schema] + return {g.name: g for g in groups} diff --git a/driver/ifs_blocking.F90 b/ifs/ifs_blocking.F90 similarity index 51% rename from driver/ifs_blocking.F90 rename to ifs/ifs_blocking.F90 index 1675ac57..0b3d8626 100644 --- a/driver/ifs_blocking.F90 +++ b/ifs/ifs_blocking.F90 @@ -21,263 +21,10 @@ module ifs_blocking public - type :: ifs_config_type - ! Offsets in ZRGP - integer :: igi, imu0, iamu0, iemiss, its, islm, iccnl, & - & ibas, itop, igelam, igemu, iclon, islon, iald, ialp, iti, ipr, iqs, iwv, iclc, ilwa, & - & iiwa, iswa, irwa, irra, idp, ioz, iecpo3, ihpr, iaprs, ihti, iaero, ifrsod, icdir, & - & ifrted, ifrsodc, ifrtedc, iemit, isudu, iuvdf, iparf, iparcf, itincf, ifdir, ifdif, & - & ilwderivative, iswdirectband, iswdiffuseband, ifrso, iswfc, ifrth, ilwfc, iaer, & - & iich4, iin2o, ino2, ic11, ic12, igix, iico2, iccno, ic22, icl4 -#ifdef BITIDENTITY_TESTING - integer :: ire_liq, ire_ice, ioverlap -#endif - integer :: ifldstot, iinbeg, ioutbeg, iinend, ioutend - end type ifs_config_type - contains -integer(kind=jpim) function indrad(knext,kflds,lduse) - - integer(kind=jpim), intent(inout) :: knext - integer(kind=jpim), intent(in) :: kflds - logical, intent(in) :: lduse - - if( lduse ) then - indrad=knext - knext=knext+kflds - else - indrad=-99999999 - endif - -end function indrad - -subroutine ifs_setup_indices (driver_config, ifs_config, yradiation, nlev) - - use radiation_io, only : nulout - use ecrad_driver_config, only : driver_config_type - use radiation_setup, only : tradiation - - ! Configuration specific to this driver - type(driver_config_type), intent(in) :: driver_config - type(ifs_config_type), intent(inout) :: ifs_config - - ! Configuration for the radiation scheme, IFS style - type(tradiation), intent(inout) :: yradiation - - integer, intent(inout) :: nlev - - integer :: ifldsin, ifldsout, inext, iinbeg, iinend, ioutbeg, ioutend - logical :: llactaero - logical :: lldebug - - ! Extract some config values - lldebug=(driver_config%iverbose>4) ! debug - llactaero = .false. - if(yradiation%rad_config%n_aerosol_types > 0 .and.& - & yradiation%rad_config%n_aerosol_types <= 21 .and. yradiation%yrerad%naermacc == 0) then - llactaero = .true. - endif - - ! - ! RADINTG - ! - - ! INITIALISE INDICES FOR VARIABLE - - ! INDRAD is a CONTAIN'd function (now a module function) - - inext =1 - iinbeg =1 ! start of input variables - ifs_config%igi =indrad(inext,1,lldebug) - ifs_config%imu0 =indrad(inext,1,.true.) - ifs_config%iamu0 =indrad(inext,1,.true.) - ifs_config%iemiss =indrad(inext,yradiation%yrerad%nlwemiss,.true.) - ifs_config%its =indrad(inext,1,.true.) - ifs_config%islm =indrad(inext,1,.true.) - ifs_config%iccnl =indrad(inext,1,.true.) - ifs_config%iccno =indrad(inext,1,.true.) - ifs_config%ibas =indrad(inext,1,.true.) - ifs_config%itop =indrad(inext,1,.true.) - ifs_config%igelam =indrad(inext,1,.true.) - ifs_config%igemu =indrad(inext,1,.true.) - ifs_config%iclon =indrad(inext,1,.true.) - ifs_config%islon =indrad(inext,1,.true.) - ifs_config%iald =indrad(inext,yradiation%yrerad%nsw,.true.) - ifs_config%ialp =indrad(inext,yradiation%yrerad%nsw,.true.) - ifs_config%iti =indrad(inext,nlev,.true.) - ifs_config%ipr =indrad(inext,nlev,.true.) - ifs_config%iqs =indrad(inext,nlev,.true.) - ifs_config%iwv =indrad(inext,nlev,.true.) - ifs_config%iclc =indrad(inext,nlev,.true.) - ifs_config%ilwa =indrad(inext,nlev,.true.) - ifs_config%iiwa =indrad(inext,nlev,.true.) - ifs_config%iswa =indrad(inext,nlev,.true.) - ifs_config%irwa =indrad(inext,nlev,.true.) - ifs_config%irra =indrad(inext,nlev,.true.) - ifs_config%idp =indrad(inext,nlev,.true.) - ifs_config%ioz =indrad(inext,nlev,.false.) - ifs_config%iecpo3 =indrad(inext,nlev ,.false.) - ifs_config%ihpr =indrad(inext,nlev+1,.true.) ! not used in ecrad - ifs_config%iaprs =indrad(inext,nlev+1,.true.) - ifs_config%ihti =indrad(inext,nlev+1,.true.) - ifs_config%iaero =indrad(inext,yradiation%rad_config%n_aerosol_types*nlev,& - & llactaero .and. yradiation%yrerad%naermacc==0) - - iinend =inext-1 ! end of input variables - - ioutbeg=inext ! start of output variables - if (yradiation%yrerad%naermacc == 1) then - ifs_config%iaero = indrad(inext,yradiation%rad_config%n_aerosol_types*nlev,& - & yradiation%yrerad%ldiagforcing) - endif - ifs_config%ifrsod =indrad(inext,1,.true.) - ifs_config%ifrted =indrad(inext,yradiation%yrerad%nlwout,.true.) - ifs_config%ifrsodc=indrad(inext,1,.true.) - ifs_config%ifrtedc=indrad(inext,1,.true.) - ifs_config%iemit =indrad(inext,1,.true.) - ifs_config%isudu =indrad(inext,1,.true.) - ifs_config%iuvdf =indrad(inext,1,.true.) - ifs_config%iparf =indrad(inext,1,.true.) - ifs_config%iparcf =indrad(inext,1,.true.) - ifs_config%itincf =indrad(inext,1,.true.) - ifs_config%ifdir =indrad(inext,1,.true.) - ifs_config%ifdif =indrad(inext,1,.true.) - ifs_config%icdir =indrad(inext,1,.true.) - ifs_config%ilwderivative =indrad(inext,nlev+1, yradiation%yrerad%lapproxlwupdate) - ifs_config%iswdirectband =indrad(inext,yradiation%yrerad%nsw,yradiation%yrerad%lapproxswupdate) - ifs_config%iswdiffuseband=indrad(inext,yradiation%yrerad%nsw,yradiation%yrerad%lapproxswupdate) - ifs_config%ifrso =indrad(inext,nlev+1,.true.) - ifs_config%iswfc =indrad(inext,nlev+1,.true.) - ifs_config%ifrth =indrad(inext,nlev+1,.true.) - ifs_config%ilwfc =indrad(inext,nlev+1,.true.) - ifs_config%iaer =indrad(inext,6*nlev,yradiation%yrerad%ldiagforcing) - ifs_config%ioz =indrad(inext,nlev,yradiation%yrerad%ldiagforcing) - ifs_config%iico2 =indrad(inext,nlev,yradiation%yrerad%ldiagforcing) - ifs_config%iich4 =indrad(inext,nlev,yradiation%yrerad%ldiagforcing) - ifs_config%iin2o =indrad(inext,nlev,yradiation%yrerad%ldiagforcing) - ifs_config%ino2 =indrad(inext,nlev,yradiation%yrerad%ldiagforcing) - ifs_config%ic11 =indrad(inext,nlev,yradiation%yrerad%ldiagforcing) - ifs_config%ic12 =indrad(inext,nlev,yradiation%yrerad%ldiagforcing) - ifs_config%ic22 =indrad(inext,nlev,yradiation%yrerad%ldiagforcing) - ifs_config%icl4 =indrad(inext,nlev,yradiation%yrerad%ldiagforcing) - ifs_config%igix =indrad(inext,1,lldebug) - - ioutend=inext-1 ! end of output variables - - ! start of local variables - if(.not.yradiation%yrerad%ldiagforcing) then - if (yradiation%rad_config%n_aerosol_types == 0 .or. yradiation%yrerad%naermacc == 1) then - ifs_config%iaero = indrad(inext,yradiation%rad_config%n_aerosol_types*nlev,.true.) - endif - ifs_config%iaer =indrad(inext,nlev*6,.true.) - ifs_config%ioz =indrad(inext,nlev,.true.) - ifs_config%iico2 =indrad(inext,nlev,.true.) - ifs_config%iich4 =indrad(inext,nlev,.true.) - ifs_config%iin2o =indrad(inext,nlev,.true.) - ifs_config%ino2 =indrad(inext,nlev,.true.) - ifs_config%ic11 =indrad(inext,nlev,.true.) - ifs_config%ic12 =indrad(inext,nlev,.true.) - ifs_config%ic22 =indrad(inext,nlev,.true.) - ifs_config%icl4 =indrad(inext,nlev,.true.) - endif - ! end of local variables - - ! start of standalone inputs workaround variables -#ifdef BITIDENTITY_TESTING - ! To validate results against standalone ecrad, we overwrite effective - ! radii, cloud overlap and seed with input values - ifs_config%ire_liq =indrad(inext,nlev,.true.) - ifs_config%ire_ice =indrad(inext,nlev,.true.) - ifs_config%ioverlap =indrad(inext,nlev-1,.true.) -#endif - ! end of standalone inputs workaround variables - - ifldsin = iinend - iinbeg +1 - ifldsout= ioutend-ioutbeg +1 - ifs_config%ifldstot= inext - 1 - ifs_config%iinbeg = iinbeg - ifs_config%iinend = iinend - ifs_config%ioutbeg = ioutbeg - ifs_config%ioutend = ioutend - - if( lldebug )then - write(nulout,'("imu0 =",i0)')ifs_config%imu0 - write(nulout,'("iamu0 =",i0)')ifs_config%iamu0 - write(nulout,'("iemiss =",i0)')ifs_config%iemiss - write(nulout,'("its =",i0)')ifs_config%its - write(nulout,'("islm =",i0)')ifs_config%islm - write(nulout,'("iccnl =",i0)')ifs_config%iccnl - write(nulout,'("iccno =",i0)')ifs_config%iccno - write(nulout,'("ibas =",i0)')ifs_config%ibas - write(nulout,'("itop =",i0)')ifs_config%itop - write(nulout,'("igelam =",i0)')ifs_config%igelam - write(nulout,'("igemu =",i0)')ifs_config%igemu - write(nulout,'("iclon =",i0)')ifs_config%iclon - write(nulout,'("islon =",i0)')ifs_config%islon - write(nulout,'("iald =",i0)')ifs_config%iald - write(nulout,'("ialp =",i0)')ifs_config%ialp - write(nulout,'("iti =",i0)')ifs_config%iti - write(nulout,'("ipr =",i0)')ifs_config%ipr - write(nulout,'("iqs =",i0)')ifs_config%iqs - write(nulout,'("iwv =",i0)')ifs_config%iwv - write(nulout,'("iclc =",i0)')ifs_config%iclc - write(nulout,'("ilwa =",i0)')ifs_config%ilwa - write(nulout,'("iiwa =",i0)')ifs_config%iiwa - write(nulout,'("iswa =",i0)')ifs_config%iswa - write(nulout,'("irwa =",i0)')ifs_config%irwa - write(nulout,'("irra =",i0)')ifs_config%irra - write(nulout,'("idp =",i0)')ifs_config%idp - write(nulout,'("ioz =",i0)')ifs_config%ioz - write(nulout,'("iecpo3 =",i0)')ifs_config%iecpo3 - write(nulout,'("ihpr =",i0)')ifs_config%ihpr - write(nulout,'("iaprs =",i0)')ifs_config%iaprs - write(nulout,'("ihti =",i0)')ifs_config%ihti - write(nulout,'("ifrsod =",i0)')ifs_config%ifrsod - write(nulout,'("ifrted =",i0)')ifs_config%ifrted - write(nulout,'("ifrsodc=",i0)')ifs_config%ifrsodc - write(nulout,'("ifrtedc=",i0)')ifs_config%ifrtedc - write(nulout,'("iemit =",i0)')ifs_config%iemit - write(nulout,'("isudu =",i0)')ifs_config%isudu - write(nulout,'("iuvdf =",i0)')ifs_config%iuvdf - write(nulout,'("iparf =",i0)')ifs_config%iparf - write(nulout,'("iparcf =",i0)')ifs_config%iparcf - write(nulout,'("itincf =",i0)')ifs_config%itincf - write(nulout,'("ifdir =",i0)')ifs_config%ifdir - write(nulout,'("ifdif =",i0)')ifs_config%ifdif - write(nulout,'("icdir =",i0)')ifs_config%icdir - write(nulout,'("ilwderivative =",i0)')ifs_config%ilwderivative - write(nulout,'("iswdirectband =",i0)')ifs_config%iswdirectband - write(nulout,'("iswdiffuseband =",i0)')ifs_config%iswdiffuseband - write(nulout,'("ifrso =",i0)')ifs_config%ifrso - write(nulout,'("iswfc =",i0)')ifs_config%iswfc - write(nulout,'("ifrth =",i0)')ifs_config%ifrth - write(nulout,'("ilwfc =",i0)')ifs_config%ilwfc - write(nulout,'("igi =",i0)')ifs_config%igi - write(nulout,'("iaer =",i0)')ifs_config%iaer - write(nulout,'("iaero =",i0)')ifs_config%iaero - write(nulout,'("iico2 =",i0)')ifs_config%iico2 - write(nulout,'("iich4 =",i0)')ifs_config%iich4 - write(nulout,'("iin2o =",i0)')ifs_config%iin2o - write(nulout,'("ino2 =",i0)')ifs_config%ino2 - write(nulout,'("ic11 =",i0)')ifs_config%ic11 - write(nulout,'("ic12 =",i0)')ifs_config%ic12 - write(nulout,'("ic22 =",i0)')ifs_config%ic22 - write(nulout,'("icl4 =",i0)')ifs_config%icl4 -#ifdef BITIDENTITY_TESTING - write(nulout,'("ire_liq=",i0)')ifs_config%ire_liq - write(nulout,'("ire_ice=",i0)')ifs_config%ire_ice - write(nulout,'("ioverlap=",i0)')ifs_config%ioverlap -#endif - write(nulout,'("ifldsin =",i0)')ifldsin - write(nulout,'("ifldsout=",i0)')ifldsout - write(nulout,'("ifldstot=",i0)')ifs_config%ifldstot - endif - -end subroutine ifs_setup_indices - subroutine ifs_copy_inputs_to_blocked ( & - & driver_config, ifs_config, yradiation, ncol, nlev, & + & ifs_config, yradiation, ncol, nlev, nproma, & & single_level, thermodynamics, gas, cloud, aerosol, & & sin_latitude, longitude_rad, land_frac, pressure_fl, temperature_fl, & & zrgp, thermodynamics_out, iseed) @@ -288,20 +35,17 @@ subroutine ifs_copy_inputs_to_blocked ( & & IH2O, ICO2, IO3, IN2O, ICH4, ICFC11, ICFC12, IHCFC22, ICCL4 use radiation_cloud, only : cloud_type use radiation_aerosol, only : aerosol_type - use ecrad_driver_config, only : driver_config_type use radiation_setup, only : tradiation + use radintg_zrgp_mod, only : radintg_zrgp_type implicit none - ! Configuration specific to this driver - type(driver_config_type), intent(in) :: driver_config - - type(ifs_config_type), intent(in) :: ifs_config + type(radintg_zrgp_type), intent(in) :: ifs_config ! Configuration for the radiation scheme, IFS style type(tradiation), intent(in) :: yradiation - integer, intent(in) :: ncol, nlev ! Number of columns and levels + integer, intent(in) :: ncol, nlev, nproma ! Number of columns, levels, columns per block ! Derived types for the inputs to the radiation scheme type(single_level_type), intent(in) :: single_level @@ -323,13 +67,12 @@ subroutine ifs_copy_inputs_to_blocked ( & ! Seed for random number generator integer, intent(out), allocatable, optional :: iseed(:,:) - ! number of column blocks, block size - integer :: ngpblks, nproma + ! number of column blocks + integer :: ngpblks integer :: jrl, ibeg, iend, il, ib, ifld, jemiss, jalb, jlev, joff, jaer ! Extract some config values - nproma=driver_config%nblocksize ! nproma size ngpblks=(ncol-1)/nproma+1 ! number of column blocks ! Allocate blocked data structure @@ -501,22 +244,19 @@ subroutine ifs_copy_inputs_to_blocked ( & end subroutine ifs_copy_inputs_to_blocked subroutine ifs_copy_fluxes_from_blocked(& - & driver_config, ifs_config, yradiation, ncol, nlev,& + & ifs_config, yradiation, ncol, nlev, nproma, & & zrgp, flux, flux_sw_direct_normal, flux_uv, flux_par, flux_par_clear,& & emissivity_out, flux_diffuse_band, flux_direct_band) - use ecrad_driver_config, only : driver_config_type use radiation_setup, only : tradiation use radiation_flux, only : flux_type + use radintg_zrgp_mod, only : radintg_zrgp_type - ! Configuration specific to this driver - type(driver_config_type), intent(in) :: driver_config - - type(ifs_config_type), intent(in) :: ifs_config + type(radintg_zrgp_type), intent(in) :: ifs_config ! Configuration for the radiation scheme, IFS style type(tradiation), intent(in) :: yradiation - integer, intent(in) :: ncol, nlev ! Number of columns and levels + integer, intent(in) :: ncol, nlev, nproma ! Number of columns, levels, columns per block ! monolithic IFS data structure passed to radiation scheme real(kind=jprb), intent(inout), allocatable :: zrgp(:,:,:) @@ -529,13 +269,12 @@ subroutine ifs_copy_fluxes_from_blocked(& & flux_par_clear, emissivity_out real(jprb), dimension(:,:), intent(inout) :: flux_diffuse_band, flux_direct_band - ! number of column blocks, block size - integer :: ngpblks, nproma + ! number of column blocks + integer :: ngpblks integer :: jrl, ibeg, iend, il, ib, jlev, jg ! Extract some config values - nproma=driver_config%nblocksize ! nproma size ngpblks=(ncol-1)/nproma+1 ! number of column blocks ! ------------------------------------------------------- diff --git a/ifs/radiation_fields_config.yaml b/ifs/radiation_fields_config.yaml new file mode 100644 index 00000000..94d60429 --- /dev/null +++ b/ifs/radiation_fields_config.yaml @@ -0,0 +1,216 @@ +# IFS radiation fields definition for RADINTG + +# List of variables groups mapping into ZRGP allocation +- type: group + name: ZRGP_IN + short: ZRGP_IN + dimension: 3 + comment: Input fields collated into ZRGP in RADINTG + variables: + - name: igi + dim: [1] + condition: ldebug + - name: imu0 + dim: [1] + - name: iamu0 + dim: [1] + - name: iemiss + dim: [nlwemiss] + - name: its + dim: [1] + - name: islm + dim: [1] + - name: iccnl + dim: [1] + - name: iccno + dim: [1] + - name: ibas + dim: [1] + - name: itop + dim: [1] + - name: igelam + dim: [1] + - name: igemu + dim: [1] + - name: iclon + dim: [1] + - name: islon + dim: [1] + - name: iald + dim: [nsw] + - name: ialp + dim: [nsw] + - name: iti + dim: [nlev] + - name: ipr + dim: [nlev] + - name: iqs + dim: [nlev] + - name: iwv + dim: [nlev] + - name: iclc + dim: [nlev] + - name: ilwa + dim: [nlev] + - name: iiwa + dim: [nlev] + - name: iswa + dim: [nlev] + - name: irwa + dim: [nlev] + - name: irra + dim: [nlev] + - name: idp + dim: [nlev] + # - name: ifsd + # dim: [nlev] + # condition: nfsd>0 + - name: ioz + dim: [nlev] + condition: lrayfm + - name: iecpo3 + dim: [nlev] + condition: .not.lrayfm.and.lepo3ra + - name: ihpr + dim: [nlev+1] + - name: iaprs + dim: [nlev+1] + - name: ihti + dim: [nlev+1] + # - name: ipert + # dim: [nrftotal_radgrid] + # condition: lspprad + # - name: iprogaero + # dim: [nprogaer, nlev] + # condition: .not.lrayfm.and.nradaer>0 + - name: ire_liq + dim: [nlev] + condition: lbitidentity + - name: ire_ice + dim: [nlev] + condition: lbitidentity + - name: ioverlap + dim: [nlev-1] + condition: lbitidentity + +- type: group + name: ZRGP_OUT + short: ZRGP_OUT + dimension: 3 + comment: Output fields collated into ZRGP in RADINTG + variables: + - name: iaero + dim: [nradaer, nlev] + - name: ifrsod + dim: [1] + - name: ifrted + dim: [nlwout] + - name: ifrsodc + dim: [1] + - name: ifrtedc + dim: [1] + - name: iemit + dim: [1] + - name: isudu + dim: [1] + - name: iuvdf + dim: [1] + - name: iparf + dim: [1] + - name: iparcf + dim: [1] + - name: itincf + dim: [1] + - name: ifdir + dim: [1] + - name: ifdif + dim: [1] + - name: icdir + dim: [1] + - name: ilwderivative + dim: [nlev+1] + condition: lapproxlwupdate + - name: iswdirectband + dim: [nsw] + condition: lapproxswupdate + - name: iswdiffuseband + dim: [nsw] + condition: lapproxswupdate + - name: ifrso + dim: [nlev+1] + - name: iswfc + dim: [nlev+1] + - name: ifrth + dim: [nlev+1] + - name: ilwfc + dim: [nlev+1] + - name: iaer + dim: [6, nlev] + condition: ldiagforcing + - name: ioz + dim: [nlev] + condition: ldiagforcing + - name: iico2 + dim: [nlev] + condition: ldiagforcing + - name: iich4 + dim: [nlev] + condition: ldiagforcing + - name: iin2o + dim: [nlev] + condition: ldiagforcing + - name: ino2 + dim: [nlev] + condition: ldiagforcing + - name: ic11 + dim: [nlev] + condition: ldiagforcing + - name: ic12 + dim: [nlev] + condition: ldiagforcing + - name: ic22 + dim: [nlev] + condition: ldiagforcing + - name: icl4 + dim: [nlev] + condition: ldiagforcing + - name: igix + dim: [1] + condition: ldebug + +- type: group + name: ZRGP_LOCAL + short: ZRGP_LOCAL + dimension: 3 + comment: Local variables collated into ZRGP in RADINTG + variables: + - name: iaer + dim: [6, nlev] + condition: .not.ldiagforcing + - name: ioz + dim: [nlev] + condition: .not.(ldiagforcing.or.lrayfm) + - name: iico2 + dim: [nlev] + condition: .not.ldiagforcing + - name: iich4 + dim: [nlev] + condition: .not.ldiagforcing + - name: iin2o + dim: [nlev] + condition: .not.ldiagforcing + - name: ino2 + dim: [nlev] + condition: .not.ldiagforcing + - name: ic11 + dim: [nlev] + condition: .not.ldiagforcing + - name: ic12 + dim: [nlev] + condition: .not.ldiagforcing + - name: ic22 + dim: [nlev] + condition: .not.ldiagforcing + - name: icl4 + dim: [nlev] + condition: .not.ldiagforcing diff --git a/ifs/radiation_scheme.F90 b/ifs/radiation_scheme.F90 index d754e13e..58438286 100644 --- a/ifs/radiation_scheme.F90 +++ b/ifs/radiation_scheme.F90 @@ -17,7 +17,7 @@ SUBROUTINE RADIATION_SCHEME & & PFLUX_SW_DN_TOA, PEMIS_OUT, PLWDERIVATIVE, & & PSWDIFFUSEBAND, PSWDIRECTBAND, & ! OPTIONAL ARGUMENTS for bit-identical results in tests - & PRE_LIQ, PRE_ICE, ISEED, PCLOUD_OVERLAP) + & PRE_LIQ, PRE_ICE, ISEED, PCLOUD_OVERLAP, LACC) ! RADIATION_SCHEME - Interface to modular radiation scheme ! @@ -206,6 +206,7 @@ SUBROUTINE RADIATION_SCHEME & REAL(KIND=JPRB), INTENT(IN), OPTIONAL :: PCLOUD_OVERLAP(KLON, KLEV-1) ! Enable GPU code paths +LOGICAL, INTENT(IN), OPTIONAL :: LACC LOGICAL :: LLACC ! LOCAL VARIABLES @@ -341,11 +342,8 @@ SUBROUTINE RADIATION_SCHEME & call nvtxEndRange #endif -#ifdef _OPENACC -LLACC = .TRUE. -#else LLACC = .FALSE. -#endif +IF (PRESENT(LACC)) LLACC = LACC !$ACC DATA & !$ACC COPYIN(YRADIATION, YRERAD, RAD_CONFIG, SINGLE_LEVEL, THERMODYNAMICS, GAS, AEROSOL, YLCLOUD, FLUX) & diff --git a/ifs/radiation_scheme_layer_mod.F90 b/ifs/radiation_scheme_layer_mod.F90 new file mode 100644 index 00000000..58170a03 --- /dev/null +++ b/ifs/radiation_scheme_layer_mod.F90 @@ -0,0 +1,905 @@ +! (C) Copyright 2015- 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 RADIATION_SCHEME_LAYER_MOD + +IMPLICIT NONE + +PRIVATE +PUBLIC :: RADIATION_SCHEME_LAYER, RADIATION_SCHEME_LAYER_PARALLEL, RADIATION_SCHEME_LAYER_OPENACC + +CONTAINS + +SUBROUTINE RADIATION_SCHEME_LAYER & + & (YRADIATION, ZRGP_FIELDS, NGPTOT, NRPROMA, NFLEVG, & + & NFSD, KAEROSOL, PSOLAR_IRRADIANCE, ISEED) + +! Modules from ifs or ifsaux libraries +USE RADIATION_SETUP , ONLY : TRADIATION +USE PARKIND1 , ONLY : JPIM, JPRB +USE RADINTG_ZRGP_MOD, ONLY : RADINTG_ZRGP_TYPE + +IMPLICIT NONE + +! INPUT ARGUMENTS + +TYPE(TRADIATION) ,INTENT(IN), TARGET :: YRADIATION +TYPE(RADINTG_ZRGP_TYPE), INTENT(INOUT) :: ZRGP_FIELDS + +! *** Array dimensions and ranges +INTEGER(KIND=JPIM),INTENT(IN) :: NGPTOT ! Number of columns +INTEGER(KIND=JPIM),INTENT(IN) :: NRPROMA ! Number of columns +INTEGER(KIND=JPIM),INTENT(IN) :: NFLEVG ! Number of levels +INTEGER(KIND=JPIM),INTENT(IN) :: NFSD +INTEGER(KIND=JPIM),INTENT(IN) :: KAEROSOL ! Number of aerosol types + +! *** Single-level fields +REAL(KIND=JPRB), INTENT(IN) :: PSOLAR_IRRADIANCE ! (W m-2) + +INTEGER, OPTIONAL, INTENT(IN) :: ISEED(:,:) + +IF (YRADIATION%YRERAD%LECRAD_ON_GPU) THEN + CALL RADIATION_SCHEME_LAYER_OPENACC( & + & YRADIATION, ZRGP_FIELDS, NGPTOT, NRPROMA, NFLEVG, & + & NFSD, KAEROSOL, PSOLAR_IRRADIANCE, ISEED=ISEED ) +ELSE + CALL RADIATION_SCHEME_LAYER_PARALLEL( & + & YRADIATION, ZRGP_FIELDS, NGPTOT, NRPROMA, NFLEVG, & + & NFSD, KAEROSOL, PSOLAR_IRRADIANCE, ISEED=ISEED ) +ENDIF + +END SUBROUTINE RADIATION_SCHEME_LAYER + +SUBROUTINE RADIATION_SCHEME_LAYER_PARALLEL & + & (YRADIATION, ZRGP_FIELDS, NGPTOT, NRPROMA, NFLEVG, & + & NFSD, KAEROSOL, PSOLAR_IRRADIANCE, ISEED) + +USE FIELD_MODULE +USE FIELD_FACTORY_MODULE + +! Modules from ifs or ifsaux libraries +USE RADIATION_SETUP , ONLY : TRADIATION +USE PARKIND1 , ONLY : JPIM, JPRB +USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK +USE RADINTG_ZRGP_MOD, ONLY : RADINTG_ZRGP_TYPE + +IMPLICIT NONE + +! INPUT ARGUMENTS + +TYPE(TRADIATION) ,INTENT(IN), TARGET :: YRADIATION +TYPE(RADINTG_ZRGP_TYPE), INTENT(INOUT) :: ZRGP_FIELDS + +! *** Array dimensions and ranges +INTEGER(KIND=JPIM),INTENT(IN) :: NGPTOT ! Number of columns +INTEGER(KIND=JPIM),INTENT(IN) :: NRPROMA ! Number of columns +INTEGER(KIND=JPIM),INTENT(IN) :: NFLEVG ! Number of levels +INTEGER(KIND=JPIM),INTENT(IN) :: NFSD +INTEGER(KIND=JPIM),INTENT(IN) :: KAEROSOL ! Number of aerosol types + +! *** Single-level fields +REAL(KIND=JPRB), INTENT(IN) :: PSOLAR_IRRADIANCE ! (W m-2) + +INTEGER, OPTIONAL, INTENT(IN) :: ISEED(:,:) + +INTEGER(KIND=JPIM) :: KIDIA, KFDIA, IBL, JKGLO + +! Dummies for IFS config values +LOGICAL :: LSPPRAD, LRAYFM, LEPO3RA +LOGICAL, PARAMETER :: LDEBUG = .false. + +! Field pointers for each field in ZRGP +CLASS(FIELD_2RB), POINTER :: F_igi => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_igi(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_imu0 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_imu0(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_iamu0 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iamu0(:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iemiss => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iemiss(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_its => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_its(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_islm => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_islm(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_iccnl => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iccnl(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_iccno => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iccno(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_ibas => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ibas(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_itop => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_itop(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_igelam => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_igelam(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_igemu => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_igemu(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_iclon => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iclon(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_islon => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_islon(:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iald => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iald(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ialp => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ialp(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iti => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iti(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ipr => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ipr(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iqs => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iqs(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iwv => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iwv(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iclc => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iclc(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ilwa => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ilwa(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iiwa => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iiwa(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iswa => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iswa(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_irwa => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_irwa(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_irra => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_irra(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_idp => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_idp(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ioz => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ioz(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iecpo3 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iecpo3(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ihpr => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ihpr(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iaprs => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iaprs(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ihti => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ihti(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ire_liq => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ire_liq(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ire_ice => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ire_ice(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ioverlap => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ioverlap(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iaero => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iaero(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_ifrsod => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ifrsod(:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ifrted => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ifrted(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_ifrsodc => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ifrsodc(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_ifrtedc => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ifrtedc(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_iemit => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iemit(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_isudu => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_isudu(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_iuvdf => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iuvdf(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_iparf => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iparf(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_iparcf => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iparcf(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_itincf => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_itincf(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_ifdir => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ifdir(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_ifdif => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ifdif(:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_icdir => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_icdir(:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ilwderivative => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ilwderivative(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iswdirectband => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iswdirectband(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iswdiffuseband => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iswdiffuseband(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ifrso => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ifrso(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iswfc => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iswfc(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ifrth => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ifrth(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ilwfc => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ilwfc(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iaer => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iaer(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iico2 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iico2(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iich4 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iich4(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iin2o => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iin2o(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ino2 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ino2(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ic11 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ic11(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ic12 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ic12(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ic22 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ic22(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_icl4 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_icl4(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_igix => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_igix(:) => NULL() + +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +#include "radiation_scheme.intfb.h" + +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_PARALLEL',0,ZHOOK_HANDLE) + +ASSOCIATE(YDERAD=>YRADIATION%YRERAD, RAD_CONFIG=>YRADIATION%RAD_CONFIG) +ASSOCIATE(LDIAGFORCING=>YDERAD%LDIAGFORCING, LAPPROXLWUPDATE=>YDERAD%LAPPROXLWUPDATE, & + & LAPPROXSWUPDATE=>YDERAD%LAPPROXSWUPDATE, NRADAER=>RAD_CONFIG%N_AEROSOL_TYPES) + +LSPPRAD=.FALSE. +LRAYFM=.FALSE. +LEPO3RA=.FALSE. + +! We want thread-local copies of the member fields but different compilers +! can or cannot firstprivatize these objects successfully. Therefore, we +! have two versions here that (1) either use private field objects and +! extract these fields from the field stack in a parallel environment or +! (2) extract these fields first and then mark them as firstprivate +#ifdef __GFORTRAN__ +#define USE_FIRSTPRIVATE +#endif + +#ifndef USE_FIRSTPRIVATE +!$OMP PARALLEL & +!$OMP& PRIVATE(KIDIA,KFDIA,IBL,& +!$OMP& F_igi,F_imu0,F_iamu0,F_iemiss,F_its, & +!$OMP& F_islm,F_iccnl,F_iccno,F_ibas,F_itop, & +!$OMP& F_igelam,F_igemu,F_iclon,F_islon,F_iald, & +!$OMP& F_ialp,F_iti,F_ipr,F_iqs,F_iwv, & +!$OMP& F_iclc,F_ilwa,F_iiwa,F_iswa,F_irwa, & +!$OMP& F_irra,F_idp,F_ioz,F_iecpo3,F_ihpr, & +!$OMP& F_iaprs,F_ihti,F_ire_liq,F_ire_ice,F_ioverlap, & +!$OMP& F_iaero,F_ifrsod,F_ifrted,F_ifrsodc,F_ifrtedc, & +!$OMP& F_iemit,F_isudu,F_iuvdf,F_iparf,F_iparcf, & +!$OMP& F_itincf,F_ifdir,F_ifdif,F_icdir,F_ilwderivative, & +!$OMP& F_iswdirectband,F_iswdiffuseband,F_ifrso,F_iswfc,F_ifrth, & +!$OMP& F_ilwfc,F_iaer,F_iico2,F_iich4,F_iin2o, & +!$OMP& F_ino2,F_ic11,F_ic12,F_ic22,F_icl4, & +!$OMP& F_igix & +!$OMP& ) & +!$OMP& PRIVATE(& +!$OMP& P_igi,P_imu0,P_iamu0,P_iemiss,P_its, & +!$OMP& P_islm,P_iccnl,P_iccno,P_ibas,P_itop, & +!$OMP& P_igelam,P_igemu,P_iclon,P_islon,P_iald, & +!$OMP& P_ialp,P_iti,P_ipr,P_iqs,P_iwv, & +!$OMP& P_iclc,P_ilwa,P_iiwa,P_iswa,P_irwa, & +!$OMP& P_irra,P_idp,P_ioz,P_iecpo3,P_ihpr, & +!$OMP& P_iaprs,P_ihti,P_ire_liq,P_ire_ice,P_ioverlap, & +!$OMP& P_iaero,P_ifrsod,P_ifrted,P_ifrsodc,P_ifrtedc, & +!$OMP& P_iemit,P_isudu,P_iuvdf,P_iparf,P_iparcf, & +!$OMP& P_itincf,P_ifdir,P_ifdif,P_icdir,P_ilwderivative, & +!$OMP& P_iswdirectband,P_iswdiffuseband,P_ifrso,P_iswfc,P_ifrth, & +!$OMP& P_ilwfc,P_iaer,P_iico2,P_iich4,P_iin2o, & +!$OMP& P_ino2,P_ic11,P_ic12,P_ic22,P_icl4, & +!$OMP& P_igix & +!$OMP& ) +#endif + +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 1, F_igi) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 2, F_imu0) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 3, F_iamu0) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 4, F_iemiss) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 5, F_its) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 6, F_islm) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 7, F_iccnl) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 8, F_iccno) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 9, F_ibas) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 10, F_itop) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 11, F_igelam) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 12, F_igemu) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 13, F_iclon) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 14, F_islon) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 15, F_iald) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 16, F_ialp) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 17, F_iti) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 18, F_ipr) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 19, F_iqs) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 20, F_iwv) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 21, F_iclc) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 22, F_ilwa) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 23, F_iiwa) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 24, F_iswa) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 25, F_irwa) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 26, F_irra) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 27, F_idp) +IF(lrayfm) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 28, F_ioz) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 29, F_iecpo3) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 30, F_ihpr) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 31, F_iaprs) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 32, F_ihti) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 33, F_ire_liq) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 34, F_ire_ice) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 35, F_ioverlap) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 36, F_iaero) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 37, F_ifrsod) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 38, F_ifrted) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 39, F_ifrsodc) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 40, F_ifrtedc) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 41, F_iemit) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 42, F_isudu) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 43, F_iuvdf) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 44, F_iparf) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 45, F_iparcf) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 46, F_itincf) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 47, F_ifdir) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 48, F_ifdif) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 49, F_icdir) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 50, F_ilwderivative) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 51, F_iswdirectband) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 52, F_iswdiffuseband) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 53, F_ifrso) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 54, F_iswfc) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 55, F_ifrth) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 56, F_ilwfc) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 57, F_iaer) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 58, F_ioz) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 59, F_iico2) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 60, F_iich4) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 61, F_iin2o) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 62, F_ino2) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 63, F_ic11) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 64, F_ic12) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 65, F_ic22) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 66, F_icl4) +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 67, F_igix) +IF(.not.ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 68, F_iaer) +IF(.not.(ldiagforcing.or.lrayfm)) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 69, F_ioz) +IF(.not.ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 70, F_iico2) +IF(.not.ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 71, F_iich4) +IF(.not.ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 72, F_iin2o) +IF(.not.ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 73, F_ino2) +IF(.not.ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 74, F_ic11) +IF(.not.ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 75, F_ic12) +IF(.not.ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 76, F_ic22) +IF(.not.ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 77, F_icl4) + +#ifdef USE_FIRSTPRIVATE +!$OMP PARALLEL & +!$OMP& FIRSTPRIVATE(KIDIA,KFDIA,IBL,& +!$OMP& F_igi,F_imu0,F_iamu0,F_iemiss,F_its, & +!$OMP& F_islm,F_iccnl,F_iccno,F_ibas,F_itop, & +!$OMP& F_igelam,F_igemu,F_iclon,F_islon,F_iald, & +!$OMP& F_ialp,F_iti,F_ipr,F_iqs,F_iwv, & +!$OMP& F_iclc,F_ilwa,F_iiwa,F_iswa,F_irwa, & +!$OMP& F_irra,F_idp,F_ioz,F_iecpo3,F_ihpr, & +!$OMP& F_iaprs,F_ihti,F_ire_liq,F_ire_ice,F_ioverlap, & +!$OMP& F_iaero,F_ifrsod,F_ifrted,F_ifrsodc,F_ifrtedc, & +!$OMP& F_iemit,F_isudu,F_iuvdf,F_iparf,F_iparcf, & +!$OMP& F_itincf,F_ifdir,F_ifdif,F_icdir,F_ilwderivative, & +!$OMP& F_iswdirectband,F_iswdiffuseband,F_ifrso,F_iswfc,F_ifrth, & +!$OMP& F_ilwfc,F_iaer,F_iico2,F_iich4,F_iin2o, & +!$OMP& F_ino2,F_ic11,F_ic12,F_ic22,F_icl4, & +!$OMP& F_igix & +!$OMP& ) & +!$OMP& PRIVATE(& +!$OMP& P_igi,P_imu0,P_iamu0,P_iemiss,P_its, & +!$OMP& P_islm,P_iccnl,P_iccno,P_ibas,P_itop, & +!$OMP& P_igelam,P_igemu,P_iclon,P_islon,P_iald, & +!$OMP& P_ialp,P_iti,P_ipr,P_iqs,P_iwv, & +!$OMP& P_iclc,P_ilwa,P_iiwa,P_iswa,P_irwa, & +!$OMP& P_irra,P_idp,P_ioz,P_iecpo3,P_ihpr, & +!$OMP& P_iaprs,P_ihti,P_ire_liq,P_ire_ice,P_ioverlap, & +!$OMP& P_iaero,P_ifrsod,P_ifrted,P_ifrsodc,P_ifrtedc, & +!$OMP& P_iemit,P_isudu,P_iuvdf,P_iparf,P_iparcf, & +!$OMP& P_itincf,P_ifdir,P_ifdif,P_icdir,P_ilwderivative, & +!$OMP& P_iswdirectband,P_iswdiffuseband,P_ifrso,P_iswfc,P_ifrth, & +!$OMP& P_ilwfc,P_iaer,P_iico2,P_iich4,P_iin2o, & +!$OMP& P_ino2,P_ic11,P_ic12,P_ic22,P_icl4, & +!$OMP& P_igix & +!$OMP& ) +#endif +!$OMP DO SCHEDULE(DYNAMIC,1) +DO JKGLO=1,NGPTOT,NRPROMA + KIDIA=1 + KFDIA=MIN(NRPROMA,NGPTOT-JKGLO+1) + IBL=(JKGLO-1)/NRPROMA+1 + + P_iamu0 => F_iamu0%GET_VIEW(IBL) + P_its => F_its%GET_VIEW(IBL) + P_iald => F_iald%GET_VIEW(IBL) + P_ialp => F_ialp%GET_VIEW(IBL) + P_iemiss => F_iemiss%GET_VIEW(IBL) + P_iccnl => F_iccnl%GET_VIEW(IBL) + P_iccno => F_iccno%GET_VIEW(IBL) + P_igelam => F_igelam%GET_VIEW(IBL) + P_igemu => F_igemu%GET_VIEW(IBL) + P_islm => F_islm%GET_VIEW(IBL) + P_ipr => F_ipr%GET_VIEW(IBL) + P_iti => F_iti%GET_VIEW(IBL) + P_iaprs => F_iaprs%GET_VIEW(IBL) + P_ihti => F_ihti%GET_VIEW(IBL) + P_iwv => F_iwv%GET_VIEW(IBL) + P_iico2 => F_iico2%GET_VIEW(IBL) + P_iich4 => F_iich4%GET_VIEW(IBL) + P_iin2o => F_iin2o%GET_VIEW(IBL) + P_ino2 => F_ino2%GET_VIEW(IBL) + P_ic11 => F_ic11%GET_VIEW(IBL) + P_ic12 => F_ic12%GET_VIEW(IBL) + P_ic22 => F_ic22%GET_VIEW(IBL) + P_icl4 => F_icl4%GET_VIEW(IBL) + P_ioz => F_ioz%GET_VIEW(IBL) + P_iclc => F_iclc%GET_VIEW(IBL) + P_ilwa => F_ilwa%GET_VIEW(IBL) + P_iiwa => F_iiwa%GET_VIEW(IBL) + P_irwa => F_irwa%GET_VIEW(IBL) + P_iswa => F_iswa%GET_VIEW(IBL) + P_iaer => F_iaer%GET_VIEW(IBL) + P_iaero => F_iaero%GET_VIEW(IBL) + P_ifrso => F_ifrso%GET_VIEW(IBL) + P_ifrth => F_ifrth%GET_VIEW(IBL) + P_iswfc => F_iswfc%GET_VIEW(IBL) + P_ilwfc => F_ilwfc%GET_VIEW(IBL) + P_ifrsod => F_ifrsod%GET_VIEW(IBL) + P_ifrted => F_ifrted%GET_VIEW(IBL) + P_ifrsodc => F_ifrsodc%GET_VIEW(IBL) + P_ifrtedc => F_ifrtedc%GET_VIEW(IBL) + P_ifdir => F_ifdir%GET_VIEW(IBL) + P_icdir => F_icdir%GET_VIEW(IBL) + P_isudu => F_isudu%GET_VIEW(IBL) + P_iuvdf => F_iuvdf%GET_VIEW(IBL) + P_iparf => F_iparf%GET_VIEW(IBL) + P_iparcf => F_iparcf%GET_VIEW(IBL) + P_itincf => F_itincf%GET_VIEW(IBL) + P_iemit => F_iemit%GET_VIEW(IBL) + P_ilwderivative => F_ilwderivative%GET_VIEW(IBL) + P_iswdiffuseband => F_iswdiffuseband%GET_VIEW(IBL) + P_iswdirectband => F_iswdirectband%GET_VIEW(IBL) + P_ire_liq => F_ire_liq%GET_VIEW(IBL) + P_ire_ice => F_ire_ice%GET_VIEW(IBL) + P_ioverlap => F_ioverlap%GET_VIEW(IBL) + + ! Call the ECRAD radiation scheme + CALL RADIATION_SCHEME & + & (YRADIATION, & + & KIDIA, KFDIA, NRPROMA, & ! startcol, endcol, ncol + & NFLEVG, KAEROSOL, & + & PSOLAR_IRRADIANCE, & ! solar_irrad + & P_IAMU0, P_ITS, P_IALD, P_IALP, & + & P_IEMISS, & + & P_ICCNL, P_ICCNO ,& + & P_IGELAM,P_IGEMU, P_ISLM, & + & P_IPR, P_ITI, & + & P_IAPRS,P_IHTI, & + & P_IWV,P_IICO2,P_IICH4,P_IIN2O, & + & P_INO2,P_IC11,P_IC12, P_IC22, & + & P_ICL4,P_IOZ, & + & P_ICLC,P_ILWA,P_IIWA,P_IRWA, & + & P_ISWA, & + & P_IAER, P_IAERO, & + ! Flux outputs + & P_IFRSO,P_IFRTH,P_ISWFC,P_ILWFC,& + & P_IFRSOD,P_IFRTED, & + & P_IFRSODC,P_IFRTEDC,& + & P_IFDIR,P_ICDIR,P_ISUDU, & + & P_IUVDF,P_IPARF, & + & P_IPARCF,P_ITINCF, & + & P_IEMIT,P_ILWDERIVATIVE, & + & P_ISWDIFFUSEBAND,P_ISWDIRECTBAND & + ! OPTIONAL ARGUMENTS +#ifdef BITIDENTITY_TESTING + & , PRE_LIQ=P_IRE_LIQ, PRE_ICE=P_IRE_ICE & + & , PCLOUD_OVERLAP=P_IOVERLAP, ISEED=ISEED(:,IBL) & +#endif + & ) + +END DO +!$OMP END DO +!$OMP END PARALLEL + +END ASSOCIATE +END ASSOCIATE + +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_PARALLEL',1,ZHOOK_HANDLE) + +END SUBROUTINE RADIATION_SCHEME_LAYER_PARALLEL + +SUBROUTINE RADIATION_SCHEME_LAYER_OPENACC & + & (YRADIATION, ZRGP_FIELDS, NGPTOT, NRPROMA, NFLEVG, & + & NFSD, KAEROSOL, PSOLAR_IRRADIANCE, ISEED) + +USE FIELD_MODULE +USE FIELD_FACTORY_MODULE + +! Modules from ifs or ifsaux libraries +USE RADIATION_SETUP , ONLY : TRADIATION +USE PARKIND1 , ONLY : JPIM, JPRB +USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK +USE RADINTG_ZRGP_MOD, ONLY : RADINTG_ZRGP_TYPE + +#ifdef _OPENACC +USE OPENACC +#endif + +IMPLICIT NONE + +! INPUT ARGUMENTS + +TYPE(TRADIATION) ,INTENT(IN), TARGET :: YRADIATION +TYPE(RADINTG_ZRGP_TYPE), INTENT(INOUT) :: ZRGP_FIELDS + +! *** Array dimensions and ranges +INTEGER(KIND=JPIM),INTENT(IN) :: NGPTOT ! Number of columns +INTEGER(KIND=JPIM),INTENT(IN) :: NRPROMA ! Number of columns +INTEGER(KIND=JPIM),INTENT(IN) :: NFLEVG ! Number of levels +INTEGER(KIND=JPIM),INTENT(IN) :: NFSD +INTEGER(KIND=JPIM),INTENT(IN) :: KAEROSOL ! Number of aerosol types + +! *** Single-level fields +REAL(KIND=JPRB), INTENT(IN) :: PSOLAR_IRRADIANCE ! (W m-2) + +INTEGER, OPTIONAL, INTENT(IN) :: ISEED(:,:) + +INTEGER(KIND=JPIM) :: KIDIA, KFDIA, IBL, JKGLO + +! Dummies for IFS config values +LOGICAL :: LSPPRAD, LRAYFM, LEPO3RA, LBITIDENTITY +LOGICAL, PARAMETER :: LDEBUG = .false. + +! Field pointers for each field in ZRGP +CLASS(FIELD_2RB), POINTER :: F_igi => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_igi(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_imu0 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_imu0(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_iamu0 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iamu0(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iemiss => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iemiss(:,:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_its => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_its(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_islm => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_islm(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_iccnl => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iccnl(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_iccno => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iccno(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_ibas => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ibas(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_itop => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_itop(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_igelam => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_igelam(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_igemu => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_igemu(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_iclon => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iclon(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_islon => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_islon(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iald => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iald(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ialp => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ialp(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iti => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iti(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ipr => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ipr(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iqs => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iqs(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iwv => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iwv(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iclc => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iclc(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ilwa => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ilwa(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iiwa => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iiwa(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iswa => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iswa(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_irwa => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_irwa(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_irra => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_irra(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_idp => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_idp(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ioz => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ioz(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iecpo3 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iecpo3(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ihpr => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ihpr(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iaprs => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iaprs(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ihti => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ihti(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ire_liq => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ire_liq(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ire_ice => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ire_ice(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ioverlap => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ioverlap(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iaero => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iaero(:,:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_ifrsod => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ifrsod(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ifrted => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ifrted(:,:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_ifrsodc => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ifrsodc(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_ifrtedc => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ifrtedc(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_iemit => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iemit(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_isudu => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_isudu(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_iuvdf => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iuvdf(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_iparf => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iparf(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_iparcf => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iparcf(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_itincf => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_itincf(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_ifdir => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ifdir(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_ifdif => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ifdif(:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_icdir => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_icdir(:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ilwderivative => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ilwderivative(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iswdirectband => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iswdirectband(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iswdiffuseband => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iswdiffuseband(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ifrso => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ifrso(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iswfc => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iswfc(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ifrth => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ifrth(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ilwfc => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ilwfc(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iaer => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iaer(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iico2 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iico2(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iich4 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iich4(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_iin2o => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_iin2o(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ino2 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ino2(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ic11 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ic11(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ic12 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ic12(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_ic22 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_ic22(:,:,:) => NULL() +CLASS(FIELD_3RB), POINTER :: F_icl4 => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_icl4(:,:,:) => NULL() +CLASS(FIELD_2RB), POINTER :: F_igix => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_igix(:,:) => NULL() + +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OFFLOAD, ZHOOK_HANDLE_COMPUTE, ZHOOK_HANDLE_PULLBACK + +#include "radiation_scheme.intfb.h" + +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_OPENACC',0,ZHOOK_HANDLE) + +ASSOCIATE(YDERAD=>YRADIATION%YRERAD, RAD_CONFIG=>YRADIATION%RAD_CONFIG) +ASSOCIATE(LDIAGFORCING=>YDERAD%LDIAGFORCING, LAPPROXLWUPDATE=>YDERAD%LAPPROXLWUPDATE, & + & LAPPROXSWUPDATE=>YDERAD%LAPPROXSWUPDATE, NRADAER=>RAD_CONFIG%N_AEROSOL_TYPES) + +LSPPRAD=.FALSE. +LRAYFM=.FALSE. +LEPO3RA=.FALSE. + +#ifdef BITIDENTITY_TESTING +LBITIDENTITY=.TRUE. +#else +LBITIDENTITY=.FALSE. +#endif + +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 3, F_iamu0) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 4, F_iemiss) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 5, F_its) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 6, F_islm) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 7, F_iccnl) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 8, F_iccno) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 11, F_igelam) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 12, F_igemu) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 15, F_iald) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 16, F_ialp) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 17, F_iti) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 18, F_ipr) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 20, F_iwv) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 21, F_iclc) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 22, F_ilwa) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 23, F_iiwa) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 24, F_iswa) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 25, F_irwa) +IF(lrayfm) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 28, F_ioz) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 31, F_iaprs) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 32, F_ihti) +IF(lbitidentity) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 33, F_ire_liq) +IF(lbitidentity) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 34, F_ire_ice) +IF(lbitidentity) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 35, F_ioverlap) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 36, F_iaero) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 37, F_ifrsod) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 38, F_ifrted) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 39, F_ifrsodc) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 40, F_ifrtedc) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 41, F_iemit) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 42, F_isudu) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 43, F_iuvdf) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 44, F_iparf) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 45, F_iparcf) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 46, F_itincf) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 47, F_ifdir) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 49, F_icdir) +IF(lapproxlwupdate) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 50, F_ilwderivative) +IF(lapproxswupdate) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 51, F_iswdirectband) +IF(lapproxswupdate) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 52, F_iswdiffuseband) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 53, F_ifrso) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 54, F_iswfc) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 55, F_ifrth) +IF(.true.) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 56, F_ilwfc) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 57, F_iaer) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 58, F_ioz) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 59, F_iico2) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 60, F_iich4) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 61, F_iin2o) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 62, F_ino2) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 63, F_ic11) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 64, F_ic12) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 65, F_ic22) +IF(ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 66, F_icl4) +IF(.not.ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 68, F_iaer) +IF(.not.(ldiagforcing.or.lrayfm)) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 69, F_ioz) +IF(.not.ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 70, F_iico2) +IF(.not.ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 71, F_iich4) +IF(.not.ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 72, F_iin2o) +IF(.not.ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 73, F_ino2) +IF(.not.ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 74, F_ic11) +IF(.not.ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 75, F_ic12) +IF(.not.ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 76, F_ic22) +IF(.not.ldiagforcing) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 77, F_icl4) + +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_OPENACC:OFFLOAD',0,ZHOOK_HANDLE_OFFLOAD) + +CALL ZRGP_FIELDS%FIELD_WRAPPER%SYNC_DEVICE_RDWR() + +IF(.true.) CALL F_iamu0%GET_DEVICE_DATA_RDONLY(P_iamu0) +IF(.true.) CALL F_iemiss%GET_DEVICE_DATA_RDONLY(P_iemiss) +IF(.true.) CALL F_its%GET_DEVICE_DATA_RDONLY(P_its) +IF(.true.) CALL F_islm%GET_DEVICE_DATA_RDONLY(P_islm) +IF(.true.) CALL F_iccnl%GET_DEVICE_DATA_RDONLY(P_iccnl) +IF(.true.) CALL F_iccno%GET_DEVICE_DATA_RDONLY(P_iccno) +IF(.true.) CALL F_igelam%GET_DEVICE_DATA_RDONLY(P_igelam) +IF(.true.) CALL F_igemu%GET_DEVICE_DATA_RDONLY(P_igemu) +IF(.true.) CALL F_iald%GET_DEVICE_DATA_RDONLY(P_iald) +IF(.true.) CALL F_ialp%GET_DEVICE_DATA_RDONLY(P_ialp) +IF(.true.) CALL F_iti%GET_DEVICE_DATA_RDONLY(P_iti) +IF(.true.) CALL F_ipr%GET_DEVICE_DATA_RDONLY(P_ipr) +IF(.true.) CALL F_iwv%GET_DEVICE_DATA_RDONLY(P_iwv) +IF(.true.) CALL F_iclc%GET_DEVICE_DATA_RDONLY(P_iclc) +IF(.true.) CALL F_ilwa%GET_DEVICE_DATA_RDONLY(P_ilwa) +IF(.true.) CALL F_iiwa%GET_DEVICE_DATA_RDONLY(P_iiwa) +IF(.true.) CALL F_iswa%GET_DEVICE_DATA_RDONLY(P_iswa) +IF(.true.) CALL F_irwa%GET_DEVICE_DATA_RDONLY(P_irwa) +IF(lrayfm) CALL F_ioz%GET_DEVICE_DATA_RDONLY(P_ioz) +IF(.true.) CALL F_iaprs%GET_DEVICE_DATA_RDONLY(P_iaprs) +IF(.true.) CALL F_ihti%GET_DEVICE_DATA_RDONLY(P_ihti) +IF(lbitidentity) CALL F_ire_liq%GET_DEVICE_DATA_RDONLY(P_ire_liq) +IF(lbitidentity) CALL F_ire_ice%GET_DEVICE_DATA_RDONLY(P_ire_ice) +IF(lbitidentity) CALL F_ioverlap%GET_DEVICE_DATA_RDONLY(P_ioverlap) + +IF(.true.) CALL F_iaero%GET_DEVICE_DATA_RDWR(P_iaero) +IF(.true.) CALL F_ifrsod%GET_DEVICE_DATA_RDWR(P_ifrsod) +IF(.true.) CALL F_ifrted%GET_DEVICE_DATA_RDWR(P_ifrted) +IF(.true.) CALL F_ifrsodc%GET_DEVICE_DATA_RDWR(P_ifrsodc) +IF(.true.) CALL F_ifrtedc%GET_DEVICE_DATA_RDWR(P_ifrtedc) +IF(.true.) CALL F_iemit%GET_DEVICE_DATA_RDWR(P_iemit) +IF(.true.) CALL F_isudu%GET_DEVICE_DATA_RDWR(P_isudu) +IF(.true.) CALL F_iuvdf%GET_DEVICE_DATA_RDWR(P_iuvdf) +IF(.true.) CALL F_iparf%GET_DEVICE_DATA_RDWR(P_iparf) +IF(.true.) CALL F_iparcf%GET_DEVICE_DATA_RDWR(P_iparcf) +IF(.true.) CALL F_itincf%GET_DEVICE_DATA_RDWR(P_itincf) +IF(.true.) CALL F_ifdir%GET_DEVICE_DATA_RDWR(P_ifdir) +IF(.true.) CALL F_icdir%GET_DEVICE_DATA_RDWR(P_icdir) +IF(lapproxlwupdate) CALL F_ilwderivative%GET_DEVICE_DATA_RDWR(P_ilwderivative) +IF(lapproxswupdate) CALL F_iswdirectband%GET_DEVICE_DATA_RDWR(P_iswdirectband) +IF(lapproxswupdate) CALL F_iswdiffuseband%GET_DEVICE_DATA_RDWR(P_iswdiffuseband) +IF(.true.) CALL F_ifrso%GET_DEVICE_DATA_RDWR(P_ifrso) +IF(.true.) CALL F_iswfc%GET_DEVICE_DATA_RDWR(P_iswfc) +IF(.true.) CALL F_ifrth%GET_DEVICE_DATA_RDWR(P_ifrth) +IF(.true.) CALL F_ilwfc%GET_DEVICE_DATA_RDWR(P_ilwfc) +IF(ldiagforcing) CALL F_iaer%GET_DEVICE_DATA_RDWR(P_iaer) +IF(ldiagforcing) CALL F_ioz%GET_DEVICE_DATA_RDWR(P_ioz) +IF(ldiagforcing) CALL F_iico2%GET_DEVICE_DATA_RDWR(P_iico2) +IF(ldiagforcing) CALL F_iich4%GET_DEVICE_DATA_RDWR(P_iich4) +IF(ldiagforcing) CALL F_iin2o%GET_DEVICE_DATA_RDWR(P_iin2o) +IF(ldiagforcing) CALL F_ino2%GET_DEVICE_DATA_RDWR(P_ino2) +IF(ldiagforcing) CALL F_ic11%GET_DEVICE_DATA_RDWR(P_ic11) +IF(ldiagforcing) CALL F_ic12%GET_DEVICE_DATA_RDWR(P_ic12) +IF(ldiagforcing) CALL F_ic22%GET_DEVICE_DATA_RDWR(P_ic22) +IF(ldiagforcing) CALL F_icl4%GET_DEVICE_DATA_RDWR(P_icl4) + +IF(.not.ldiagforcing) CALL F_iaer%GET_DEVICE_DATA_RDWR(P_iaer) +IF(.not.(ldiagforcing.or.lrayfm)) CALL F_ioz%GET_DEVICE_DATA_RDWR(P_ioz) +IF(.not.ldiagforcing) CALL F_iico2%GET_DEVICE_DATA_RDWR(P_iico2) +IF(.not.ldiagforcing) CALL F_iich4%GET_DEVICE_DATA_RDWR(P_iich4) +IF(.not.ldiagforcing) CALL F_iin2o%GET_DEVICE_DATA_RDWR(P_iin2o) +IF(.not.ldiagforcing) CALL F_ino2%GET_DEVICE_DATA_RDWR(P_ino2) +IF(.not.ldiagforcing) CALL F_ic11%GET_DEVICE_DATA_RDWR(P_ic11) +IF(.not.ldiagforcing) CALL F_ic12%GET_DEVICE_DATA_RDWR(P_ic12) +IF(.not.ldiagforcing) CALL F_ic22%GET_DEVICE_DATA_RDWR(P_ic22) +IF(.not.ldiagforcing) CALL F_icl4%GET_DEVICE_DATA_RDWR(P_icl4) + +!$ACC DATA COPYIN(ISEED) IF(PRESENT(ISEED)) + +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_OPENACC:OFFLOAD',1,ZHOOK_HANDLE_OFFLOAD) +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_OPENACC:COMPUTE',0,ZHOOK_HANDLE_COMPUTE) + +DO JKGLO=1,NGPTOT,NRPROMA + KIDIA=1 + KFDIA=MIN(NRPROMA,NGPTOT-JKGLO+1) + IBL=(JKGLO-1)/NRPROMA+1 + + ! Call the ECRAD radiation scheme + CALL RADIATION_SCHEME & + & (YRADIATION, & + & KIDIA, KFDIA, NRPROMA, & ! startcol, endcol, ncol + & NFLEVG, KAEROSOL, & + & PSOLAR_IRRADIANCE, & ! solar_irrad + & P_IAMU0(:,IBL), P_ITS(:,IBL), P_IALD(:,:,IBL), P_IALP(:,:,IBL), & + & P_IEMISS(:,:,IBL), & + & P_ICCNL(:,IBL), P_ICCNO(:,IBL) ,& + & P_IGELAM(:,IBL),P_IGEMU(:,IBL), P_ISLM(:,IBL), & + & P_IPR(:,:,IBL), P_ITI(:,:,IBL), & + & P_IAPRS(:,:,IBL),P_IHTI(:,:,IBL), & + & P_IWV(:,:,IBL),P_IICO2(:,:,IBL),P_IICH4(:,:,IBL),P_IIN2O(:,:,IBL), & + & P_INO2(:,:,IBL),P_IC11(:,:,IBL),P_IC12(:,:,IBL), P_IC22(:,:,IBL), & + & P_ICL4(:,:,IBL),P_IOZ(:,:,IBL), & + & P_ICLC(:,:,IBL),P_ILWA(:,:,IBL),P_IIWA(:,:,IBL),P_IRWA(:,:,IBL), & + & P_ISWA(:,:,IBL), & + & P_IAER(:,:,IBL), P_IAERO(:,:,IBL), & + ! Flux outputs + & P_IFRSO(:,:,IBL),P_IFRTH(:,:,IBL),P_ISWFC(:,:,IBL),P_ILWFC(:,:,IBL),& + & P_IFRSOD(:,IBL),P_IFRTED(:,:,IBL), & + & P_IFRSODC(:,IBL),P_IFRTEDC(:,IBL),& + & P_IFDIR(:,IBL),P_ICDIR(:,IBL),P_ISUDU(:,IBL), & + & P_IUVDF(:,IBL),P_IPARF(:,IBL), & + & P_IPARCF(:,IBL),P_ITINCF(:,IBL), & + & P_IEMIT(:,IBL),P_ILWDERIVATIVE(:,:,IBL), & + & P_ISWDIFFUSEBAND(:,:,IBL),P_ISWDIRECTBAND(:,:,IBL) & + ! OPTIONAL ARGUMENTS +#ifdef BITIDENTITY_TESTING + & , PRE_LIQ=P_IRE_LIQ(:,:,IBL), PRE_ICE=P_IRE_ICE(:,:,IBL) & + & , PCLOUD_OVERLAP=P_IOVERLAP(:,:,IBL), ISEED=ISEED(:,IBL) & +#endif + & , LACC=.TRUE. ) + +END DO +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_OPENACC:COMPUTE',1,ZHOOK_HANDLE_COMPUTE) + +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_OPENACC:PULLBACK',0,ZHOOK_HANDLE_PULLBACK) + +!$ACC WAIT(1) +!$ACC END DATA +CALL ZRGP_FIELDS%FIELD_WRAPPER%SYNC_HOST_RDWR() + +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_OPENACC:PULLBACK',1,ZHOOK_HANDLE_PULLBACK) + +END ASSOCIATE +END ASSOCIATE + +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_OPENACC',1,ZHOOK_HANDLE) + +END SUBROUTINE RADIATION_SCHEME_LAYER_OPENACC + +END MODULE RADIATION_SCHEME_LAYER_MOD diff --git a/ifs/radiation_scheme_layer_mod.fypp b/ifs/radiation_scheme_layer_mod.fypp new file mode 100644 index 00000000..987a32ed --- /dev/null +++ b/ifs/radiation_scheme_layer_mod.fypp @@ -0,0 +1,409 @@ +! (C) Copyright 2015- 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 radiation_config_file = os.path.dirname(os.path.abspath(_THIS_FILE_)) + '/radiation_fields_config.yaml' +#:set radiation_config = field_config.VariableConfiguration(radiation_config_file) +#:set zrgp_in = radiation_config.groups['ZRGP_IN'] +#:set zrgp_out = radiation_config.groups['ZRGP_OUT'] +#:set zrgp_local = radiation_config.groups['ZRGP_LOCAL'] +#:set variables = zrgp_in.variables + zrgp_out.variables + zrgp_local.variables +#:set variable_names = [v.name for v in variables] +#:set variable_cnt = {v_name: variable_names.count(v_name) for v_name in variable_names} +#:set variable_names = list(dict.fromkeys(variable_names)) +#:set variable_dim = {v.name: 2 if v.dim[0] == 1 else 3 for v in variables} +#:def chunked_join(iterable, linebreak) +${linebreak.join(','.join(iterable[i:i+5]) for i in range(0, len(iterable), 5))}$ +#:enddef chunked_join +#:endmute + +#:set active_args = [ & +& 'iamu0', 'its', 'iald', 'ialp', & +& 'iemiss', & +& 'iccnl', 'iccno' , & +& 'igelam','igemu', 'islm', & +& 'ipr', 'iti', & +& 'iaprs','ihti', & +& 'iwv','iico2','iich4','iin2o', & +& 'ino2','ic11','ic12', 'ic22', & +& 'icl4','ioz', & +& 'iclc','ilwa','iiwa','irwa', & +& 'iswa', & +& 'iaer', 'iaero', & +& 'ifrso','ifrth','iswfc','ilwfc', & +& 'ifrsod','ifrted', & +& 'ifrsodc','ifrtedc', & +& 'ifdir','icdir','isudu', & +& 'iuvdf','iparf', & +& 'iparcf','itincf', & +& 'iemit','ilwderivative', & +& 'iswdiffuseband','iswdirectband', & +& 'ire_liq', 'ire_ice', 'ioverlap', & +& ] + +MODULE RADIATION_SCHEME_LAYER_MOD + +IMPLICIT NONE + +PRIVATE +PUBLIC :: RADIATION_SCHEME_LAYER, RADIATION_SCHEME_LAYER_PARALLEL, RADIATION_SCHEME_LAYER_OPENACC + +CONTAINS + +SUBROUTINE RADIATION_SCHEME_LAYER & + & (YRADIATION, ZRGP_FIELDS, NGPTOT, NRPROMA, NFLEVG, & + & NFSD, KAEROSOL, PSOLAR_IRRADIANCE, ISEED) + +! Modules from ifs or ifsaux libraries +USE RADIATION_SETUP , ONLY : TRADIATION +USE PARKIND1 , ONLY : JPIM, JPRB +USE RADINTG_ZRGP_MOD, ONLY : RADINTG_ZRGP_TYPE + +IMPLICIT NONE + +! INPUT ARGUMENTS + +TYPE(TRADIATION) ,INTENT(IN), TARGET :: YRADIATION +TYPE(RADINTG_ZRGP_TYPE), INTENT(INOUT) :: ZRGP_FIELDS + +! *** Array dimensions and ranges +INTEGER(KIND=JPIM),INTENT(IN) :: NGPTOT ! Number of columns +INTEGER(KIND=JPIM),INTENT(IN) :: NRPROMA ! Number of columns +INTEGER(KIND=JPIM),INTENT(IN) :: NFLEVG ! Number of levels +INTEGER(KIND=JPIM),INTENT(IN) :: NFSD +INTEGER(KIND=JPIM),INTENT(IN) :: KAEROSOL ! Number of aerosol types + +! *** Single-level fields +REAL(KIND=JPRB), INTENT(IN) :: PSOLAR_IRRADIANCE ! (W m-2) + +INTEGER, OPTIONAL, INTENT(IN) :: ISEED(:,:) + +IF (YRADIATION%YRERAD%LECRAD_ON_GPU) THEN + CALL RADIATION_SCHEME_LAYER_OPENACC( & + & YRADIATION, ZRGP_FIELDS, NGPTOT, NRPROMA, NFLEVG, & + & NFSD, KAEROSOL, PSOLAR_IRRADIANCE, ISEED=ISEED ) +ELSE + CALL RADIATION_SCHEME_LAYER_PARALLEL( & + & YRADIATION, ZRGP_FIELDS, NGPTOT, NRPROMA, NFLEVG, & + & NFSD, KAEROSOL, PSOLAR_IRRADIANCE, ISEED=ISEED ) +ENDIF + +END SUBROUTINE RADIATION_SCHEME_LAYER + +SUBROUTINE RADIATION_SCHEME_LAYER_PARALLEL & + & (YRADIATION, ZRGP_FIELDS, NGPTOT, NRPROMA, NFLEVG, & + & NFSD, KAEROSOL, PSOLAR_IRRADIANCE, ISEED) + +USE FIELD_MODULE +USE FIELD_FACTORY_MODULE + +! Modules from ifs or ifsaux libraries +USE RADIATION_SETUP , ONLY : TRADIATION +USE PARKIND1 , ONLY : JPIM, JPRB +USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK +USE RADINTG_ZRGP_MOD, ONLY : RADINTG_ZRGP_TYPE + +IMPLICIT NONE + +! INPUT ARGUMENTS + +TYPE(TRADIATION) ,INTENT(IN), TARGET :: YRADIATION +TYPE(RADINTG_ZRGP_TYPE), INTENT(INOUT) :: ZRGP_FIELDS + +! *** Array dimensions and ranges +INTEGER(KIND=JPIM),INTENT(IN) :: NGPTOT ! Number of columns +INTEGER(KIND=JPIM),INTENT(IN) :: NRPROMA ! Number of columns +INTEGER(KIND=JPIM),INTENT(IN) :: NFLEVG ! Number of levels +INTEGER(KIND=JPIM),INTENT(IN) :: NFSD +INTEGER(KIND=JPIM),INTENT(IN) :: KAEROSOL ! Number of aerosol types + +! *** Single-level fields +REAL(KIND=JPRB), INTENT(IN) :: PSOLAR_IRRADIANCE ! (W m-2) + +INTEGER, OPTIONAL, INTENT(IN) :: ISEED(:,:) + +INTEGER(KIND=JPIM) :: KIDIA, KFDIA, IBL, JKGLO + +! Dummies for IFS config values +LOGICAL :: LSPPRAD, LRAYFM, LEPO3RA +LOGICAL, PARAMETER :: LDEBUG = .false. + +! Field pointers for each field in ZRGP +#:for v_name in variable_names +#:set dim = variable_dim[v_name] +CLASS(FIELD_${dim}$RB), POINTER :: F_${v_name}$ => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_${v_name}$(${','.join(':' * (dim-1))}$) => NULL() +#:endfor + +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +#include "radiation_scheme.intfb.h" + +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_PARALLEL',0,ZHOOK_HANDLE) + +ASSOCIATE(YDERAD=>YRADIATION%YRERAD, RAD_CONFIG=>YRADIATION%RAD_CONFIG) +ASSOCIATE(LDIAGFORCING=>YDERAD%LDIAGFORCING, LAPPROXLWUPDATE=>YDERAD%LAPPROXLWUPDATE, & + & LAPPROXSWUPDATE=>YDERAD%LAPPROXSWUPDATE, NRADAER=>RAD_CONFIG%N_AEROSOL_TYPES) + +LSPPRAD=.FALSE. +LRAYFM=.FALSE. +LEPO3RA=.FALSE. + +! We want thread-local copies of the member fields but different compilers +! can or cannot firstprivatize these objects successfully. Therefore, we +! have two versions here that (1) either use private field objects and +! extract these fields from the field stack in a parallel environment or +! (2) extract these fields first and then mark them as firstprivate +#ifdef __GFORTRAN__ +#define USE_FIRSTPRIVATE +#endif + +#ifndef USE_FIRSTPRIVATE +!$OMP PARALLEL & +!$OMP& PRIVATE(KIDIA,KFDIA,IBL,& +!$OMP& ${chunked_join([f'F_{v_name}' for v_name in variable_names], ', &\n!$OMP& ')}$ & +!$OMP& ) & +!$OMP& PRIVATE(& +!$OMP& ${chunked_join([f'P_{v_name}' for v_name in variable_names], ', &\n!$OMP& ')}$ & +!$OMP& ) +#endif + +#:for idx, v in enumerate(variables) +#:if variable_cnt[v.name] > 1 +IF(${v.condition}$) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, ${idx+1}$, F_${v.name}$) +#:else +CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, ${idx+1}$, F_${v.name}$) +#:endif +#:endfor + +#ifdef USE_FIRSTPRIVATE +!$OMP PARALLEL & +!$OMP& FIRSTPRIVATE(KIDIA,KFDIA,IBL,& +!$OMP& ${chunked_join([f'F_{v_name}' for v_name in variable_names], ', &\n!$OMP& ')}$ & +!$OMP& ) & +!$OMP& PRIVATE(& +!$OMP& ${chunked_join([f'P_{v_name}' for v_name in variable_names], ', &\n!$OMP& ')}$ & +!$OMP& ) +#endif +!$OMP DO SCHEDULE(DYNAMIC,1) +DO JKGLO=1,NGPTOT,NRPROMA + KIDIA=1 + KFDIA=MIN(NRPROMA,NGPTOT-JKGLO+1) + IBL=(JKGLO-1)/NRPROMA+1 + + #:for v_name in active_args + P_${v_name}$ => F_${v_name}$%GET_VIEW(IBL) + #:endfor + + ! Call the ECRAD radiation scheme + CALL RADIATION_SCHEME & + & (YRADIATION, & + & KIDIA, KFDIA, NRPROMA, & ! startcol, endcol, ncol + & NFLEVG, KAEROSOL, & + & PSOLAR_IRRADIANCE, & ! solar_irrad + & P_IAMU0, P_ITS, P_IALD, P_IALP, & + & P_IEMISS, & + & P_ICCNL, P_ICCNO ,& + & P_IGELAM,P_IGEMU, P_ISLM, & + & P_IPR, P_ITI, & + & P_IAPRS,P_IHTI, & + & P_IWV,P_IICO2,P_IICH4,P_IIN2O, & + & P_INO2,P_IC11,P_IC12, P_IC22, & + & P_ICL4,P_IOZ, & + & P_ICLC,P_ILWA,P_IIWA,P_IRWA, & + & P_ISWA, & + & P_IAER, P_IAERO, & + ! Flux outputs + & P_IFRSO,P_IFRTH,P_ISWFC,P_ILWFC,& + & P_IFRSOD,P_IFRTED, & + & P_IFRSODC,P_IFRTEDC,& + & P_IFDIR,P_ICDIR,P_ISUDU, & + & P_IUVDF,P_IPARF, & + & P_IPARCF,P_ITINCF, & + & P_IEMIT,P_ILWDERIVATIVE, & + & P_ISWDIFFUSEBAND,P_ISWDIRECTBAND & + ! OPTIONAL ARGUMENTS +#ifdef BITIDENTITY_TESTING + & , PRE_LIQ=P_IRE_LIQ, PRE_ICE=P_IRE_ICE & + & , PCLOUD_OVERLAP=P_IOVERLAP, ISEED=ISEED(:,IBL) & +#endif + & ) + +END DO +!$OMP END DO +!$OMP END PARALLEL + +END ASSOCIATE +END ASSOCIATE + +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_PARALLEL',1,ZHOOK_HANDLE) + +END SUBROUTINE RADIATION_SCHEME_LAYER_PARALLEL + +SUBROUTINE RADIATION_SCHEME_LAYER_OPENACC & + & (YRADIATION, ZRGP_FIELDS, NGPTOT, NRPROMA, NFLEVG, & + & NFSD, KAEROSOL, PSOLAR_IRRADIANCE, ISEED) + +USE FIELD_MODULE +USE FIELD_FACTORY_MODULE + +! Modules from ifs or ifsaux libraries +USE RADIATION_SETUP , ONLY : TRADIATION +USE PARKIND1 , ONLY : JPIM, JPRB +USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK +USE RADINTG_ZRGP_MOD, ONLY : RADINTG_ZRGP_TYPE + +#ifdef _OPENACC +USE OPENACC +#endif + +IMPLICIT NONE + +! INPUT ARGUMENTS + +TYPE(TRADIATION) ,INTENT(IN), TARGET :: YRADIATION +TYPE(RADINTG_ZRGP_TYPE), INTENT(INOUT) :: ZRGP_FIELDS + +! *** Array dimensions and ranges +INTEGER(KIND=JPIM),INTENT(IN) :: NGPTOT ! Number of columns +INTEGER(KIND=JPIM),INTENT(IN) :: NRPROMA ! Number of columns +INTEGER(KIND=JPIM),INTENT(IN) :: NFLEVG ! Number of levels +INTEGER(KIND=JPIM),INTENT(IN) :: NFSD +INTEGER(KIND=JPIM),INTENT(IN) :: KAEROSOL ! Number of aerosol types + +! *** Single-level fields +REAL(KIND=JPRB), INTENT(IN) :: PSOLAR_IRRADIANCE ! (W m-2) + +INTEGER, OPTIONAL, INTENT(IN) :: ISEED(:,:) + +INTEGER(KIND=JPIM) :: KIDIA, KFDIA, IBL, JKGLO + +! Dummies for IFS config values +LOGICAL :: LSPPRAD, LRAYFM, LEPO3RA, LBITIDENTITY +LOGICAL, PARAMETER :: LDEBUG = .false. + +! Field pointers for each field in ZRGP +#:for v_name in variable_names +#:set dim = variable_dim[v_name] +CLASS(FIELD_${dim}$RB), POINTER :: F_${v_name}$ => NULL() +REAL(KIND=JPRB), POINTER, CONTIGUOUS :: P_${v_name}$(${','.join(':' * dim)}$) => NULL() +#:endfor + +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE, ZHOOK_HANDLE_OFFLOAD, ZHOOK_HANDLE_COMPUTE, ZHOOK_HANDLE_PULLBACK + +#include "radiation_scheme.intfb.h" + +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_OPENACC',0,ZHOOK_HANDLE) + +ASSOCIATE(YDERAD=>YRADIATION%YRERAD, RAD_CONFIG=>YRADIATION%RAD_CONFIG) +ASSOCIATE(LDIAGFORCING=>YDERAD%LDIAGFORCING, LAPPROXLWUPDATE=>YDERAD%LAPPROXLWUPDATE, & + & LAPPROXSWUPDATE=>YDERAD%LAPPROXSWUPDATE, NRADAER=>RAD_CONFIG%N_AEROSOL_TYPES) + +LSPPRAD=.FALSE. +LRAYFM=.FALSE. +LEPO3RA=.FALSE. + +#ifdef BITIDENTITY_TESTING +LBITIDENTITY=.TRUE. +#else +LBITIDENTITY=.FALSE. +#endif + +#:for idx, v in enumerate(variables) +#:if v.name in active_args +IF(${v.condition}$) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, ${idx+1}$, F_${v.name}$) +#:endif +#:endfor + +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_OPENACC:OFFLOAD',0,ZHOOK_HANDLE_OFFLOAD) + +CALL ZRGP_FIELDS%FIELD_WRAPPER%SYNC_DEVICE_RDWR() + +#:for v in zrgp_in.variables +#:if v.name in active_args +IF(${v.condition}$) CALL F_${v.name}$%GET_DEVICE_DATA_RDONLY(P_${v.name}$) +#:endif +#:endfor + +#:for v in zrgp_out.variables +#:if v.name in active_args +IF(${v.condition}$) CALL F_${v.name}$%GET_DEVICE_DATA_RDWR(P_${v.name}$) +#:endif +#:endfor + +#:for v in zrgp_local.variables +#:if v.name in active_args +IF(${v.condition}$) CALL F_${v.name}$%GET_DEVICE_DATA_RDWR(P_${v.name}$) +#:endif +#:endfor + +!$ACC DATA COPYIN(ISEED) IF(PRESENT(ISEED)) + +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_OPENACC:OFFLOAD',1,ZHOOK_HANDLE_OFFLOAD) +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_OPENACC:COMPUTE',0,ZHOOK_HANDLE_COMPUTE) + +DO JKGLO=1,NGPTOT,NRPROMA + KIDIA=1 + KFDIA=MIN(NRPROMA,NGPTOT-JKGLO+1) + IBL=(JKGLO-1)/NRPROMA+1 + + ! Call the ECRAD radiation scheme + CALL RADIATION_SCHEME & + & (YRADIATION, & + & KIDIA, KFDIA, NRPROMA, & ! startcol, endcol, ncol + & NFLEVG, KAEROSOL, & + & PSOLAR_IRRADIANCE, & ! solar_irrad + & P_IAMU0(:,IBL), P_ITS(:,IBL), P_IALD(:,:,IBL), P_IALP(:,:,IBL), & + & P_IEMISS(:,:,IBL), & + & P_ICCNL(:,IBL), P_ICCNO(:,IBL) ,& + & P_IGELAM(:,IBL),P_IGEMU(:,IBL), P_ISLM(:,IBL), & + & P_IPR(:,:,IBL), P_ITI(:,:,IBL), & + & P_IAPRS(:,:,IBL),P_IHTI(:,:,IBL), & + & P_IWV(:,:,IBL),P_IICO2(:,:,IBL),P_IICH4(:,:,IBL),P_IIN2O(:,:,IBL), & + & P_INO2(:,:,IBL),P_IC11(:,:,IBL),P_IC12(:,:,IBL), P_IC22(:,:,IBL), & + & P_ICL4(:,:,IBL),P_IOZ(:,:,IBL), & + & P_ICLC(:,:,IBL),P_ILWA(:,:,IBL),P_IIWA(:,:,IBL),P_IRWA(:,:,IBL), & + & P_ISWA(:,:,IBL), & + & P_IAER(:,:,IBL), P_IAERO(:,:,IBL), & + ! Flux outputs + & P_IFRSO(:,:,IBL),P_IFRTH(:,:,IBL),P_ISWFC(:,:,IBL),P_ILWFC(:,:,IBL),& + & P_IFRSOD(:,IBL),P_IFRTED(:,:,IBL), & + & P_IFRSODC(:,IBL),P_IFRTEDC(:,IBL),& + & P_IFDIR(:,IBL),P_ICDIR(:,IBL),P_ISUDU(:,IBL), & + & P_IUVDF(:,IBL),P_IPARF(:,IBL), & + & P_IPARCF(:,IBL),P_ITINCF(:,IBL), & + & P_IEMIT(:,IBL),P_ILWDERIVATIVE(:,:,IBL), & + & P_ISWDIFFUSEBAND(:,:,IBL),P_ISWDIRECTBAND(:,:,IBL) & + ! OPTIONAL ARGUMENTS +#ifdef BITIDENTITY_TESTING + & , PRE_LIQ=P_IRE_LIQ(:,:,IBL), PRE_ICE=P_IRE_ICE(:,:,IBL) & + & , PCLOUD_OVERLAP=P_IOVERLAP(:,:,IBL), ISEED=ISEED(:,IBL) & +#endif + & , LACC=.TRUE. ) + +END DO +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_OPENACC:COMPUTE',1,ZHOOK_HANDLE_COMPUTE) + +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_OPENACC:PULLBACK',0,ZHOOK_HANDLE_PULLBACK) + +!$ACC WAIT(1) +!$ACC END DATA +CALL ZRGP_FIELDS%FIELD_WRAPPER%SYNC_HOST_RDWR() + +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_OPENACC:PULLBACK',1,ZHOOK_HANDLE_PULLBACK) + +END ASSOCIATE +END ASSOCIATE + +IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME_LAYER_OPENACC',1,ZHOOK_HANDLE) + +END SUBROUTINE RADIATION_SCHEME_LAYER_OPENACC + +END MODULE RADIATION_SCHEME_LAYER_MOD diff --git a/ifs/radiation_setup.F90 b/ifs/radiation_setup.F90 index 52997a26..2dac5002 100644 --- a/ifs/radiation_setup.F90 +++ b/ifs/radiation_setup.F90 @@ -544,8 +544,8 @@ SUBROUTINE SETUP_RADIATION_SCHEME(PRADIATION,LDOUTPUT,FILE_NAME) & PRADIATION%NWEIGHT_PAR, PRADIATION%IBAND_PAR, PRADIATION%WEIGHT_PAR,& & 'photosynthetically active radiation, PAR') - ! PRADIATION%TROP_BG_AER_MASS_EXT = 0.0_JPRB - ! PRADIATION%STRAT_BG_AER_MASS_EXT = 0.0_JPRB + PRADIATION%TROP_BG_AER_MASS_EXT = 0.0_JPRB + PRADIATION%STRAT_BG_AER_MASS_EXT = 0.0_JPRB ! IF (YDERAD%NAERMACC > 0) THEN ! ! With the MACC aerosol climatology we need to add in the ! ! background aerosol afterwards using the Tegen arrays. In this diff --git a/ifs/radintg_zrgp_mod.F90 b/ifs/radintg_zrgp_mod.F90 new file mode 100644 index 00000000..d9d7acf0 --- /dev/null +++ b/ifs/radintg_zrgp_mod.F90 @@ -0,0 +1,726 @@ +! radintg_zrgp_mod.fypp - Wrap the block-allocated radiation fields from RADINTG in a FIELD API stack +! +! (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. + + +MODULE RADINTG_ZRGP_MOD + +USE PARKIND1 , ONLY : JPRB, JPIM +USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK + +#ifdef HAVE_FIELD_API +USE FIELD_MODULE +USE FIELD_BASIC_MODULE +#endif + +IMPLICIT NONE + +PRIVATE +PUBLIC :: RADINTG_ZRGP_TYPE + +#ifdef BITIDENTITY_TESTING + LOGICAL, PARAMETER :: LBITIDENTITY = .TRUE. +#else + LOGICAL, PARAMETER :: LBITIDENTITY = .FALSE. +#endif + +TYPE RADINTG_ZRGP_TYPE + ! Field counts and offset indices for ZRGP + INTEGER(KIND=JPIM) :: IFLDSIN, IFLDSOUT, IFLDSTOT + INTEGER(KIND=JPIM) :: IINBEG, IINEND, IOUTBEG, IOUTEND + INTEGER(KIND=JPIM) :: igi + INTEGER(KIND=JPIM) :: imu0 + INTEGER(KIND=JPIM) :: iamu0 + INTEGER(KIND=JPIM) :: iemiss + INTEGER(KIND=JPIM) :: its + INTEGER(KIND=JPIM) :: islm + INTEGER(KIND=JPIM) :: iccnl + INTEGER(KIND=JPIM) :: iccno + INTEGER(KIND=JPIM) :: ibas + INTEGER(KIND=JPIM) :: itop + INTEGER(KIND=JPIM) :: igelam + INTEGER(KIND=JPIM) :: igemu + INTEGER(KIND=JPIM) :: iclon + INTEGER(KIND=JPIM) :: islon + INTEGER(KIND=JPIM) :: iald + INTEGER(KIND=JPIM) :: ialp + INTEGER(KIND=JPIM) :: iti + INTEGER(KIND=JPIM) :: ipr + INTEGER(KIND=JPIM) :: iqs + INTEGER(KIND=JPIM) :: iwv + INTEGER(KIND=JPIM) :: iclc + INTEGER(KIND=JPIM) :: ilwa + INTEGER(KIND=JPIM) :: iiwa + INTEGER(KIND=JPIM) :: iswa + INTEGER(KIND=JPIM) :: irwa + INTEGER(KIND=JPIM) :: irra + INTEGER(KIND=JPIM) :: idp + INTEGER(KIND=JPIM) :: ioz + INTEGER(KIND=JPIM) :: iecpo3 + INTEGER(KIND=JPIM) :: ihpr + INTEGER(KIND=JPIM) :: iaprs + INTEGER(KIND=JPIM) :: ihti + INTEGER(KIND=JPIM) :: ire_liq + INTEGER(KIND=JPIM) :: ire_ice + INTEGER(KIND=JPIM) :: ioverlap + INTEGER(KIND=JPIM) :: iaero + INTEGER(KIND=JPIM) :: ifrsod + INTEGER(KIND=JPIM) :: ifrted + INTEGER(KIND=JPIM) :: ifrsodc + INTEGER(KIND=JPIM) :: ifrtedc + INTEGER(KIND=JPIM) :: iemit + INTEGER(KIND=JPIM) :: isudu + INTEGER(KIND=JPIM) :: iuvdf + INTEGER(KIND=JPIM) :: iparf + INTEGER(KIND=JPIM) :: iparcf + INTEGER(KIND=JPIM) :: itincf + INTEGER(KIND=JPIM) :: ifdir + INTEGER(KIND=JPIM) :: ifdif + INTEGER(KIND=JPIM) :: icdir + INTEGER(KIND=JPIM) :: ilwderivative + INTEGER(KIND=JPIM) :: iswdirectband + INTEGER(KIND=JPIM) :: iswdiffuseband + INTEGER(KIND=JPIM) :: ifrso + INTEGER(KIND=JPIM) :: iswfc + INTEGER(KIND=JPIM) :: ifrth + INTEGER(KIND=JPIM) :: ilwfc + INTEGER(KIND=JPIM) :: iaer + INTEGER(KIND=JPIM) :: iico2 + INTEGER(KIND=JPIM) :: iich4 + INTEGER(KIND=JPIM) :: iin2o + INTEGER(KIND=JPIM) :: ino2 + INTEGER(KIND=JPIM) :: ic11 + INTEGER(KIND=JPIM) :: ic12 + INTEGER(KIND=JPIM) :: ic22 + INTEGER(KIND=JPIM) :: icl4 + INTEGER(KIND=JPIM) :: igix + +#ifdef HAVE_FIELD_API + ! Field stack wrapper for ZRGP + CLASS(FIELD_3RB), POINTER :: FIELD_WRAPPER +#endif + +CONTAINS + PROCEDURE :: SETUP => RADINTG_ZRGP_SETUP +#ifdef HAVE_FIELD_API + PROCEDURE :: SETUP_FIELD => RADINTG_ZRGP_SETUP_FIELD + PROCEDURE :: DELETE_FIELD => RADINTG_ZRGP_DELETE_FIELD +#endif + +END TYPE RADINTG_ZRGP_TYPE + +CONTAINS + +INTEGER(KIND=JPIM) FUNCTION INDRAD(KNEXT,KFLDS,LDUSE) +INTEGER(KIND=JPIM),INTENT(INOUT) :: KNEXT +INTEGER(KIND=JPIM),INTENT(IN) :: KFLDS +LOGICAL,INTENT(IN) :: LDUSE +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +IF (LHOOK) CALL DR_HOOK('RADINTG:INDRAD',0,ZHOOK_HANDLE) + +IF( LDUSE )THEN + INDRAD=KNEXT + KNEXT=KNEXT+KFLDS +ELSE + INDRAD=-99999999 +ENDIF + +IF (LHOOK) CALL DR_HOOK('RADINTG:INDRAD',1,ZHOOK_HANDLE) + +END FUNCTION INDRAD + + +SUBROUTINE RADINTG_ZRGP_SETUP( & + & SELF, NLEV, NLWEMISS, & + & NLWOUT, NSW, NFSD, NRFTOTAL_RADGRID, & + & NPROGAER, NRADAER, & + & LDEBUG, LSPPRAD, LRAYFM, & + & LAPPROXLWUPDATE, LAPPROXSWUPDATE, & + & LEPO3RA, LDIAGFORCING) + + USE YOMLUN_ECRAD, ONLY : NULOUT + + IMPLICIT NONE + + CLASS(RADINTG_ZRGP_TYPE), INTENT(INOUT):: SELF + INTEGER, INTENT(IN) :: NLEV + INTEGER, INTENT(IN) :: NLWEMISS, NLWOUT, NSW + INTEGER, INTENT(IN) :: NFSD, NRFTOTAL_RADGRID + INTEGER, INTENT(IN) :: NPROGAER, NRADAER + LOGICAL, INTENT(IN) :: LDEBUG, LSPPRAD, LRAYFM + LOGICAL, INTENT(IN) :: LAPPROXLWUPDATE, LAPPROXSWUPDATE + LOGICAL, INTENT(IN) :: LEPO3RA, LDIAGFORCING + + INTEGER(KIND=JPIM), ALLOCATABLE :: MEMBER_MAP(:) + INTEGER(KIND=JPIM) :: INEXT + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + + IF (LHOOK) CALL DR_HOOK('RADINTG_ZRGP_SETUP',0,ZHOOK_HANDLE) + + INEXT = 1 + SELF%IINBEG=1 + SELF%igi = INDRAD( INEXT, 1, ldebug) + SELF%imu0 = INDRAD( INEXT, 1, .true.) + SELF%iamu0 = INDRAD( INEXT, 1, .true.) + SELF%iemiss = INDRAD( INEXT, nlwemiss, .true.) + SELF%its = INDRAD( INEXT, 1, .true.) + SELF%islm = INDRAD( INEXT, 1, .true.) + SELF%iccnl = INDRAD( INEXT, 1, .true.) + SELF%iccno = INDRAD( INEXT, 1, .true.) + SELF%ibas = INDRAD( INEXT, 1, .true.) + SELF%itop = INDRAD( INEXT, 1, .true.) + SELF%igelam = INDRAD( INEXT, 1, .true.) + SELF%igemu = INDRAD( INEXT, 1, .true.) + SELF%iclon = INDRAD( INEXT, 1, .true.) + SELF%islon = INDRAD( INEXT, 1, .true.) + SELF%iald = INDRAD( INEXT, nsw, .true.) + SELF%ialp = INDRAD( INEXT, nsw, .true.) + SELF%iti = INDRAD( INEXT, nlev, .true.) + SELF%ipr = INDRAD( INEXT, nlev, .true.) + SELF%iqs = INDRAD( INEXT, nlev, .true.) + SELF%iwv = INDRAD( INEXT, nlev, .true.) + SELF%iclc = INDRAD( INEXT, nlev, .true.) + SELF%ilwa = INDRAD( INEXT, nlev, .true.) + SELF%iiwa = INDRAD( INEXT, nlev, .true.) + SELF%iswa = INDRAD( INEXT, nlev, .true.) + SELF%irwa = INDRAD( INEXT, nlev, .true.) + SELF%irra = INDRAD( INEXT, nlev, .true.) + SELF%idp = INDRAD( INEXT, nlev, .true.) + SELF%ioz = INDRAD( INEXT, nlev, lrayfm) + SELF%iecpo3 = INDRAD( INEXT, nlev, .not.lrayfm.and.lepo3ra) + SELF%ihpr = INDRAD( INEXT, nlev+1, .true.) + SELF%iaprs = INDRAD( INEXT, nlev+1, .true.) + SELF%ihti = INDRAD( INEXT, nlev+1, .true.) + SELF%ire_liq = INDRAD( INEXT, nlev, lbitidentity) + SELF%ire_ice = INDRAD( INEXT, nlev, lbitidentity) + SELF%ioverlap = INDRAD( INEXT, nlev-1, lbitidentity) + SELF%IINEND = INEXT-1 + SELF%IOUTBEG = INEXT + SELF%iaero = INDRAD( INEXT, nradaer*nlev, .true.) + SELF%ifrsod = INDRAD( INEXT, 1, .true.) + SELF%ifrted = INDRAD( INEXT, nlwout, .true.) + SELF%ifrsodc = INDRAD( INEXT, 1, .true.) + SELF%ifrtedc = INDRAD( INEXT, 1, .true.) + SELF%iemit = INDRAD( INEXT, 1, .true.) + SELF%isudu = INDRAD( INEXT, 1, .true.) + SELF%iuvdf = INDRAD( INEXT, 1, .true.) + SELF%iparf = INDRAD( INEXT, 1, .true.) + SELF%iparcf = INDRAD( INEXT, 1, .true.) + SELF%itincf = INDRAD( INEXT, 1, .true.) + SELF%ifdir = INDRAD( INEXT, 1, .true.) + SELF%ifdif = INDRAD( INEXT, 1, .true.) + SELF%icdir = INDRAD( INEXT, 1, .true.) + SELF%ilwderivative = INDRAD( INEXT, nlev+1, lapproxlwupdate) + SELF%iswdirectband = INDRAD( INEXT, nsw, lapproxswupdate) + SELF%iswdiffuseband = INDRAD( INEXT, nsw, lapproxswupdate) + SELF%ifrso = INDRAD( INEXT, nlev+1, .true.) + SELF%iswfc = INDRAD( INEXT, nlev+1, .true.) + SELF%ifrth = INDRAD( INEXT, nlev+1, .true.) + SELF%ilwfc = INDRAD( INEXT, nlev+1, .true.) + SELF%iaer = INDRAD( INEXT, 6*nlev, ldiagforcing) + SELF%ioz = INDRAD( INEXT, nlev, ldiagforcing) + SELF%iico2 = INDRAD( INEXT, nlev, ldiagforcing) + SELF%iich4 = INDRAD( INEXT, nlev, ldiagforcing) + SELF%iin2o = INDRAD( INEXT, nlev, ldiagforcing) + SELF%ino2 = INDRAD( INEXT, nlev, ldiagforcing) + SELF%ic11 = INDRAD( INEXT, nlev, ldiagforcing) + SELF%ic12 = INDRAD( INEXT, nlev, ldiagforcing) + SELF%ic22 = INDRAD( INEXT, nlev, ldiagforcing) + SELF%icl4 = INDRAD( INEXT, nlev, ldiagforcing) + SELF%igix = INDRAD( INEXT, 1, ldebug) + SELF%IOUTEND = INEXT-1 + SELF%iaer = INDRAD( INEXT, 6*nlev, .not.ldiagforcing) + SELF%ioz = INDRAD( INEXT, nlev, .not.(ldiagforcing.or.lrayfm)) + SELF%iico2 = INDRAD( INEXT, nlev, .not.ldiagforcing) + SELF%iich4 = INDRAD( INEXT, nlev, .not.ldiagforcing) + SELF%iin2o = INDRAD( INEXT, nlev, .not.ldiagforcing) + SELF%ino2 = INDRAD( INEXT, nlev, .not.ldiagforcing) + SELF%ic11 = INDRAD( INEXT, nlev, .not.ldiagforcing) + SELF%ic12 = INDRAD( INEXT, nlev, .not.ldiagforcing) + SELF%ic22 = INDRAD( INEXT, nlev, .not.ldiagforcing) + SELF%icl4 = INDRAD( INEXT, nlev, .not.ldiagforcing) + + IF (LDEBUG) THEN + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IGI',SELF%igi + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IMU0',SELF%imu0 + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IAMU0',SELF%iamu0 + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IEMISS',SELF%iemiss + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ITS',SELF%its + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ISLM',SELF%islm + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ICCNL',SELF%iccnl + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ICCNO',SELF%iccno + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IBAS',SELF%ibas + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ITOP',SELF%itop + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IGELAM',SELF%igelam + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IGEMU',SELF%igemu + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ICLON',SELF%iclon + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ISLON',SELF%islon + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IALD',SELF%iald + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IALP',SELF%ialp + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ITI',SELF%iti + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IPR',SELF%ipr + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IQS',SELF%iqs + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IWV',SELF%iwv + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ICLC',SELF%iclc + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ILWA',SELF%ilwa + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IIWA',SELF%iiwa + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ISWA',SELF%iswa + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IRWA',SELF%irwa + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IRRA',SELF%irra + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IDP',SELF%idp + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IOZ',SELF%ioz + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IECPO3',SELF%iecpo3 + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IHPR',SELF%ihpr + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IAPRS',SELF%iaprs + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IHTI',SELF%ihti + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IRE_LIQ',SELF%ire_liq + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IRE_ICE',SELF%ire_ice + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IOVERLAP',SELF%ioverlap + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IAERO',SELF%iaero + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IFRSOD',SELF%ifrsod + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IFRTED',SELF%ifrted + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IFRSODC',SELF%ifrsodc + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IFRTEDC',SELF%ifrtedc + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IEMIT',SELF%iemit + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ISUDU',SELF%isudu + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IUVDF',SELF%iuvdf + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IPARF',SELF%iparf + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IPARCF',SELF%iparcf + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ITINCF',SELF%itincf + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IFDIR',SELF%ifdir + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IFDIF',SELF%ifdif + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ICDIR',SELF%icdir + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ILWDERIVATIVE',SELF%ilwderivative + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ISWDIRECTBAND',SELF%iswdirectband + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ISWDIFFUSEBAND',SELF%iswdiffuseband + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IFRSO',SELF%ifrso + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ISWFC',SELF%iswfc + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IFRTH',SELF%ifrth + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ILWFC',SELF%ilwfc + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IAER',SELF%iaer + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IICO2',SELF%iico2 + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IICH4',SELF%iich4 + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IIN2O',SELF%iin2o + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'INO2',SELF%ino2 + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IC11',SELF%ic11 + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IC12',SELF%ic12 + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IC22',SELF%ic22 + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'ICL4',SELF%icl4 + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') 'IGIX',SELF%igix + ENDIF + + SELF%IFLDSIN = SELF%IINEND - SELF%IINBEG + 1 + SELF%IFLDSOUT = SELF%IOUTEND - SELF%IOUTBEG + 1 + SELF%IFLDSTOT = INEXT - 1 + + WRITE(NULOUT,'("RADINTG: IFLDSIN =",I12)')SELF%IFLDSIN + WRITE(NULOUT,'("RADINTG: IFLDSOUT =",I12)')SELF%IFLDSOUT + WRITE(NULOUT,'("RADINTG: IFLDSTOT =",I12)')SELF%IFLDSTOT + + IF (LHOOK) CALL DR_HOOK('RADINTG_ZRGP_SETUP',1,ZHOOK_HANDLE) + +END SUBROUTINE RADINTG_ZRGP_SETUP + +#ifdef HAVE_FIELD_API + +SUBROUTINE FIELD_INDRAD(MEMBER_MAP, KIDX, KNEXT, KFLDS, LDUSE) + INTEGER(KIND=JPIM), INTENT(INOUT) :: MEMBER_MAP(:) + INTEGER(KIND=JPIM), INTENT(IN) :: KIDX + INTEGER(KIND=JPIM), INTENT(INOUT) :: KNEXT + INTEGER(KIND=JPIM), INTENT(IN) :: KFLDS + LOGICAL, INTENT(IN) :: LDUSE + INTEGER(KIND=JPIM) :: ISTART, IEND + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + + IF (LHOOK) CALL DR_HOOK('RADINTG:FIELD_INDRAD',0,ZHOOK_HANDLE) + + ISTART = KNEXT + IF( LDUSE .AND. KFLDS > 0 ) THEN + IEND = ISTART + KFLDS - 1 + KNEXT = IEND + 1 + ELSE + IEND = ISTART - 1 + ENDIF + MEMBER_MAP(2*KIDX-1) = ISTART + MEMBER_MAP(2*KIDX) = IEND + + IF (LHOOK) CALL DR_HOOK('RADINTG:FIELD_INDRAD',1,ZHOOK_HANDLE) + +END SUBROUTINE FIELD_INDRAD + +SUBROUTINE RADINTG_ZRGP_SETUP_FIELD( & + & SELF, ZRGP, NLEV, NLWEMISS, & + & NLWOUT, NSW, NFSD, NRFTOTAL_RADGRID, & + & NPROGAER, NRADAER, & + & LDEBUG, LSPPRAD, LRAYFM, & + & LAPPROXLWUPDATE, LAPPROXSWUPDATE, & + & LEPO3RA, LDIAGFORCING) + + USE FIELD_FACTORY_MODULE + USE YOMLUN_ECRAD, ONLY: NULOUT + + IMPLICIT NONE + + CLASS(RADINTG_ZRGP_TYPE), INTENT(INOUT):: SELF + REAL(KIND=JPRB), INTENT(INOUT), TARGET :: ZRGP(:,:,:) + INTEGER, INTENT(IN) :: NLEV + INTEGER, INTENT(IN) :: NLWEMISS, NLWOUT, NSW + INTEGER, INTENT(IN) :: NFSD, NRFTOTAL_RADGRID + INTEGER, INTENT(IN) :: NPROGAER, NRADAER + LOGICAL, INTENT(IN) :: LDEBUG, LSPPRAD, LRAYFM + LOGICAL, INTENT(IN) :: LAPPROXLWUPDATE, LAPPROXSWUPDATE + LOGICAL, INTENT(IN) :: LEPO3RA, LDIAGFORCING + + INTEGER(KIND=JPIM), ALLOCATABLE :: MEMBER_MAP(:) + INTEGER(KIND=JPIM), ALLOCATABLE :: MEMBER_RANKS(:) + INTEGER(KIND=JPIM) :: INEXT + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + + IF (LHOOK) CALL DR_HOOK('RADINTG_ZRGP_SETUP_FIELD',0,ZHOOK_HANDLE) + + ALLOCATE(MEMBER_MAP(154)) + ALLOCATE(MEMBER_RANKS(77)) + + INEXT = 1 + ! igi + CALL FIELD_INDRAD( MEMBER_MAP, 1, INEXT, 1, ldebug) + MEMBER_RANKS(1) = 2 + ! imu0 + CALL FIELD_INDRAD( MEMBER_MAP, 2, INEXT, 1, .true.) + MEMBER_RANKS(2) = 2 + ! iamu0 + CALL FIELD_INDRAD( MEMBER_MAP, 3, INEXT, 1, .true.) + MEMBER_RANKS(3) = 2 + ! iemiss + CALL FIELD_INDRAD( MEMBER_MAP, 4, INEXT, nlwemiss, .true.) + MEMBER_RANKS(4) = 3 + ! its + CALL FIELD_INDRAD( MEMBER_MAP, 5, INEXT, 1, .true.) + MEMBER_RANKS(5) = 2 + ! islm + CALL FIELD_INDRAD( MEMBER_MAP, 6, INEXT, 1, .true.) + MEMBER_RANKS(6) = 2 + ! iccnl + CALL FIELD_INDRAD( MEMBER_MAP, 7, INEXT, 1, .true.) + MEMBER_RANKS(7) = 2 + ! iccno + CALL FIELD_INDRAD( MEMBER_MAP, 8, INEXT, 1, .true.) + MEMBER_RANKS(8) = 2 + ! ibas + CALL FIELD_INDRAD( MEMBER_MAP, 9, INEXT, 1, .true.) + MEMBER_RANKS(9) = 2 + ! itop + CALL FIELD_INDRAD( MEMBER_MAP, 10, INEXT, 1, .true.) + MEMBER_RANKS(10) = 2 + ! igelam + CALL FIELD_INDRAD( MEMBER_MAP, 11, INEXT, 1, .true.) + MEMBER_RANKS(11) = 2 + ! igemu + CALL FIELD_INDRAD( MEMBER_MAP, 12, INEXT, 1, .true.) + MEMBER_RANKS(12) = 2 + ! iclon + CALL FIELD_INDRAD( MEMBER_MAP, 13, INEXT, 1, .true.) + MEMBER_RANKS(13) = 2 + ! islon + CALL FIELD_INDRAD( MEMBER_MAP, 14, INEXT, 1, .true.) + MEMBER_RANKS(14) = 2 + ! iald + CALL FIELD_INDRAD( MEMBER_MAP, 15, INEXT, nsw, .true.) + MEMBER_RANKS(15) = 3 + ! ialp + CALL FIELD_INDRAD( MEMBER_MAP, 16, INEXT, nsw, .true.) + MEMBER_RANKS(16) = 3 + ! iti + CALL FIELD_INDRAD( MEMBER_MAP, 17, INEXT, nlev, .true.) + MEMBER_RANKS(17) = 3 + ! ipr + CALL FIELD_INDRAD( MEMBER_MAP, 18, INEXT, nlev, .true.) + MEMBER_RANKS(18) = 3 + ! iqs + CALL FIELD_INDRAD( MEMBER_MAP, 19, INEXT, nlev, .true.) + MEMBER_RANKS(19) = 3 + ! iwv + CALL FIELD_INDRAD( MEMBER_MAP, 20, INEXT, nlev, .true.) + MEMBER_RANKS(20) = 3 + ! iclc + CALL FIELD_INDRAD( MEMBER_MAP, 21, INEXT, nlev, .true.) + MEMBER_RANKS(21) = 3 + ! ilwa + CALL FIELD_INDRAD( MEMBER_MAP, 22, INEXT, nlev, .true.) + MEMBER_RANKS(22) = 3 + ! iiwa + CALL FIELD_INDRAD( MEMBER_MAP, 23, INEXT, nlev, .true.) + MEMBER_RANKS(23) = 3 + ! iswa + CALL FIELD_INDRAD( MEMBER_MAP, 24, INEXT, nlev, .true.) + MEMBER_RANKS(24) = 3 + ! irwa + CALL FIELD_INDRAD( MEMBER_MAP, 25, INEXT, nlev, .true.) + MEMBER_RANKS(25) = 3 + ! irra + CALL FIELD_INDRAD( MEMBER_MAP, 26, INEXT, nlev, .true.) + MEMBER_RANKS(26) = 3 + ! idp + CALL FIELD_INDRAD( MEMBER_MAP, 27, INEXT, nlev, .true.) + MEMBER_RANKS(27) = 3 + ! ioz + CALL FIELD_INDRAD( MEMBER_MAP, 28, INEXT, nlev, lrayfm) + MEMBER_RANKS(28) = 3 + ! iecpo3 + CALL FIELD_INDRAD( MEMBER_MAP, 29, INEXT, nlev, .not.lrayfm.and.lepo3ra) + MEMBER_RANKS(29) = 3 + ! ihpr + CALL FIELD_INDRAD( MEMBER_MAP, 30, INEXT, nlev+1, .true.) + MEMBER_RANKS(30) = 3 + ! iaprs + CALL FIELD_INDRAD( MEMBER_MAP, 31, INEXT, nlev+1, .true.) + MEMBER_RANKS(31) = 3 + ! ihti + CALL FIELD_INDRAD( MEMBER_MAP, 32, INEXT, nlev+1, .true.) + MEMBER_RANKS(32) = 3 + ! ire_liq + CALL FIELD_INDRAD( MEMBER_MAP, 33, INEXT, nlev, lbitidentity) + MEMBER_RANKS(33) = 3 + ! ire_ice + CALL FIELD_INDRAD( MEMBER_MAP, 34, INEXT, nlev, lbitidentity) + MEMBER_RANKS(34) = 3 + ! ioverlap + CALL FIELD_INDRAD( MEMBER_MAP, 35, INEXT, nlev-1, lbitidentity) + MEMBER_RANKS(35) = 3 + ! iaero + CALL FIELD_INDRAD( MEMBER_MAP, 36, INEXT, nradaer*nlev, .true.) + MEMBER_RANKS(36) = 3 + ! ifrsod + CALL FIELD_INDRAD( MEMBER_MAP, 37, INEXT, 1, .true.) + MEMBER_RANKS(37) = 2 + ! ifrted + CALL FIELD_INDRAD( MEMBER_MAP, 38, INEXT, nlwout, .true.) + MEMBER_RANKS(38) = 3 + ! ifrsodc + CALL FIELD_INDRAD( MEMBER_MAP, 39, INEXT, 1, .true.) + MEMBER_RANKS(39) = 2 + ! ifrtedc + CALL FIELD_INDRAD( MEMBER_MAP, 40, INEXT, 1, .true.) + MEMBER_RANKS(40) = 2 + ! iemit + CALL FIELD_INDRAD( MEMBER_MAP, 41, INEXT, 1, .true.) + MEMBER_RANKS(41) = 2 + ! isudu + CALL FIELD_INDRAD( MEMBER_MAP, 42, INEXT, 1, .true.) + MEMBER_RANKS(42) = 2 + ! iuvdf + CALL FIELD_INDRAD( MEMBER_MAP, 43, INEXT, 1, .true.) + MEMBER_RANKS(43) = 2 + ! iparf + CALL FIELD_INDRAD( MEMBER_MAP, 44, INEXT, 1, .true.) + MEMBER_RANKS(44) = 2 + ! iparcf + CALL FIELD_INDRAD( MEMBER_MAP, 45, INEXT, 1, .true.) + MEMBER_RANKS(45) = 2 + ! itincf + CALL FIELD_INDRAD( MEMBER_MAP, 46, INEXT, 1, .true.) + MEMBER_RANKS(46) = 2 + ! ifdir + CALL FIELD_INDRAD( MEMBER_MAP, 47, INEXT, 1, .true.) + MEMBER_RANKS(47) = 2 + ! ifdif + CALL FIELD_INDRAD( MEMBER_MAP, 48, INEXT, 1, .true.) + MEMBER_RANKS(48) = 2 + ! icdir + CALL FIELD_INDRAD( MEMBER_MAP, 49, INEXT, 1, .true.) + MEMBER_RANKS(49) = 2 + ! ilwderivative + CALL FIELD_INDRAD( MEMBER_MAP, 50, INEXT, nlev+1, lapproxlwupdate) + MEMBER_RANKS(50) = 3 + ! iswdirectband + CALL FIELD_INDRAD( MEMBER_MAP, 51, INEXT, nsw, lapproxswupdate) + MEMBER_RANKS(51) = 3 + ! iswdiffuseband + CALL FIELD_INDRAD( MEMBER_MAP, 52, INEXT, nsw, lapproxswupdate) + MEMBER_RANKS(52) = 3 + ! ifrso + CALL FIELD_INDRAD( MEMBER_MAP, 53, INEXT, nlev+1, .true.) + MEMBER_RANKS(53) = 3 + ! iswfc + CALL FIELD_INDRAD( MEMBER_MAP, 54, INEXT, nlev+1, .true.) + MEMBER_RANKS(54) = 3 + ! ifrth + CALL FIELD_INDRAD( MEMBER_MAP, 55, INEXT, nlev+1, .true.) + MEMBER_RANKS(55) = 3 + ! ilwfc + CALL FIELD_INDRAD( MEMBER_MAP, 56, INEXT, nlev+1, .true.) + MEMBER_RANKS(56) = 3 + ! iaer + CALL FIELD_INDRAD( MEMBER_MAP, 57, INEXT, 6*nlev, ldiagforcing) + MEMBER_RANKS(57) = 3 + ! ioz + CALL FIELD_INDRAD( MEMBER_MAP, 58, INEXT, nlev, ldiagforcing) + MEMBER_RANKS(58) = 3 + ! iico2 + CALL FIELD_INDRAD( MEMBER_MAP, 59, INEXT, nlev, ldiagforcing) + MEMBER_RANKS(59) = 3 + ! iich4 + CALL FIELD_INDRAD( MEMBER_MAP, 60, INEXT, nlev, ldiagforcing) + MEMBER_RANKS(60) = 3 + ! iin2o + CALL FIELD_INDRAD( MEMBER_MAP, 61, INEXT, nlev, ldiagforcing) + MEMBER_RANKS(61) = 3 + ! ino2 + CALL FIELD_INDRAD( MEMBER_MAP, 62, INEXT, nlev, ldiagforcing) + MEMBER_RANKS(62) = 3 + ! ic11 + CALL FIELD_INDRAD( MEMBER_MAP, 63, INEXT, nlev, ldiagforcing) + MEMBER_RANKS(63) = 3 + ! ic12 + CALL FIELD_INDRAD( MEMBER_MAP, 64, INEXT, nlev, ldiagforcing) + MEMBER_RANKS(64) = 3 + ! ic22 + CALL FIELD_INDRAD( MEMBER_MAP, 65, INEXT, nlev, ldiagforcing) + MEMBER_RANKS(65) = 3 + ! icl4 + CALL FIELD_INDRAD( MEMBER_MAP, 66, INEXT, nlev, ldiagforcing) + MEMBER_RANKS(66) = 3 + ! igix + CALL FIELD_INDRAD( MEMBER_MAP, 67, INEXT, 1, ldebug) + MEMBER_RANKS(67) = 2 + ! iaer + CALL FIELD_INDRAD( MEMBER_MAP, 68, INEXT, 6*nlev, .not.ldiagforcing) + MEMBER_RANKS(68) = 3 + ! ioz + CALL FIELD_INDRAD( MEMBER_MAP, 69, INEXT, nlev, .not.(ldiagforcing.or.lrayfm)) + MEMBER_RANKS(69) = 3 + ! iico2 + CALL FIELD_INDRAD( MEMBER_MAP, 70, INEXT, nlev, .not.ldiagforcing) + MEMBER_RANKS(70) = 3 + ! iich4 + CALL FIELD_INDRAD( MEMBER_MAP, 71, INEXT, nlev, .not.ldiagforcing) + MEMBER_RANKS(71) = 3 + ! iin2o + CALL FIELD_INDRAD( MEMBER_MAP, 72, INEXT, nlev, .not.ldiagforcing) + MEMBER_RANKS(72) = 3 + ! ino2 + CALL FIELD_INDRAD( MEMBER_MAP, 73, INEXT, nlev, .not.ldiagforcing) + MEMBER_RANKS(73) = 3 + ! ic11 + CALL FIELD_INDRAD( MEMBER_MAP, 74, INEXT, nlev, .not.ldiagforcing) + MEMBER_RANKS(74) = 3 + ! ic12 + CALL FIELD_INDRAD( MEMBER_MAP, 75, INEXT, nlev, .not.ldiagforcing) + MEMBER_RANKS(75) = 3 + ! ic22 + CALL FIELD_INDRAD( MEMBER_MAP, 76, INEXT, nlev, .not.ldiagforcing) + MEMBER_RANKS(76) = 3 + ! icl4 + CALL FIELD_INDRAD( MEMBER_MAP, 77, INEXT, nlev, .not.ldiagforcing) + MEMBER_RANKS(77) = 3 + + CALL FIELD_NEW(SELF%FIELD_WRAPPER, LSTACK=.TRUE., DATA=ZRGP, MEMBER_MAP=MEMBER_MAP, MEMBER_RANKS=MEMBER_RANKS) + + IF (LDEBUG) THEN + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IGI',MEMBER_MAP(1),MEMBER_MAP(2) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IMU0',MEMBER_MAP(3),MEMBER_MAP(4) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IAMU0',MEMBER_MAP(5),MEMBER_MAP(6) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IEMISS',MEMBER_MAP(7),MEMBER_MAP(8) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ITS',MEMBER_MAP(9),MEMBER_MAP(10) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ISLM',MEMBER_MAP(11),MEMBER_MAP(12) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ICCNL',MEMBER_MAP(13),MEMBER_MAP(14) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ICCNO',MEMBER_MAP(15),MEMBER_MAP(16) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IBAS',MEMBER_MAP(17),MEMBER_MAP(18) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ITOP',MEMBER_MAP(19),MEMBER_MAP(20) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IGELAM',MEMBER_MAP(21),MEMBER_MAP(22) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IGEMU',MEMBER_MAP(23),MEMBER_MAP(24) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ICLON',MEMBER_MAP(25),MEMBER_MAP(26) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ISLON',MEMBER_MAP(27),MEMBER_MAP(28) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IALD',MEMBER_MAP(29),MEMBER_MAP(30) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IALP',MEMBER_MAP(31),MEMBER_MAP(32) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ITI',MEMBER_MAP(33),MEMBER_MAP(34) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IPR',MEMBER_MAP(35),MEMBER_MAP(36) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IQS',MEMBER_MAP(37),MEMBER_MAP(38) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IWV',MEMBER_MAP(39),MEMBER_MAP(40) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ICLC',MEMBER_MAP(41),MEMBER_MAP(42) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ILWA',MEMBER_MAP(43),MEMBER_MAP(44) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IIWA',MEMBER_MAP(45),MEMBER_MAP(46) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ISWA',MEMBER_MAP(47),MEMBER_MAP(48) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IRWA',MEMBER_MAP(49),MEMBER_MAP(50) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IRRA',MEMBER_MAP(51),MEMBER_MAP(52) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IDP',MEMBER_MAP(53),MEMBER_MAP(54) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IOZ',MEMBER_MAP(55),MEMBER_MAP(56) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IECPO3',MEMBER_MAP(57),MEMBER_MAP(58) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IHPR',MEMBER_MAP(59),MEMBER_MAP(60) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IAPRS',MEMBER_MAP(61),MEMBER_MAP(62) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IHTI',MEMBER_MAP(63),MEMBER_MAP(64) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IRE_LIQ',MEMBER_MAP(65),MEMBER_MAP(66) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IRE_ICE',MEMBER_MAP(67),MEMBER_MAP(68) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IOVERLAP',MEMBER_MAP(69),MEMBER_MAP(70) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IAERO',MEMBER_MAP(71),MEMBER_MAP(72) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IFRSOD',MEMBER_MAP(73),MEMBER_MAP(74) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IFRTED',MEMBER_MAP(75),MEMBER_MAP(76) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IFRSODC',MEMBER_MAP(77),MEMBER_MAP(78) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IFRTEDC',MEMBER_MAP(79),MEMBER_MAP(80) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IEMIT',MEMBER_MAP(81),MEMBER_MAP(82) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ISUDU',MEMBER_MAP(83),MEMBER_MAP(84) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IUVDF',MEMBER_MAP(85),MEMBER_MAP(86) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IPARF',MEMBER_MAP(87),MEMBER_MAP(88) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IPARCF',MEMBER_MAP(89),MEMBER_MAP(90) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ITINCF',MEMBER_MAP(91),MEMBER_MAP(92) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IFDIR',MEMBER_MAP(93),MEMBER_MAP(94) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IFDIF',MEMBER_MAP(95),MEMBER_MAP(96) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ICDIR',MEMBER_MAP(97),MEMBER_MAP(98) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ILWDERIVATIVE',MEMBER_MAP(99),MEMBER_MAP(100) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ISWDIRECTBAND',MEMBER_MAP(101),MEMBER_MAP(102) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ISWDIFFUSEBAND',MEMBER_MAP(103),MEMBER_MAP(104) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IFRSO',MEMBER_MAP(105),MEMBER_MAP(106) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ISWFC',MEMBER_MAP(107),MEMBER_MAP(108) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IFRTH',MEMBER_MAP(109),MEMBER_MAP(110) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ILWFC',MEMBER_MAP(111),MEMBER_MAP(112) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IAER',MEMBER_MAP(113),MEMBER_MAP(114) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IOZ',MEMBER_MAP(115),MEMBER_MAP(116) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IICO2',MEMBER_MAP(117),MEMBER_MAP(118) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IICH4',MEMBER_MAP(119),MEMBER_MAP(120) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IIN2O',MEMBER_MAP(121),MEMBER_MAP(122) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'INO2',MEMBER_MAP(123),MEMBER_MAP(124) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IC11',MEMBER_MAP(125),MEMBER_MAP(126) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IC12',MEMBER_MAP(127),MEMBER_MAP(128) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IC22',MEMBER_MAP(129),MEMBER_MAP(130) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ICL4',MEMBER_MAP(131),MEMBER_MAP(132) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IGIX',MEMBER_MAP(133),MEMBER_MAP(134) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IAER',MEMBER_MAP(135),MEMBER_MAP(136) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IOZ',MEMBER_MAP(137),MEMBER_MAP(138) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IICO2',MEMBER_MAP(139),MEMBER_MAP(140) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IICH4',MEMBER_MAP(141),MEMBER_MAP(142) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IIN2O',MEMBER_MAP(143),MEMBER_MAP(144) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'INO2',MEMBER_MAP(145),MEMBER_MAP(146) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IC11',MEMBER_MAP(147),MEMBER_MAP(148) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IC12',MEMBER_MAP(149),MEMBER_MAP(150) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'IC22',MEMBER_MAP(151),MEMBER_MAP(152) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') 'ICL4',MEMBER_MAP(153),MEMBER_MAP(154) + ENDIF + + IF (LHOOK) CALL DR_HOOK('RADINTG_ZRGP_SETUP_FIELD',1,ZHOOK_HANDLE) + +END SUBROUTINE RADINTG_ZRGP_SETUP_FIELD + +SUBROUTINE RADINTG_ZRGP_DELETE_FIELD(SELF) + USE FIELD_FACTORY_MODULE + IMPLICIT NONE + + CLASS(RADINTG_ZRGP_TYPE), INTENT(INOUT) :: SELF + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + + IF (LHOOK) CALL DR_HOOK('RADINTG_ZRGP_DELETE_FIELD',0,ZHOOK_HANDLE) + + CALL FIELD_DELETE(SELF%FIELD_WRAPPER) + + IF (LHOOK) CALL DR_HOOK('RADINTG_ZRGP_DELETE_FIELD',1,ZHOOK_HANDLE) +END SUBROUTINE RADINTG_ZRGP_DELETE_FIELD + +#endif + +END MODULE RADINTG_ZRGP_MOD diff --git a/ifs/radintg_zrgp_mod.fypp b/ifs/radintg_zrgp_mod.fypp new file mode 100644 index 00000000..45bd8195 --- /dev/null +++ b/ifs/radintg_zrgp_mod.fypp @@ -0,0 +1,245 @@ +! radintg_zrgp_mod.fypp - Wrap the block-allocated radiation fields from RADINTG in a FIELD API stack +! +! (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 radiation_config_file = os.path.dirname(os.path.abspath(_THIS_FILE_)) + '/radiation_fields_config.yaml' +#:set radiation_config = field_config.VariableConfiguration(radiation_config_file) +#:set zrgp_in = radiation_config.groups['ZRGP_IN'] +#:set zrgp_out = radiation_config.groups['ZRGP_OUT'] +#:set zrgp_local = radiation_config.groups['ZRGP_LOCAL'] +#:set variables = zrgp_in.variables + zrgp_out.variables + zrgp_local.variables +#:set variable_names = list(dict.fromkeys(v.name for v in variables)) +#:set variable_dim = {v.name: 2 if v.dim[0] == 1 else 3 for v in variables} +#:def kflds_from_dim(dim) +$:'*'.join(str(d) for d in dim) +#:enddef +#:endmute + +MODULE RADINTG_ZRGP_MOD + +USE PARKIND1 , ONLY : JPRB, JPIM +USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK + +#ifdef HAVE_FIELD_API +USE FIELD_MODULE +USE FIELD_BASIC_MODULE +#endif + +IMPLICIT NONE + +PRIVATE +PUBLIC :: RADINTG_ZRGP_TYPE + +#ifdef BITIDENTITY_TESTING + LOGICAL, PARAMETER :: LBITIDENTITY = .TRUE. +#else + LOGICAL, PARAMETER :: LBITIDENTITY = .FALSE. +#endif + +TYPE RADINTG_ZRGP_TYPE + ! Field counts and offset indices for ZRGP + INTEGER(KIND=JPIM) :: IFLDSIN, IFLDSOUT, IFLDSTOT + INTEGER(KIND=JPIM) :: IINBEG, IINEND, IOUTBEG, IOUTEND + #:for v_name in variable_names + INTEGER(KIND=JPIM) :: ${v_name}$ + #:endfor + +#ifdef HAVE_FIELD_API + ! Field stack wrapper for ZRGP + CLASS(FIELD_3RB), POINTER :: FIELD_WRAPPER +#endif + +CONTAINS + PROCEDURE :: SETUP => RADINTG_ZRGP_SETUP +#ifdef HAVE_FIELD_API + PROCEDURE :: SETUP_FIELD => RADINTG_ZRGP_SETUP_FIELD + PROCEDURE :: DELETE_FIELD => RADINTG_ZRGP_DELETE_FIELD +#endif + +END TYPE RADINTG_ZRGP_TYPE + +CONTAINS + +INTEGER(KIND=JPIM) FUNCTION INDRAD(KNEXT,KFLDS,LDUSE) +INTEGER(KIND=JPIM),INTENT(INOUT) :: KNEXT +INTEGER(KIND=JPIM),INTENT(IN) :: KFLDS +LOGICAL,INTENT(IN) :: LDUSE +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +IF (LHOOK) CALL DR_HOOK('RADINTG:INDRAD',0,ZHOOK_HANDLE) + +IF( LDUSE )THEN + INDRAD=KNEXT + KNEXT=KNEXT+KFLDS +ELSE + INDRAD=-99999999 +ENDIF + +IF (LHOOK) CALL DR_HOOK('RADINTG:INDRAD',1,ZHOOK_HANDLE) + +END FUNCTION INDRAD + + +SUBROUTINE RADINTG_ZRGP_SETUP( & + & SELF, NLEV, NLWEMISS, & + & NLWOUT, NSW, NFSD, NRFTOTAL_RADGRID, & + & NPROGAER, NRADAER, & + & LDEBUG, LSPPRAD, LRAYFM, & + & LAPPROXLWUPDATE, LAPPROXSWUPDATE, & + & LEPO3RA, LDIAGFORCING) + + USE YOMLUN_ECRAD, ONLY : NULOUT + + IMPLICIT NONE + + CLASS(RADINTG_ZRGP_TYPE), INTENT(INOUT):: SELF + INTEGER, INTENT(IN) :: NLEV + INTEGER, INTENT(IN) :: NLWEMISS, NLWOUT, NSW + INTEGER, INTENT(IN) :: NFSD, NRFTOTAL_RADGRID + INTEGER, INTENT(IN) :: NPROGAER, NRADAER + LOGICAL, INTENT(IN) :: LDEBUG, LSPPRAD, LRAYFM + LOGICAL, INTENT(IN) :: LAPPROXLWUPDATE, LAPPROXSWUPDATE + LOGICAL, INTENT(IN) :: LEPO3RA, LDIAGFORCING + + INTEGER(KIND=JPIM), ALLOCATABLE :: MEMBER_MAP(:) + INTEGER(KIND=JPIM) :: INEXT + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + + IF (LHOOK) CALL DR_HOOK('RADINTG_ZRGP_SETUP',0,ZHOOK_HANDLE) + + INEXT = 1 + SELF%IINBEG=1 + #:for v in zrgp_in.variables + SELF%${v.name}$ = INDRAD( INEXT, ${kflds_from_dim(v.dim)}$, ${v.condition}$) + #:endfor + SELF%IINEND = INEXT-1 + SELF%IOUTBEG = INEXT + #:for v in zrgp_out.variables + SELF%${v.name}$ = INDRAD( INEXT, ${kflds_from_dim(v.dim)}$, ${v.condition}$) + #:endfor + SELF%IOUTEND = INEXT-1 + #:for v in zrgp_local.variables + SELF%${v.name}$ = INDRAD( INEXT, ${kflds_from_dim(v.dim)}$, ${v.condition}$) + #:endfor + + IF (LDEBUG) THEN + #:for v_name in variable_names + WRITE(NULOUT,'("RADINTG: ",A16,"=",I12)') '${v_name.upper()}$',SELF%${v_name}$ + #:endfor + ENDIF + + SELF%IFLDSIN = SELF%IINEND - SELF%IINBEG + 1 + SELF%IFLDSOUT = SELF%IOUTEND - SELF%IOUTBEG + 1 + SELF%IFLDSTOT = INEXT - 1 + + WRITE(NULOUT,'("RADINTG: IFLDSIN =",I12)')SELF%IFLDSIN + WRITE(NULOUT,'("RADINTG: IFLDSOUT =",I12)')SELF%IFLDSOUT + WRITE(NULOUT,'("RADINTG: IFLDSTOT =",I12)')SELF%IFLDSTOT + + IF (LHOOK) CALL DR_HOOK('RADINTG_ZRGP_SETUP',1,ZHOOK_HANDLE) + +END SUBROUTINE RADINTG_ZRGP_SETUP + +#ifdef HAVE_FIELD_API + +SUBROUTINE FIELD_INDRAD(MEMBER_MAP, KIDX, KNEXT, KFLDS, LDUSE) + INTEGER(KIND=JPIM), INTENT(INOUT) :: MEMBER_MAP(:) + INTEGER(KIND=JPIM), INTENT(IN) :: KIDX + INTEGER(KIND=JPIM), INTENT(INOUT) :: KNEXT + INTEGER(KIND=JPIM), INTENT(IN) :: KFLDS + LOGICAL, INTENT(IN) :: LDUSE + INTEGER(KIND=JPIM) :: ISTART, IEND + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + + IF (LHOOK) CALL DR_HOOK('RADINTG:FIELD_INDRAD',0,ZHOOK_HANDLE) + + ISTART = KNEXT + IF( LDUSE .AND. KFLDS > 0 ) THEN + IEND = ISTART + KFLDS - 1 + KNEXT = IEND + 1 + ELSE + IEND = ISTART - 1 + ENDIF + MEMBER_MAP(2*KIDX-1) = ISTART + MEMBER_MAP(2*KIDX) = IEND + + IF (LHOOK) CALL DR_HOOK('RADINTG:FIELD_INDRAD',1,ZHOOK_HANDLE) + +END SUBROUTINE FIELD_INDRAD + +SUBROUTINE RADINTG_ZRGP_SETUP_FIELD( & + & SELF, ZRGP, NLEV, NLWEMISS, & + & NLWOUT, NSW, NFSD, NRFTOTAL_RADGRID, & + & NPROGAER, NRADAER, & + & LDEBUG, LSPPRAD, LRAYFM, & + & LAPPROXLWUPDATE, LAPPROXSWUPDATE, & + & LEPO3RA, LDIAGFORCING) + + USE FIELD_FACTORY_MODULE + USE YOMLUN_ECRAD, ONLY: NULOUT + + IMPLICIT NONE + + CLASS(RADINTG_ZRGP_TYPE), INTENT(INOUT):: SELF + REAL(KIND=JPRB), INTENT(INOUT), TARGET :: ZRGP(:,:,:) + INTEGER, INTENT(IN) :: NLEV + INTEGER, INTENT(IN) :: NLWEMISS, NLWOUT, NSW + INTEGER, INTENT(IN) :: NFSD, NRFTOTAL_RADGRID + INTEGER, INTENT(IN) :: NPROGAER, NRADAER + LOGICAL, INTENT(IN) :: LDEBUG, LSPPRAD, LRAYFM + LOGICAL, INTENT(IN) :: LAPPROXLWUPDATE, LAPPROXSWUPDATE + LOGICAL, INTENT(IN) :: LEPO3RA, LDIAGFORCING + + INTEGER(KIND=JPIM), ALLOCATABLE :: MEMBER_MAP(:) + INTEGER(KIND=JPIM), ALLOCATABLE :: MEMBER_RANKS(:) + INTEGER(KIND=JPIM) :: INEXT + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + + IF (LHOOK) CALL DR_HOOK('RADINTG_ZRGP_SETUP_FIELD',0,ZHOOK_HANDLE) + + ALLOCATE(MEMBER_MAP(${len(variables) * 2}$)) + ALLOCATE(MEMBER_RANKS(${len(variables)}$)) + + INEXT = 1 + #:for idx, v in enumerate(variables) + ! ${v.name}$ + CALL FIELD_INDRAD( MEMBER_MAP, ${idx + 1}$, INEXT, ${kflds_from_dim(v.dim)}$, ${v.condition}$) + MEMBER_RANKS(${idx+1}$) = ${variable_dim[v.name]}$ + #:endfor + + CALL FIELD_NEW(SELF%FIELD_WRAPPER, LSTACK=.TRUE., DATA=ZRGP, MEMBER_MAP=MEMBER_MAP, MEMBER_RANKS=MEMBER_RANKS) + + IF (LDEBUG) THEN + #:for idx, v in enumerate(variables) + WRITE(NULOUT,'("RADINTG_ZRGP_SETUP_FIELD: ",A7,"=",I8,":",I8)') '${v.name.upper()}$',MEMBER_MAP(${2*idx+1}$),MEMBER_MAP(${2*idx+2}$) + #:endfor + ENDIF + + IF (LHOOK) CALL DR_HOOK('RADINTG_ZRGP_SETUP_FIELD',1,ZHOOK_HANDLE) + +END SUBROUTINE RADINTG_ZRGP_SETUP_FIELD + +SUBROUTINE RADINTG_ZRGP_DELETE_FIELD(SELF) + USE FIELD_FACTORY_MODULE + IMPLICIT NONE + + CLASS(RADINTG_ZRGP_TYPE), INTENT(INOUT) :: SELF + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + + IF (LHOOK) CALL DR_HOOK('RADINTG_ZRGP_DELETE_FIELD',0,ZHOOK_HANDLE) + + CALL FIELD_DELETE(SELF%FIELD_WRAPPER) + + IF (LHOOK) CALL DR_HOOK('RADINTG_ZRGP_DELETE_FIELD',1,ZHOOK_HANDLE) +END SUBROUTINE RADINTG_ZRGP_DELETE_FIELD + +#endif + +END MODULE RADINTG_ZRGP_MOD diff --git a/ifs/yoerad.F90 b/ifs/yoerad.F90 index 3a9f4283..791f5941 100644 --- a/ifs/yoerad.F90 +++ b/ifs/yoerad.F90 @@ -40,6 +40,7 @@ MODULE YOERAD LOGICAL :: LDIAGFORCING = .FALSE. LOGICAL :: LAPPROXLWUPDATE = .TRUE. LOGICAL :: LAPPROXSWUPDATE = .FALSE. + LOGICAL :: LECRAD_ON_GPU = .FALSE. LOGICAL :: LCCNL = .TRUE. LOGICAL :: LCCNO = .TRUE. REAL(KIND=JPRB) :: RCCNLND = 900.0_JPRB @@ -107,8 +108,8 @@ MODULE YOERAD ! NSW : INTEGER : NUMBER OF SHORTWAVE SPECTRAL INTERVALS ! NSWNL : INTEGER : NUMBER OF SHORTWAVE SPECTRAL INTERVALS IN NL MODEL ! NSWTL : INTEGER : NUMBER OF SHORTWAVE SPECTRAL INTERVALS IN TL MODEL -! NTSW : INTEGER : MAXIMUM POSSIBLE NUMBER OF SW SPECTRAL INTERVALS -! NUV : INTEGER : NUMBER OF UV SPECTRAL INTERVALS FOR THE UV PROCESSOR +! NTSW : INTEGER : MAXIMUM POSSIBLE NUMBER OF SW SPECTRAL INTERVALS +! NUV : INTEGER : NUMBER OF UV SPECTRAL INTERVALS FOR THE UV PROCESSOR ! LOPTRPROMA:LOGICAL: .T. NRPROMA will be optimised ! : .F. NRPROMA will not be optimised (forced ! : by negative NRPROMA in namelist) @@ -131,7 +132,7 @@ MODULE YOERAD ! the following only available in newer modular radiation scheme: ! 4 = SW/LW Baran data fitted versus ice mixing ratio ! NLIQOPT: INTEGER : INDEX FOR LIQUID WATER CLOUD OPTICAL PROPERTIES -! 0 = SW Fouquart (1991) LW Smith-Shi (1992) YF/SmSh +! 0 = SW Fouquart (1991) LW Smith-Shi (1992) YF/SmSh ! 1 = SW Slingo (1989) LW Savijarvi (1997) ! 2 = SW Slingo (1989) LW Lindner-Li (2000) ! the following only available in RADLSW, not RADLSWR: @@ -144,16 +145,16 @@ MODULE YOERAD ! NCSRADF: INTEGER : 1 IF ACCUMULATED, 2 IF INSTANTANEOUS ! LRRTM : LOGICAL : .T. IF RRTM140MR IS USED FOR LW RADIATION TRANSFER -! LHVOLCA: LOGICAL : .T. IF USING HISTORICAL VOLCANIC AEROSOLS +! LHVOLCA: LOGICAL : .T. IF USING HISTORICAL VOLCANIC AEROSOLS ! LNEWAER: LOGICAL : .T. IF AEROSOL MONTHLY DISTRIBUTIONS ARE USED ! LNOTROAER:LOGICAL: .T. IF NO TROPOSPHERIC AEROSOLS ! CRTABLEDIR: CHAR : IF NRADINT > 0 SPECIFIES DIRECTORY PATH FOR RADIATION ! : GRID RTABLE NAMELIST -! CRTABLEFIL: CHAR : IF NRADINT > 0 SPECIFIES FILE NAME OF RADIATION +! CRTABLEFIL: CHAR : IF NRADINT > 0 SPECIFIES FILE NAME OF RADIATION ! : GRID RTABLE NAMELIST ! LRAYL : LOGICAL : .T. NEW RAYLEIGH FOR SW-6 VERSION -! RAOVLP : REAL : COEFFICIENTS FOR ALPHA1 FACTOR IN HOGAN & +! RAOVLP : REAL : COEFFICIENTS FOR ALPHA1 FACTOR IN HOGAN & ! RBOVLP : REAL : ILLINGWORTH's PARAMETRIZATION ! LCCNL : LOGICAL : .T. IF CCN CONCENTRATION OVER LAND IS DIAGNOSED @@ -163,14 +164,14 @@ MODULE YOERAD ! LDIFFC : LOGICAL : .T. IF SAVIJARVI'S DIFFUSIVITY CORRECTION IS ON -! NINHOM : INTEGER : 0 IF NO INHOMOGENEITY SCALING EFFECT +! NINHOM : INTEGER : 0 IF NO INHOMOGENEITY SCALING EFFECT ! 1 IF SIMPLE 0.7 SCALING ! 2 IF BARKER, 3 IF CAIRNS ET AL. ! RLWINHF: REAL : INHOMOG. SCALING FACTOR FOR CLOUD LW OPTICAL THICKNESS ! RSWINHF: REAL : INHOMOG. SCALING FACTOR FOR CLOUD SW OPTICAL THICKNESS -! NPERTAER : INTERGER : PERCENTAGE OF PERTURBATION FOR AEROSOL -! NPERTOZONE : INTEGER : PERCENTAGE OF PERTURBATION FOR OZONE +! NPERTAER : INTERGER : PERCENTAGE OF PERTURBATION FOR AEROSOL +! NPERTOZONE : INTEGER : PERCENTAGE OF PERTURBATION FOR OZONE ! NHINCSOL : INTEGER : 0: Total Solar Irradiance (TSI) fixed at 1366.0 W m-2 ! 1: Deprecated - use default ! 2: Deprecated - use default @@ -186,7 +187,7 @@ MODULE YOERAD ! RMINICE: REAL : MINIMUM SIZE FOR ICE PARTICLES (um) ! FOR ICE ! NMINICE: INTEGER : 1-6 MINIMUM ICE PARTICLE SIZE DEPENDS ON LATITUDE, 0=INDEPENDENT OF LATITUDE -! NDECOLAT:INTEGER : DECORRELATION LENGTH FOR CF AND CW +! NDECOLAT:INTEGER : DECORRELATION LENGTH FOR CF AND CW ! 0: SPECIFIED INDEPENDENT OF LATITUDE, 1: SHONK-HOGAN, 2: IMPROVED ! NMCICA : INTEGER : 0: NO McICA ! 1: McICA w maximum-random in cloud generator @@ -195,7 +196,7 @@ MODULE YOERAD ! NGHGRAD: INTEGER : configuration of 3D GHG climatologies accounted for in radiation ! 0: global values ! 1: CO2 2: CH4 3: N2O 4: NO2 5:CFC11 6:CFC12 -! 12: CO2+CH4 13: CO2+CH4+N2O +! 12: CO2+CH4 13: CO2+CH4+N2O ! 16: CO2+CH4+N2O+CFC11+CFC12 ! LETRACGMS: LOGICAL : F=Cariolle climatol. T=GEMS-derived clim for CO2, CH4, O3 ! LAERCLIM : LOGICAL : .T. for output of the climatological aerosol optical depth at 550 nm @@ -215,7 +216,7 @@ MODULE YOERAD ! NREDGLW : INTEGER : 0 full resolution for RRTM_LW (256) ! 1 ECMWF High resolution model configuration (_LW: 140) ! 2 ECMWF EPS configuration (_LW: 70) -! LDIAGFORCING : LOGICAL : T Write input ozone, ghg and aerosol forcing to 3D fields +! LDIAGFORCING : LOGICAL : T Write input ozone, ghg and aerosol forcing to 3D fields ! To be used for diagnostics only; do not use in production runs ! NAERMACC : INTEGER : MACC-derived aerosol climatology on a NMCLAT x NMCLON grid ! RAESHxx : REAL : parameters related to scale height of MACC-derived aerosol climatology @@ -240,9 +241,9 @@ MODULE YOERAD ! LAverageSZA : LOGICAL : Compute an averaged solar zenith angle ! across the time interval required ! (either a model timestep or a radiation -! timestep). Should be used with +! timestep). Should be used with ! LCentredTimeSZA=TRUE. -! LUsePre2017Rad : LOGICAL : Use the pre-2017 radiation scheme, rather +! LUsePre2017Rad : LOGICAL : Use the pre-2017 radiation scheme, rather ! than the modular scheme contained in the ! separate "radiation" library. Note that ! the radiation library may make use of the @@ -270,12 +271,12 @@ MODULE YOERAD ! used. If it starts with "." or "/" then ! a relative path is assumed, otherwise ! the default directory. -! NLWEMISS : INTEGER : Number of emissivity spectral intervals, set +! NLWEMISS : INTEGER : Number of emissivity spectral intervals, set ! according to the value of NEMISSSCHEME; traditionally ! this has always been 2: outside the IR window and within ! NLWOUT : INTEGER : Number of spectral intervals to pass LW downwelling flux ! to RADHEATN; traditionally this was 1, but this led -! to errors with LAPPROXLWUPDATE=TRUE, which updated +! to errors with LAPPROXLWUPDATE=TRUE, which updated ! fluxes using a single broadband emissivity. Now we can ! do approximate updates using full spectral emissivity. ! ------------------------------------------------------------------ @@ -307,7 +308,7 @@ MODULE YOERAD ! compute rate of horizontal exchange of radiation ! between clouds and clear skies in SPARTACUS solver ! ------------------------------------------------------------------ -! KMODTS : INTEGER : (A Bozzo) switch for different radiative transfer schemes for UV +! KMODTS : INTEGER : (A Bozzo) switch for different radiative transfer schemes for UV ! = 0 Fouquart&Bonnel adapted by Morcrette and Arola ! = 1 eddington (joseph et al., 1976) ! = 2 pifm (zdunkowski et al., 1980) @@ -317,7 +318,7 @@ MODULE YOERAD ! default for Tegen climatology was 0.03 ! STBKG : REAL stratospheric background OD@550nm for aerosol climatology. ! ------------------------------------------------------------------ -! LDUSEASON : LOGICAL enables a monthly-varying scale height for the +! LDUSEASON : LOGICAL enables a monthly-varying scale height for the ! dust aerosol climatology ! LAER3D : LOGICAL : to enable aerosol climatology in 3D diff --git a/ifsaux/Makefile b/ifsaux/Makefile index f62a4a2f..d0dd107c 100644 --- a/ifsaux/Makefile +++ b/ifsaux/Makefile @@ -1,5 +1,5 @@ SOURCES = parkind1.F90 yomlun_ifsaux.F90 yomcst.F90 abor1.F90 \ - yomtag.F90 mpl_module.F90 yommp0_ifsaux.F90 yomdyncore.F90 yomlun_ecrad.F90 + yomtag.F90 mpl_module.F90 yommp0_ifsaux.F90 yomdyncore_ecrad.F90 yomlun_ecrad.F90 MAKE_INCLUDES = ../bin/make_intfbl.1.pl INCLUDE_DIR = ../include diff --git a/ifsrrtm/CMakeLists.txt b/ifsrrtm/CMakeLists.txt index 183a1c9c..463ed0aa 100644 --- a/ifsrrtm/CMakeLists.txt +++ b/ifsrrtm/CMakeLists.txt @@ -11,7 +11,7 @@ set( ifsrrtm_SOURCES modify_wv_continuum.F90 parrrtm.F90 parsrtm.F90 - rrtm_utils.F90 + compute_laytrop_min_max.F90 rrtm_cmbgb1.F90 rrtm_cmbgb10.F90 rrtm_cmbgb11.F90 diff --git a/ifsrrtm/Makefile b/ifsrrtm/Makefile index bb784334..ef127bb0 100644 --- a/ifsrrtm/Makefile +++ b/ifsrrtm/Makefile @@ -1,5 +1,5 @@ OBJECTS = parrrtm.o parsrtm.o rrtm_prepare_gases.o \ -rrtm_gas_optical_depth.o rrtm_setcoef_140gp.o \ +rrtm_gas_optical_depth.o rrtm_setcoef_140gp.o compute_laytrop_min_max.o \ rrtm_taumol1.o rrtm_taumol10.o rrtm_taumol11.o rrtm_taumol12.o \ rrtm_taumol13.o rrtm_taumol14.o rrtm_taumol15.o rrtm_taumol16.o \ rrtm_taumol2.o rrtm_taumol3.o rrtm_taumol4.o rrtm_taumol5.o \ @@ -58,7 +58,7 @@ $(LIBIFSRRTM): $(OBJECTS) %.o: %.F90 $(FC) $(FCFLAGS) -c $< -$(DEPS_FILE): $(SOURCES) +$(DEPS_FILE): $(SOURCES) $(MAKE_DEPS) $(SOURCES) > $(DEPS_FILE) dummy_includes: @@ -81,4 +81,3 @@ clean-deps: .PHONY: deps dummy_includes includes clean-deps include $(DEPS_FILE) - diff --git a/ifsrrtm/rrtm_utils.F90 b/ifsrrtm/compute_laytrop_min_max.F90 similarity index 100% rename from ifsrrtm/rrtm_utils.F90 rename to ifsrrtm/compute_laytrop_min_max.F90 diff --git a/ifsrrtm/rrtm_gas_optical_depth.F90 b/ifsrrtm/rrtm_gas_optical_depth.F90 index 27b50df9..f4099b19 100644 --- a/ifsrrtm/rrtm_gas_optical_depth.F90 +++ b/ifsrrtm/rrtm_gas_optical_depth.F90 @@ -89,7 +89,7 @@ SUBROUTINE RRTM_GAS_OPTICAL_DEPTH(KIDIA,KFDIA,KLEV,POD,PAVEL, PCOLDRY,PCOLBRD,PW #include "rrtm_taumol7.intfb.h" #include "rrtm_taumol8.intfb.h" #include "rrtm_taumol9.intfb.h" -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" IF (LHOOK) CALL DR_HOOK('RRTM_GAS_OPTICAL_DEPTH',0,ZHOOK_HANDLE) diff --git a/ifsrrtm/rrtm_taumol1.F90 b/ifsrrtm/rrtm_taumol1.F90 index b9096cd1..5922e953 100644 --- a/ifsrrtm/rrtm_taumol1.F90 +++ b/ifsrrtm/rrtm_taumol1.F90 @@ -188,7 +188,7 @@ SUBROUTINE RRTM_TAUMOL1 (KIDIA,KFDIA,KLEV,taug,PAVEL,& INTEGER(KIND=JPIM) :: ich, icl, ixc0, ixp, jc, jl INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/rrtm_taumol10.F90 b/ifsrrtm/rrtm_taumol10.F90 index 5277d7d3..21b0a7b2 100644 --- a/ifsrrtm/rrtm_taumol10.F90 +++ b/ifsrrtm/rrtm_taumol10.F90 @@ -61,7 +61,7 @@ SUBROUTINE RRTM_TAUMOL10 (KIDIA,KFDIA,KLEV,taug,& INTEGER(KIND=JPIM) :: ich, icl, ixc0, ixp, jc, jl INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/rrtm_taumol11.F90 b/ifsrrtm/rrtm_taumol11.F90 index e7c31818..a6d2d5b7 100644 --- a/ifsrrtm/rrtm_taumol11.F90 +++ b/ifsrrtm/rrtm_taumol11.F90 @@ -69,7 +69,7 @@ SUBROUTINE RRTM_TAUMOL11 (KIDIA,KFDIA,KLEV,taug,& INTEGER(KIND=JPIM) :: ich, icl, ixc0, ixp, jc, jl INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/rrtm_taumol12.F90 b/ifsrrtm/rrtm_taumol12.F90 index d8ae43bc..d271f06c 100644 --- a/ifsrrtm/rrtm_taumol12.F90 +++ b/ifsrrtm/rrtm_taumol12.F90 @@ -1,7 +1,7 @@ !---------------------------------------------------------------------------- SUBROUTINE RRTM_TAUMOL12 (KIDIA,KFDIA,KLEV,taug,& & P_TAUAERL,fac00,fac01,fac10,fac11,forfac,forfrac,indfor,jp,jt,jt1,oneminus,& - & colh2o,colco2,laytrop,selffac,selffrac,indself,fracs, & + & colh2o,colco2,laytrop,selffac,selffrac,indself,fracs, & & rat_h2oco2, rat_h2oco2_1,laytrop_min,laytrop_max) ! BAND 12: 1800-2080 cm-1 (low - H2O,CO2; high - nothing) @@ -85,7 +85,7 @@ SUBROUTINE RRTM_TAUMOL12 (KIDIA,KFDIA,KLEV,taug,& #define MOD1(x) ((x) - AINT((x))) -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/rrtm_taumol13.F90 b/ifsrrtm/rrtm_taumol13.F90 index 8323e6e1..da25c955 100644 --- a/ifsrrtm/rrtm_taumol13.F90 +++ b/ifsrrtm/rrtm_taumol13.F90 @@ -96,7 +96,7 @@ SUBROUTINE RRTM_TAUMOL13 (KIDIA,KFDIA,KLEV,taug,& #define MOD1(x) ((x) - AINT((x))) -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/rrtm_taumol14.F90 b/ifsrrtm/rrtm_taumol14.F90 index 71ad25e3..4b3b3679 100644 --- a/ifsrrtm/rrtm_taumol14.F90 +++ b/ifsrrtm/rrtm_taumol14.F90 @@ -58,7 +58,7 @@ SUBROUTINE RRTM_TAUMOL14 (KIDIA,KFDIA,KLEV,taug,& INTEGER(KIND=JPIM) :: ich, icl, ixc0, ixp, jc, jl INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/rrtm_taumol15.F90 b/ifsrrtm/rrtm_taumol15.F90 index 941561c5..1ff9d197 100644 --- a/ifsrrtm/rrtm_taumol15.F90 +++ b/ifsrrtm/rrtm_taumol15.F90 @@ -84,7 +84,7 @@ SUBROUTINE RRTM_TAUMOL15 (KIDIA,KFDIA,KLEV,taug,& #define MOD1(x) ((x) - AINT((x))) -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/rrtm_taumol16.F90 b/ifsrrtm/rrtm_taumol16.F90 index 607cc6cb..16c46327 100644 --- a/ifsrrtm/rrtm_taumol16.F90 +++ b/ifsrrtm/rrtm_taumol16.F90 @@ -79,7 +79,7 @@ SUBROUTINE RRTM_TAUMOL16 (KIDIA,KFDIA,KLEV,taug,& #define MOD1(x) ((x) - AINT((x))) -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/rrtm_taumol2.F90 b/ifsrrtm/rrtm_taumol2.F90 index 4a9a9708..319dc08c 100644 --- a/ifsrrtm/rrtm_taumol2.F90 +++ b/ifsrrtm/rrtm_taumol2.F90 @@ -70,7 +70,7 @@ SUBROUTINE RRTM_TAUMOL2 (KIDIA,KFDIA,KLEV,taug,PAVEL,coldry,& INTEGER(KIND=JPIM) :: ich, icl, ixc0, ixp, jc, jl INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/rrtm_taumol3.F90 b/ifsrrtm/rrtm_taumol3.F90 index 74f8aed3..b4bb281b 100644 --- a/ifsrrtm/rrtm_taumol3.F90 +++ b/ifsrrtm/rrtm_taumol3.F90 @@ -92,7 +92,7 @@ SUBROUTINE RRTM_TAUMOL3 (KIDIA,KFDIA,KLEV,taug,& #define MOD1(x) ((x) - AINT((x))) -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/rrtm_taumol4.F90 b/ifsrrtm/rrtm_taumol4.F90 index 0b14afb9..428826d9 100644 --- a/ifsrrtm/rrtm_taumol4.F90 +++ b/ifsrrtm/rrtm_taumol4.F90 @@ -84,7 +84,7 @@ SUBROUTINE RRTM_TAUMOL4 (KIDIA,KFDIA,KLEV,taug,& #define MOD1(x) ((x) - AINT((x))) -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/rrtm_taumol5.F90 b/ifsrrtm/rrtm_taumol5.F90 index 6d70cbc4..1d353d89 100644 --- a/ifsrrtm/rrtm_taumol5.F90 +++ b/ifsrrtm/rrtm_taumol5.F90 @@ -92,7 +92,7 @@ SUBROUTINE RRTM_TAUMOL5 (KIDIA,KFDIA,KLEV,taug,wx,& #define MOD1(x) ((x) - AINT((x))) -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/rrtm_taumol6.F90 b/ifsrrtm/rrtm_taumol6.F90 index 5c32d9e6..5e396e00 100644 --- a/ifsrrtm/rrtm_taumol6.F90 +++ b/ifsrrtm/rrtm_taumol6.F90 @@ -71,7 +71,7 @@ SUBROUTINE RRTM_TAUMOL6 (KIDIA,KFDIA,KLEV,taug,wx,& INTEGER(KIND=JPIM) :: ich, icl, ixc0, ixp, jc, jl INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/rrtm_taumol7.F90 b/ifsrrtm/rrtm_taumol7.F90 index f4fde0d8..bf23ce5d 100644 --- a/ifsrrtm/rrtm_taumol7.F90 +++ b/ifsrrtm/rrtm_taumol7.F90 @@ -91,7 +91,7 @@ SUBROUTINE RRTM_TAUMOL7 (KIDIA,KFDIA,KLEV,taug,& #define MOD1(x) ((x) - AINT((x))) -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/rrtm_taumol8.F90 b/ifsrrtm/rrtm_taumol8.F90 index 7c41bca8..b0e3b730 100644 --- a/ifsrrtm/rrtm_taumol8.F90 +++ b/ifsrrtm/rrtm_taumol8.F90 @@ -75,7 +75,7 @@ SUBROUTINE RRTM_TAUMOL8 (KIDIA,KFDIA,KLEV,taug,wx,& INTEGER(KIND=JPIM) :: ich, icl, ixc0, ixp, jc, jl INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/rrtm_taumol9.F90 b/ifsrrtm/rrtm_taumol9.F90 index ceab7caa..106fb38d 100644 --- a/ifsrrtm/rrtm_taumol9.F90 +++ b/ifsrrtm/rrtm_taumol9.F90 @@ -95,7 +95,7 @@ SUBROUTINE RRTM_TAUMOL9 (KIDIA,KFDIA,KLEV,taug,& #define MOD1(x) ((x) - AINT((x))) -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/srtm_gas_optical_depth.F90 b/ifsrrtm/srtm_gas_optical_depth.F90 index 46af8841..0089c244 100644 --- a/ifsrrtm/srtm_gas_optical_depth.F90 +++ b/ifsrrtm/srtm_gas_optical_depth.F90 @@ -123,7 +123,7 @@ SUBROUTINE SRTM_GAS_OPTICAL_DEPTH & #include "srtm_taumol27.intfb.h" #include "srtm_taumol28.intfb.h" #include "srtm_taumol29.intfb.h" -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" ! ------------------------------------------------------------------ diff --git a/ifsrrtm/srtm_taumol16.F90 b/ifsrrtm/srtm_taumol16.F90 index 38bc1d8d..78300e6e 100644 --- a/ifsrrtm/srtm_taumol16.F90 +++ b/ifsrrtm/srtm_taumol16.F90 @@ -65,7 +65,7 @@ SUBROUTINE SRTM_TAUMOL16 & & Z_TAURAY INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/srtm_taumol17.F90 b/ifsrrtm/srtm_taumol17.F90 index 87ea0fe2..b282202f 100644 --- a/ifsrrtm/srtm_taumol17.F90 +++ b/ifsrrtm/srtm_taumol17.F90 @@ -64,7 +64,7 @@ SUBROUTINE SRTM_TAUMOL17 & REAL(KIND=JPRB) :: Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM, Z_TAURAY INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/srtm_taumol18.F90 b/ifsrrtm/srtm_taumol18.F90 index 3a98e5b4..db3070de 100644 --- a/ifsrrtm/srtm_taumol18.F90 +++ b/ifsrrtm/srtm_taumol18.F90 @@ -66,7 +66,7 @@ SUBROUTINE SRTM_TAUMOL18 & & Z_TAURAY INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/srtm_taumol19.F90 b/ifsrrtm/srtm_taumol19.F90 index 1fcfc16a..2c56f612 100644 --- a/ifsrrtm/srtm_taumol19.F90 +++ b/ifsrrtm/srtm_taumol19.F90 @@ -66,7 +66,7 @@ SUBROUTINE SRTM_TAUMOL19 & INTEGER(KIND=JPIM) :: I_LAY_NEXT INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/srtm_taumol20.F90 b/ifsrrtm/srtm_taumol20.F90 index 02ad33f5..80f0c34c 100644 --- a/ifsrrtm/srtm_taumol20.F90 +++ b/ifsrrtm/srtm_taumol20.F90 @@ -64,7 +64,7 @@ SUBROUTINE SRTM_TAUMOL20 & & Z_TAURAY INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/srtm_taumol21.F90 b/ifsrrtm/srtm_taumol21.F90 index 2bfb6c93..9f56035f 100644 --- a/ifsrrtm/srtm_taumol21.F90 +++ b/ifsrrtm/srtm_taumol21.F90 @@ -66,7 +66,7 @@ SUBROUTINE SRTM_TAUMOL21 & & Z_TAURAY INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/srtm_taumol22.F90 b/ifsrrtm/srtm_taumol22.F90 index d1bb0c23..f901c467 100644 --- a/ifsrrtm/srtm_taumol22.F90 +++ b/ifsrrtm/srtm_taumol22.F90 @@ -66,7 +66,7 @@ SUBROUTINE SRTM_TAUMOL22 & & Z_TAURAY, Z_O2ADJ , Z_O2CONT INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/srtm_taumol23.F90 b/ifsrrtm/srtm_taumol23.F90 index a753213e..181df993 100644 --- a/ifsrrtm/srtm_taumol23.F90 +++ b/ifsrrtm/srtm_taumol23.F90 @@ -63,7 +63,7 @@ SUBROUTINE SRTM_TAUMOL23 & & Z_TAURAY INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/srtm_taumol24.F90 b/ifsrrtm/srtm_taumol24.F90 index 1c6d769c..5456f8ad 100644 --- a/ifsrrtm/srtm_taumol24.F90 +++ b/ifsrrtm/srtm_taumol24.F90 @@ -68,7 +68,7 @@ SUBROUTINE SRTM_TAUMOL24 & & Z_TAURAY INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/srtm_taumol25.F90 b/ifsrrtm/srtm_taumol25.F90 index 5288b19b..6520ced0 100644 --- a/ifsrrtm/srtm_taumol25.F90 +++ b/ifsrrtm/srtm_taumol25.F90 @@ -60,7 +60,7 @@ SUBROUTINE SRTM_TAUMOL25 & & Z_TAURAY INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/srtm_taumol26.F90 b/ifsrrtm/srtm_taumol26.F90 index f096fb30..db732822 100644 --- a/ifsrrtm/srtm_taumol26.F90 +++ b/ifsrrtm/srtm_taumol26.F90 @@ -44,7 +44,7 @@ SUBROUTINE SRTM_TAUMOL26 & INTEGER(KIND=JPIM) :: IG, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/srtm_taumol27.F90 b/ifsrrtm/srtm_taumol27.F90 index afecdec9..b9a876d3 100644 --- a/ifsrrtm/srtm_taumol27.F90 +++ b/ifsrrtm/srtm_taumol27.F90 @@ -55,7 +55,7 @@ SUBROUTINE SRTM_TAUMOL27 & & Z_TAURAY INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/srtm_taumol28.F90 b/ifsrrtm/srtm_taumol28.F90 index 5483ae4c..04812429 100644 --- a/ifsrrtm/srtm_taumol28.F90 +++ b/ifsrrtm/srtm_taumol28.F90 @@ -58,7 +58,7 @@ SUBROUTINE SRTM_TAUMOL28 & & Z_TAURAY INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/ifsrrtm/srtm_taumol29.F90 b/ifsrrtm/srtm_taumol29.F90 index e517d0f9..de3fd93d 100644 --- a/ifsrrtm/srtm_taumol29.F90 +++ b/ifsrrtm/srtm_taumol29.F90 @@ -64,7 +64,7 @@ SUBROUTINE SRTM_TAUMOL29 & & Z_TAURAY INTEGER(KIND=JPIM) :: llaytrop_min, llaytrop_max -#include "rrtm_utils.intfb.h" +#include "compute_laytrop_min_max.intfb.h" if (present(laytrop_min) .AND. present(laytrop_max)) then llaytrop_min = laytrop_min diff --git a/include/rrtm_utils.intfb.h b/include/compute_laytrop_min_max.intfb.h similarity index 100% rename from include/rrtm_utils.intfb.h rename to include/compute_laytrop_min_max.intfb.h diff --git a/include/radiation_scheme.intfb.h b/include/radiation_scheme.intfb.h index cf26ca08..d431422a 100644 --- a/include/radiation_scheme.intfb.h +++ b/include/radiation_scheme.intfb.h @@ -17,7 +17,7 @@ SUBROUTINE RADIATION_SCHEME & & PFLUX_UV, PFLUX_PAR, PFLUX_PAR_CLEAR, & & PFLUX_SW_DN_TOA, PEMIS_OUT, PLWDERIVATIVE, & & PSWDIFFUSEBAND, PSWDIRECTBAND, & - & PRE_LIQ, PRE_ICE, ISEED, PCLOUD_OVERLAP) + & PRE_LIQ, PRE_ICE, ISEED, PCLOUD_OVERLAP, LACC) use parkind1 , only:& & jpim,& & jprb @@ -84,5 +84,6 @@ REAL(KIND=JPRB), INTENT(IN), OPTIONAL :: PRE_LIQ(KLON, KLEV) REAL(KIND=JPRB), INTENT(IN), OPTIONAL :: PRE_ICE(KLON, KLEV) INTEGER, INTENT(IN), OPTIONAL :: ISEED(KLON) REAL(KIND=JPRB), INTENT(IN), OPTIONAL :: PCLOUD_OVERLAP(KLON, KLEV-1) +LOGICAL, INTENT(IN), OPTIONAL :: LACC END SUBROUTINE RADIATION_SCHEME end interface diff --git a/radiation/Makefile_deps b/radiation/Makefile_deps index 76af53b4..31371362 100644 --- a/radiation/Makefile_deps +++ b/radiation/Makefile_deps @@ -5,7 +5,7 @@ radiation_cloudless_lw.o: radiation_adding_ica_lw.o radiation_config.o radiation radiation_cloudless_sw.o: radiation_adding_ica_sw.o radiation_config.o radiation_constants.o radiation_flux.o radiation_single_level.o radiation_two_stream.o radiation_cloud_generator.o: radiation_cloud_cover.o radiation_pdf_sampler.o radiation_random_numbers.o radiation_cloud_generator_acc.o: radiation_random_numbers.o -radiation_cloud_optics.o: radiation_cloud.o radiation_config.o radiation_constants.o radiation_ice_optics_baran.o radiation_ice_optics_baran2017.o radiation_ice_optics_fu.o radiation_ice_optics_yi.o radiation_liquid_optics_slingo.o radiation_liquid_optics_socrates.o radiation_thermodynamics.o +radiation_cloud_optics.o: radiation_cloud.o radiation_config.o radiation_constants.o radiation_ice_optics_baran.o radiation_ice_optics_baran2017.o radiation_ice_optics_fu.o radiation_ice_optics_yi.o radiation_liquid_optics_jahangir.o radiation_liquid_optics_nielsen.o radiation_liquid_optics_slingo.o radiation_liquid_optics_socrates.o radiation_thermodynamics.o radiation_config.o: radiation_aerosol_optics_data.o radiation_cloud_cover.o radiation_cloud_optics_data.o radiation_ecckd.o radiation_general_cloud_optics_data.o radiation_pdf_sampler.o radiation_spectral_definition.o radiation_ecckd.o: radiation_constants.o radiation_ecckd_gas.o radiation_gas_constants.o radiation_spectral_definition.o radiation_ecckd_gas.o: radiation_gas_constants.o diff --git a/test/ifs/CMakeLists.txt b/test/ifs/CMakeLists.txt index e920390f..4c3eb2b6 100644 --- a/test/ifs/CMakeLists.txt +++ b/test/ifs/CMakeLists.txt @@ -82,6 +82,7 @@ function( add_ecrad_ifs_test ) endif() set( CONFIG_NAM "${CMAKE_CURRENT_BINARY_DIR}/config_${_PAR_NAME}.nam" ) list( APPEND _PAR_NAMELIST_OPTIONS "directory_name=\\\"data\\\"" ) + list( APPEND _PAR_NAMELIST_OPTIONS "nblocksize=15" ) add_custom_command( OUTPUT ${CONFIG_NAM} COMMAND @@ -111,17 +112,19 @@ function( add_ecrad_ifs_test ) DEPENDS config_${_PAR_NAME}_${PREC} ) - foreach( binary ecrad_${PREC} ecrad_ifs_${PREC} ecrad_ifs_blocked_${PREC} ) - - ecbuild_add_test( - TARGET ${binary}_${_PAR_NAME}_net - COMMAND ${binary} - ARGS - ${CONFIG_NET_NAM} - ${TEST_IFS_INPUT} - output_${binary}_${_PAR_NAME}_net.nc - DEPENDS config_${_PAR_NAME}_${PREC}_net - ) + foreach( binary ecrad_${PREC} ecrad_ifs_${PREC} ecrad_ifs_blocked_${PREC} ecrad_ifs_field_api_${PREC} ) + + if( TARGET ${binary} ) + ecbuild_add_test( + TARGET ${binary}_${_PAR_NAME}_net + COMMAND ${binary} + ARGS + ${CONFIG_NET_NAM} + ${TEST_IFS_INPUT} + output_${binary}_${_PAR_NAME}_net.nc + DEPENDS config_${_PAR_NAME}_${PREC}_net + ) + endif() endforeach() @@ -142,7 +145,7 @@ function( add_ecrad_ifs_test ) set( NCCMP_OPTIONS ) endif() - foreach( binary ecrad_ifs_${PREC} ecrad_ifs_blocked_${PREC} ) + foreach( binary ecrad_ifs_${PREC} ecrad_ifs_blocked_${PREC} ecrad_ifs_field_api_${PREC} ) if( TARGET ${binary} ) add_ecrad_nccmp_test(