From a61c7e0444085c69b268ce274d2100e56cfccb1e Mon Sep 17 00:00:00 2001 From: Balthasar Reuter Date: Tue, 26 Aug 2025 18:28:54 +0200 Subject: [PATCH 01/14] Move ifs_blocking to ifs directory and ensure separate module directories are used --- driver/CMakeLists.txt | 7 +++++- driver/Makefile | 2 +- driver/ecrad_ifs_driver_blocked.F90 | 8 +++---- ifs/CMakeLists.txt | 7 ++++++ ifs/Makefile | 3 ++- {driver => ifs}/ifs_blocking.F90 | 34 ++++++++++------------------- 6 files changed, 31 insertions(+), 30 deletions(-) rename {driver => ifs}/ifs_blocking.F90 (95%) diff --git a/driver/CMakeLists.txt b/driver/CMakeLists.txt index 50176a23..73def153 100644 --- a/driver/CMakeLists.txt +++ b/driver/CMakeLists.txt @@ -14,6 +14,8 @@ ecbuild_add_library( ecrad_driver_read_input.F90 ecrad_driver_config.F90 print_matrix_mod.F90 + PUBLIC_INCLUDES + "$" PUBLIC_DEFINITIONS $<$:NO_OPENMP> PUBLIC_LIBS @@ -21,6 +23,10 @@ ecbuild_add_library( 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} @@ -45,7 +51,6 @@ ecbuild_add_executable( TARGET ecrad_ifs_blocked_${PREC} SOURCES ecrad_ifs_driver_blocked.F90 - ifs_blocking.F90 LIBS ifs.${PREC} driver_lib.${PREC} diff --git a/driver/Makefile b/driver/Makefile index 9670382a..fd63c114 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/ecrad_ifs_driver_blocked.F90 b/driver/ecrad_ifs_driver_blocked.F90 index c8d90dd6..29f47a3a 100644 --- a/driver/ecrad_ifs_driver_blocked.F90 +++ b/driver/ecrad_ifs_driver_blocked.F90 @@ -363,9 +363,9 @@ 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 ifs_setup_indices(ifs_config, yradiation, nlev, driver_config%iverbose>4) + call ifs_copy_inputs_to_blocked(ifs_config, yradiation,& + & ncol, nlev, nproma, single_level, thermodynamics, gas, cloud, aerosol,& & sin_latitude, longitude_rad, land_frac, pressure_fl, temperature_fl,& & zrgp & #ifdef BITIDENTITY_TESTING @@ -478,7 +478,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(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) diff --git a/ifs/CMakeLists.txt b/ifs/CMakeLists.txt index f3de0083..7e2dc9fb 100644 --- a/ifs/CMakeLists.txt +++ b/ifs/CMakeLists.txt @@ -19,13 +19,20 @@ set( ifs_SOURCES yoe_spectral_planck.F90 cloud_overlap_decorr_len.F90 yoerad.F90 + ifs_blocking.F90 ) ecbuild_add_library( TARGET ifs.${PREC} TYPE OBJECT SOURCES ${ifs_SOURCES} + PUBLIC_INCLUDES + "$" PRIVATE_LIBS ecrad.${PREC} ecrad_base.${PREC} ) +set_target_properties( ifs.${PREC} + PROPERTIES + Fortran_MODULE_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}/module_ifs" +) diff --git a/ifs/Makefile b/ifs/Makefile index d9a515b4..624b0432 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 OBJECTS := $(SOURCES:.F90=.o) LIBIFS = ../lib/libifs.a diff --git a/driver/ifs_blocking.F90 b/ifs/ifs_blocking.F90 similarity index 95% rename from driver/ifs_blocking.F90 rename to ifs/ifs_blocking.F90 index 03875ec5..a1181042 100644 --- a/driver/ifs_blocking.F90 +++ b/ifs/ifs_blocking.F90 @@ -52,14 +52,12 @@ integer(kind=jpim) function indrad(knext,kflds,lduse) end function indrad -subroutine ifs_setup_indices (driver_config, ifs_config, yradiation, nlev) +subroutine ifs_setup_indices (ifs_config, yradiation, nlev, lldebug) 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 @@ -67,12 +65,12 @@ subroutine ifs_setup_indices (driver_config, ifs_config, yradiation, nlev) integer, intent(inout) :: nlev + logical, intent(in) :: lldebug + 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 @@ -273,7 +271,7 @@ subroutine ifs_setup_indices (driver_config, ifs_config, yradiation, nlev) 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) @@ -284,20 +282,16 @@ 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 implicit none - ! Configuration specific to this driver - type(driver_config_type), intent(in) :: driver_config - type(ifs_config_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 @@ -319,13 +313,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 @@ -497,22 +490,18 @@ 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 - ! Configuration specific to this driver - type(driver_config_type), intent(in) :: driver_config - type(ifs_config_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(:,:,:) @@ -525,13 +514,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 ! ------------------------------------------------------- From 66e5dd992bd4e944693bf6c19dd712e45c818871 Mon Sep 17 00:00:00 2001 From: Balthasar Reuter Date: Wed, 27 Aug 2025 23:34:11 +0200 Subject: [PATCH 02/14] Add ZRGP indexing logic from IFS in radintg_zrgp_mod --- CMakeLists.txt | 7 + driver/ecrad_ifs_driver_blocked.F90 | 84 ++++---- ifs/CMakeLists.txt | 27 +++ ifs/field_config.py | 71 +++++++ ifs/ifs_blocking.F90 | 253 +--------------------- ifs/radiation_fields_config.yaml | 216 +++++++++++++++++++ ifs/radintg_zrgp_mod.F90 | 317 ++++++++++++++++++++++++++++ ifs/radintg_zrgp_mod.fypp | 136 ++++++++++++ 8 files changed, 822 insertions(+), 289 deletions(-) create mode 100644 ifs/field_config.py create mode 100644 ifs/radiation_fields_config.yaml create mode 100644 ifs/radintg_zrgp_mod.F90 create mode 100644 ifs/radintg_zrgp_mod.fypp diff --git a/CMakeLists.txt b/CMakeLists.txt index 9bcc3693..2602bc9b 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -57,6 +57,13 @@ ecbuild_add_option( if( HAVE_FIAT AND fiat_HAVE_MPI ) list( APPEND ECRAD_COMPILE_DEFINITIONS EASY_NETCDF_READ_MPI ) endif() +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 diff --git a/driver/ecrad_ifs_driver_blocked.F90 b/driver/ecrad_ifs_driver_blocked.F90 index 29f47a3a..7f1eda3d 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 implicit none @@ -94,14 +95,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 @@ -341,8 +342,6 @@ program ecrad_ifs_driver if(allocated(flux%lw_derivatives)) 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)) @@ -354,8 +353,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)) @@ -363,8 +360,15 @@ program ecrad_ifs_driver ! Section 4a: Reshuffle into blocked memory layout ! -------------------------------------------------------- - call ifs_setup_indices(ifs_config, yradiation, nlev, driver_config%iverbose>4) - call ifs_copy_inputs_to_blocked(ifs_config, yradiation,& + 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 & @@ -415,40 +419,40 @@ program ecrad_ifs_driver & nlev, yradiation%rad_config%n_aerosol_types, & ! nlev, naerosols & single_level%solar_irradiance, & ! solar_irrad ! array inputs - & zrgp(1,ifs_config%iamu0,ib), zrgp(1,ifs_config%its,ib), & ! mu0, skintemp - & zrgp(1,ifs_config%iald,ib) , zrgp(1,ifs_config%ialp,ib), & ! albedo_dif, albedo_dir - & zrgp(1,ifs_config%iemiss,ib), & ! spectral emissivity - & zrgp(1,ifs_config%iccnl,ib), zrgp(1,ifs_config%iccno,ib) ,& ! CCN concentration, land and sea - & zrgp(1,ifs_config%igelam,ib),zrgp(1,ifs_config%igemu,ib), & ! longitude, sine of latitude - & zrgp(1,ifs_config%islm,ib), & ! land sea mask - & zrgp(1,ifs_config%ipr,ib), zrgp(1,ifs_config%iti,ib), & ! full level pressure and temperature - & zrgp(1,ifs_config%iaprs,ib), zrgp(1,ifs_config%ihti,ib), & ! half-level pressure and temperature - & zrgp(1,ifs_config%iwv,ib), zrgp(1,ifs_config%iico2,ib), & - & zrgp(1,ifs_config%iich4,ib), zrgp(1,ifs_config%iin2o,ib), & - & zrgp(1,ifs_config%ino2,ib), zrgp(1,ifs_config%ic11,ib), & - & zrgp(1,ifs_config%ic12,ib), zrgp(1,ifs_config%ic22,ib), & - & zrgp(1,ifs_config%icl4,ib), zrgp(1,ifs_config%ioz,ib), & - & zrgp(1,ifs_config%iclc,ib), zrgp(1,ifs_config%ilwa,ib), & - & zrgp(1,ifs_config%iiwa,ib), zrgp(1,ifs_config%irwa,ib), & - & zrgp(1,ifs_config%iswa,ib), & - & zrgp(1,ifs_config%iaer,ib), zrgp(1,ifs_config%iaero,ib), & + & zrgp(1,zrgp_fields%iamu0,ib), zrgp(1,zrgp_fields%its,ib), & ! mu0, skintemp + & zrgp(1,zrgp_fields%iald,ib) , zrgp(1,zrgp_fields%ialp,ib), & ! albedo_dif, albedo_dir + & zrgp(1,zrgp_fields%iemiss,ib), & ! spectral emissivity + & zrgp(1,zrgp_fields%iccnl,ib), zrgp(1,zrgp_fields%iccno,ib) ,& ! CCN concentration, land and sea + & zrgp(1,zrgp_fields%igelam,ib),zrgp(1,zrgp_fields%igemu,ib), & ! longitude, sine of latitude + & zrgp(1,zrgp_fields%islm,ib), & ! land sea mask + & zrgp(1,zrgp_fields%ipr,ib), zrgp(1,zrgp_fields%iti,ib), & ! full level pressure and temperature + & zrgp(1,zrgp_fields%iaprs,ib), zrgp(1,zrgp_fields%ihti,ib), & ! half-level pressure and temperature + & zrgp(1,zrgp_fields%iwv,ib), zrgp(1,zrgp_fields%iico2,ib), & + & zrgp(1,zrgp_fields%iich4,ib), zrgp(1,zrgp_fields%iin2o,ib), & + & zrgp(1,zrgp_fields%ino2,ib), zrgp(1,zrgp_fields%ic11,ib), & + & zrgp(1,zrgp_fields%ic12,ib), zrgp(1,zrgp_fields%ic22,ib), & + & zrgp(1,zrgp_fields%icl4,ib), zrgp(1,zrgp_fields%ioz,ib), & + & zrgp(1,zrgp_fields%iclc,ib), zrgp(1,zrgp_fields%ilwa,ib), & + & zrgp(1,zrgp_fields%iiwa,ib), zrgp(1,zrgp_fields%irwa,ib), & + & zrgp(1,zrgp_fields%iswa,ib), & + & zrgp(1,zrgp_fields%iaer,ib), zrgp(1,zrgp_fields%iaero,ib), & ! flux outputs - & zrgp(1,ifs_config%ifrso,ib), zrgp(1,ifs_config%ifrth,ib), & - & zrgp(1,ifs_config%iswfc,ib), zrgp(1,ifs_config%ilwfc,ib),& - & zrgp(1,ifs_config%ifrsod,ib),zrgp(1,ifs_config%ifrted,ib), & - & zrgp(1,ifs_config%ifrsodc,ib),zrgp(1,ifs_config%ifrtedc,ib),& - & zrgp(1,ifs_config%ifdir,ib), zrgp(1,ifs_config%icdir,ib), & - & zrgp(1,ifs_config%isudu,ib), & - & zrgp(1,ifs_config%iuvdf,ib), zrgp(1,ifs_config%iparf,ib), & - & zrgp(1,ifs_config%iparcf,ib),zrgp(1,ifs_config%itincf,ib), & - & zrgp(1,ifs_config%iemit,ib) ,zrgp(1,ifs_config%ilwderivative,ib), & - & zrgp(1,ifs_config%iswdiffuseband,ib), zrgp(1,ifs_config%iswdirectband,ib)& + & zrgp(1,zrgp_fields%ifrso,ib), zrgp(1,zrgp_fields%ifrth,ib), & + & zrgp(1,zrgp_fields%iswfc,ib), zrgp(1,zrgp_fields%ilwfc,ib),& + & zrgp(1,zrgp_fields%ifrsod,ib),zrgp(1,zrgp_fields%ifrted,ib), & + & zrgp(1,zrgp_fields%ifrsodc,ib),zrgp(1,zrgp_fields%ifrtedc,ib),& + & zrgp(1,zrgp_fields%ifdir,ib), zrgp(1,zrgp_fields%icdir,ib), & + & zrgp(1,zrgp_fields%isudu,ib), & + & zrgp(1,zrgp_fields%iuvdf,ib), zrgp(1,zrgp_fields%iparf,ib), & + & zrgp(1,zrgp_fields%iparcf,ib),zrgp(1,zrgp_fields%itincf,ib), & + & zrgp(1,zrgp_fields%iemit,ib) ,zrgp(1,zrgp_fields%ilwderivative,ib), & + & zrgp(1,zrgp_fields%iswdiffuseband,ib), zrgp(1,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(1,ifs_config%ire_liq,ib), & - & pre_ice=zrgp(1,ifs_config%ire_ice,ib), & - & pcloud_overlap=zrgp(1,ifs_config%ioverlap,ib), & + & ,pre_liq=zrgp(1,zrgp_fields%ire_liq,ib), & + & pre_ice=zrgp(1,zrgp_fields%ire_ice,ib), & + & pcloud_overlap=zrgp(1,zrgp_fields%ioverlap,ib), & & iseed=iseed(:,ib) & #endif & ) @@ -478,7 +482,7 @@ program ecrad_ifs_driver ! Section 4c: Copy fluxes from blocked memory data ! -------------------------------------------------------- - call ifs_copy_fluxes_from_blocked(ifs_config, yradiation, ncol, nlev, nproma, & + 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/ifs/CMakeLists.txt b/ifs/CMakeLists.txt index 7e2dc9fb..0c128ad8 100644 --- a/ifs/CMakeLists.txt +++ b/ifs/CMakeLists.txt @@ -20,8 +20,35 @@ set( ifs_SOURCES 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 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/ifs/ifs_blocking.F90 b/ifs/ifs_blocking.F90 index a1181042..0b3d8626 100644 --- a/ifs/ifs_blocking.F90 +++ b/ifs/ifs_blocking.F90 @@ -21,255 +21,8 @@ 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 - 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 (ifs_config, yradiation, nlev, lldebug) - - use radiation_io, only : nulout - use radiation_setup, only : tradiation - - ! Configuration specific to this driver - type(ifs_config_type), intent(inout) :: ifs_config - - ! Configuration for the radiation scheme, IFS style - type(tradiation), intent(inout) :: yradiation - - integer, intent(inout) :: nlev - - logical, intent(in) :: lldebug - - integer :: ifldsin, ifldsout, inext, iinbeg, iinend, ioutbeg, ioutend - logical :: llactaero - - ! Extract some config values - 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 - - 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 ( & & ifs_config, yradiation, ncol, nlev, nproma, & & single_level, thermodynamics, gas, cloud, aerosol, & @@ -283,10 +36,11 @@ subroutine ifs_copy_inputs_to_blocked ( & use radiation_cloud, only : cloud_type use radiation_aerosol, only : aerosol_type use radiation_setup, only : tradiation + use radintg_zrgp_mod, only : radintg_zrgp_type implicit none - 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 @@ -495,8 +249,9 @@ subroutine ifs_copy_fluxes_from_blocked(& & emissivity_out, flux_diffuse_band, flux_direct_band) use radiation_setup, only : tradiation use radiation_flux, only : flux_type + use radintg_zrgp_mod, only : radintg_zrgp_type - 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 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/radintg_zrgp_mod.F90 b/ifs/radintg_zrgp_mod.F90 new file mode 100644 index 00000000..0d14347a --- /dev/null +++ b/ifs/radintg_zrgp_mod.F90 @@ -0,0 +1,317 @@ +! 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 + +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 + +CONTAINS + PROCEDURE :: SETUP => RADINTG_ZRGP_SETUP + +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 , 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 + +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..0e402227 --- /dev/null +++ b/ifs/radintg_zrgp_mod.fypp @@ -0,0 +1,136 @@ +! 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 + +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 + +CONTAINS + PROCEDURE :: SETUP => RADINTG_ZRGP_SETUP + +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 , 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 + +END MODULE RADINTG_ZRGP_MOD From 04eda8d59996ae2c8fb04e50acb45606cce98ee4 Mon Sep 17 00:00:00 2001 From: Balthasar Reuter Date: Thu, 28 Aug 2025 00:47:36 +0200 Subject: [PATCH 03/14] Add radiation_scheme_layer and field_api-based driver --- CMakeLists.txt | 8 + driver/CMakeLists.txt | 44 ++- driver/ecrad_ifs_driver_field_api.F90 | 476 ++++++++++++++++++++++++++ ifs/CMakeLists.txt | 31 +- ifs/radiation_scheme_layer_mod.F90 | 432 +++++++++++++++++++++++ ifs/radiation_scheme_layer_mod.fypp | 219 ++++++++++++ ifs/radintg_zrgp_mod.F90 | 409 ++++++++++++++++++++++ ifs/radintg_zrgp_mod.fypp | 109 ++++++ test/ifs/CMakeLists.txt | 26 +- 9 files changed, 1726 insertions(+), 28 deletions(-) create mode 100644 driver/ecrad_ifs_driver_field_api.F90 create mode 100644 ifs/radiation_scheme_layer_mod.F90 create mode 100644 ifs/radiation_scheme_layer_mod.fypp diff --git a/CMakeLists.txt b/CMakeLists.txt index 2602bc9b..c48ba261 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -57,6 +57,14 @@ ecbuild_add_option( 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 diff --git a/driver/CMakeLists.txt b/driver/CMakeLists.txt index 73def153..430c2330 100644 --- a/driver/CMakeLists.txt +++ b/driver/CMakeLists.txt @@ -80,24 +80,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/ecrad_ifs_driver_field_api.F90 b/driver/ecrad_ifs_driver_field_api.F90 new file mode 100644 index 00000000..9eb19627 --- /dev/null +++ b/driver/ecrad_ifs_driver_field_api.F90 @@ -0,0 +1,476 @@ +! 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) + + ! 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 + flux%lw_up(:,:) = 0._jprb + flux%lw_dn(:,:) = 0._jprb + flux%sw_up(:,:) = 0._jprb + flux%sw_dn(:,:) = 0._jprb + flux%sw_dn_direct(:,:) = 0._jprb + flux%lw_up_clear(:,:) = 0._jprb + flux%lw_dn_clear(:,:) = 0._jprb + flux%sw_up_clear(:,:) = 0._jprb + flux%sw_dn_clear(:,:) = 0._jprb + flux%sw_dn_direct_clear(:,:) = 0._jprb + + flux%lw_dn_surf_canopy(:,:) = 0._jprb + flux%sw_dn_diffuse_surf_canopy(:,:) = 0._jprb + flux%sw_dn_direct_surf_canopy(:,:) = 0._jprb + 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, & + & size(aerosol%mixing_ratio, 3), & + & 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. + 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) + + 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) + + 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) + + 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) + + ! -------------------------------------------------------- + ! 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 + + call zrgp_fields%delete_field() + + ! 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 0c128ad8..be954726 100644 --- a/ifs/CMakeLists.txt +++ b/ifs/CMakeLists.txt @@ -20,7 +20,7 @@ set( ifs_SOURCES cloud_overlap_decorr_len.F90 yoerad.F90 ifs_blocking.F90 -${CMAKE_CURRENT_BINARY_DIR}/radintg_zrgp_mod.F90 + ${CMAKE_CURRENT_BINARY_DIR}/radintg_zrgp_mod.F90 ) macro( ecrad_ifs_process_fypp fypp_file ) @@ -63,3 +63,32 @@ 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> + ) + + set_target_properties( ifs_field_api.${PREC} + PROPERTIES + Fortran_MODULE_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}/module_ifs_field_api" + ) + +endif() diff --git a/ifs/radiation_scheme_layer_mod.F90 b/ifs/radiation_scheme_layer_mod.F90 new file mode 100644 index 00000000..1f6a333b --- /dev/null +++ b/ifs/radiation_scheme_layer_mod.F90 @@ -0,0 +1,432 @@ +! (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 + +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(:,:) + +CALL RADIATION_SCHEME_LAYER_PARALLEL( & + & YRADIATION, ZRGP_FIELDS, NGPTOT, NRPROMA, NFLEVG, & + & NFSD, KAEROSOL, PSOLAR_IRRADIANCE, ISEED=ISEED ) + +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. + +!$OMP PARALLEL & +!$OMP& PRIVATE(KIDIA,KFDIA,IBL,& +!$OMP& P_igi,P_imu0,P_iamu0,P_iemiss,P_its,P_islm,P_iccnl,P_iccno,P_ibas,P_itop,P_igelam,P_igemu,P_iclon,P_islon,P_iald,P_ialp,P_iti,P_ipr,P_iqs,P_iwv,P_iclc,P_ilwa,P_iiwa,P_iswa,P_irwa,P_irra,P_idp,P_ioz,P_iecpo3,P_ihpr,P_iaprs,P_ihti,P_ire_liq,P_ire_ice,P_ioverlap,P_iaero,P_ifrsod,P_ifrted,P_ifrsodc,P_ifrtedc,P_iemit,P_isudu,P_iuvdf,P_iparf,P_iparcf,P_itincf,P_ifdir,P_ifdif,P_icdir,P_ilwderivative,P_iswdirectband,P_iswdiffuseband,P_ifrso,P_iswfc,P_ifrth,P_ilwfc,P_iaer,P_iico2,P_iich4,P_iin2o,P_ino2,P_ic11,P_ic12,P_ic22,P_icl4,P_igix) & +!$OMP& PRIVATE(& +!$OMP& F_igi,F_imu0,F_iamu0,F_iemiss,F_its,F_islm,F_iccnl,F_iccno,F_ibas,F_itop,F_igelam,F_igemu,F_iclon,F_islon,F_iald,F_ialp,F_iti,F_ipr,F_iqs,F_iwv,F_iclc,F_ilwa,F_iiwa,F_iswa,F_irwa,F_irra,F_idp,F_ioz,F_iecpo3,F_ihpr,F_iaprs,F_ihti,F_ire_liq,F_ire_ice,F_ioverlap,F_iaero,F_ifrsod,F_ifrted,F_ifrsodc,F_ifrtedc,F_iemit,F_isudu,F_iuvdf,F_iparf,F_iparcf,F_itincf,F_ifdir,F_ifdif,F_icdir,F_ilwderivative,F_iswdirectband,F_iswdiffuseband,F_ifrso,F_iswfc,F_ifrth,F_ilwfc,F_iaer,F_iico2,F_iich4,F_iin2o,F_ino2,F_ic11,F_ic12,F_ic22,F_icl4,F_igix) + +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) + +!$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_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 + +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..17c733ef --- /dev/null +++ b/ifs/radiation_scheme_layer_mod.fypp @@ -0,0 +1,219 @@ +! (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} +#: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', '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 + +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(:,:) + +CALL RADIATION_SCHEME_LAYER_PARALLEL( & + & YRADIATION, ZRGP_FIELDS, NGPTOT, NRPROMA, NFLEVG, & + & NFSD, KAEROSOL, PSOLAR_IRRADIANCE, ISEED=ISEED ) + +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. + +!$OMP PARALLEL & +!$OMP& PRIVATE(KIDIA,KFDIA,IBL,& +!$OMP& ${','.join(f'P_{v_name}' for v_name in variable_names)}$) & +!$OMP& PRIVATE(& +!$OMP& ${','.join(f'F_{v_name}' for v_name in variable_names)}$) + +#: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 + +!$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 + +END MODULE RADIATION_SCHEME_LAYER_MOD diff --git a/ifs/radintg_zrgp_mod.F90 b/ifs/radintg_zrgp_mod.F90 index 0d14347a..221bf103 100644 --- a/ifs/radintg_zrgp_mod.F90 +++ b/ifs/radintg_zrgp_mod.F90 @@ -15,6 +15,11 @@ 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 @@ -97,8 +102,17 @@ MODULE RADINTG_ZRGP_MOD 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 @@ -314,4 +328,399 @@ SUBROUTINE RADINTG_ZRGP_SETUP( & 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, 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 index 0e402227..ecbf5e17 100644 --- a/ifs/radintg_zrgp_mod.fypp +++ b/ifs/radintg_zrgp_mod.fypp @@ -28,6 +28,11 @@ 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 @@ -47,8 +52,17 @@ TYPE RADINTG_ZRGP_TYPE 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 @@ -133,4 +147,99 @@ SUBROUTINE RADINTG_ZRGP_SETUP( & 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, 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/test/ifs/CMakeLists.txt b/test/ifs/CMakeLists.txt index dfdbc376..98a50b53 100644 --- a/test/ifs/CMakeLists.txt +++ b/test/ifs/CMakeLists.txt @@ -111,17 +111,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 +144,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( From 24041472087b14b8c2c9ab0dad7013b007200494 Mon Sep 17 00:00:00 2001 From: Balthasar Reuter Date: Thu, 28 Aug 2025 01:04:29 +0200 Subject: [PATCH 04/14] Add field_api to Github Actions workflow --- .github/workflows/build.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 0f68dc4c..48be25df 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -181,9 +181,11 @@ 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" ctest_options: "${{ matrix.ctest_options }}" From 425d0aadada8e1be49d5e72e9f746baee91e7892 Mon Sep 17 00:00:00 2001 From: Balthasar Reuter Date: Thu, 28 Aug 2025 01:30:51 +0200 Subject: [PATCH 05/14] Chunking of OpenMP private clause to limit line length --- ifs/radiation_scheme_layer_mod.F90 | 32 +++++++++++++++++++++++++++-- ifs/radiation_scheme_layer_mod.fypp | 9 ++++++-- 2 files changed, 37 insertions(+), 4 deletions(-) diff --git a/ifs/radiation_scheme_layer_mod.F90 b/ifs/radiation_scheme_layer_mod.F90 index 1f6a333b..0934d298 100644 --- a/ifs/radiation_scheme_layer_mod.F90 +++ b/ifs/radiation_scheme_layer_mod.F90 @@ -241,9 +241,37 @@ SUBROUTINE RADIATION_SCHEME_LAYER_PARALLEL & !$OMP PARALLEL & !$OMP& PRIVATE(KIDIA,KFDIA,IBL,& -!$OMP& P_igi,P_imu0,P_iamu0,P_iemiss,P_its,P_islm,P_iccnl,P_iccno,P_ibas,P_itop,P_igelam,P_igemu,P_iclon,P_islon,P_iald,P_ialp,P_iti,P_ipr,P_iqs,P_iwv,P_iclc,P_ilwa,P_iiwa,P_iswa,P_irwa,P_irra,P_idp,P_ioz,P_iecpo3,P_ihpr,P_iaprs,P_ihti,P_ire_liq,P_ire_ice,P_ioverlap,P_iaero,P_ifrsod,P_ifrted,P_ifrsodc,P_ifrtedc,P_iemit,P_isudu,P_iuvdf,P_iparf,P_iparcf,P_itincf,P_ifdir,P_ifdif,P_icdir,P_ilwderivative,P_iswdirectband,P_iswdiffuseband,P_ifrso,P_iswfc,P_ifrth,P_ilwfc,P_iaer,P_iico2,P_iich4,P_iin2o,P_ino2,P_ic11,P_ic12,P_ic22,P_icl4,P_igix) & +!$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& F_igi,F_imu0,F_iamu0,F_iemiss,F_its,F_islm,F_iccnl,F_iccno,F_ibas,F_itop,F_igelam,F_igemu,F_iclon,F_islon,F_iald,F_ialp,F_iti,F_ipr,F_iqs,F_iwv,F_iclc,F_ilwa,F_iiwa,F_iswa,F_irwa,F_irra,F_idp,F_ioz,F_iecpo3,F_ihpr,F_iaprs,F_ihti,F_ire_liq,F_ire_ice,F_ioverlap,F_iaero,F_ifrsod,F_ifrted,F_ifrsodc,F_ifrtedc,F_iemit,F_isudu,F_iuvdf,F_iparf,F_iparcf,F_itincf,F_ifdir,F_ifdif,F_icdir,F_ilwderivative,F_iswdirectband,F_iswdiffuseband,F_ifrso,F_iswfc,F_ifrth,F_ilwfc,F_iaer,F_iico2,F_iich4,F_iin2o,F_ino2,F_ic11,F_ic12,F_ic22,F_icl4,F_igix) +!$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& ) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 1, F_igi) CALL GET_STACK_MEMBER(ZRGP_FIELDS%FIELD_WRAPPER, 2, F_imu0) diff --git a/ifs/radiation_scheme_layer_mod.fypp b/ifs/radiation_scheme_layer_mod.fypp index 17c733ef..d4df6559 100644 --- a/ifs/radiation_scheme_layer_mod.fypp +++ b/ifs/radiation_scheme_layer_mod.fypp @@ -19,6 +19,9 @@ #: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 = [ & @@ -149,9 +152,11 @@ LEPO3RA=.FALSE. !$OMP PARALLEL & !$OMP& PRIVATE(KIDIA,KFDIA,IBL,& -!$OMP& ${','.join(f'P_{v_name}' for v_name in variable_names)}$) & +!$OMP& ${chunked_join([f'F_{v_name}' for v_name in variable_names], ', &\n!$OMP& ')}$ & +!$OMP& ) & !$OMP& PRIVATE(& -!$OMP& ${','.join(f'F_{v_name}' for v_name in variable_names)}$) +!$OMP& ${chunked_join([f'P_{v_name}' for v_name in variable_names], ', &\n!$OMP& ')}$ & +!$OMP& ) #:for idx, v in enumerate(variables) #:if variable_cnt[v.name] > 1 From ac1c49fd9804791b5b50f0ca583d700338824633 Mon Sep 17 00:00:00 2001 From: Balthasar Reuter Date: Thu, 28 Aug 2025 15:04:32 +0200 Subject: [PATCH 06/14] radiation_setup: fix aerosol setup --- ifs/radiation_setup.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ifs/radiation_setup.F90 b/ifs/radiation_setup.F90 index 8f103323..e829ac1a 100644 --- a/ifs/radiation_setup.F90 +++ b/ifs/radiation_setup.F90 @@ -539,8 +539,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 From bb715d1027a5d19c80bd934694292bb967bedfb8 Mon Sep 17 00:00:00 2001 From: Balthasar Reuter Date: Fri, 5 Sep 2025 15:42:59 +0200 Subject: [PATCH 07/14] Apply unallocated array fixes to field_api driver --- driver/ecrad_ifs_driver_field_api.F90 | 65 +++++++++++++++------------ 1 file changed, 36 insertions(+), 29 deletions(-) diff --git a/driver/ecrad_ifs_driver_field_api.F90 b/driver/ecrad_ifs_driver_field_api.F90 index 9eb19627..da157a76 100644 --- a/driver/ecrad_ifs_driver_field_api.F90 +++ b/driver/ecrad_ifs_driver_field_api.F90 @@ -327,21 +327,21 @@ program ecrad_ifs_driver call flux%allocate(yradiation%rad_config, 1, ncol, nlev) ! set relevant fluxes to zero - flux%lw_up(:,:) = 0._jprb - flux%lw_dn(:,:) = 0._jprb - flux%sw_up(:,:) = 0._jprb - flux%sw_dn(:,:) = 0._jprb - flux%sw_dn_direct(:,:) = 0._jprb - flux%lw_up_clear(:,:) = 0._jprb - flux%lw_dn_clear(:,:) = 0._jprb - flux%sw_up_clear(:,:) = 0._jprb - flux%sw_dn_clear(:,:) = 0._jprb - flux%sw_dn_direct_clear(:,:) = 0._jprb - - flux%lw_dn_surf_canopy(:,:) = 0._jprb - flux%sw_dn_diffuse_surf_canopy(:,:) = 0._jprb - flux%sw_dn_direct_surf_canopy(:,:) = 0._jprb - flux%lw_derivatives(:,:) = 0._jprb + 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)) @@ -404,7 +404,7 @@ program ecrad_ifs_driver call radiation_scheme_layer(yradiation, zrgp_fields, & & ncol, nproma, nlev, 0, & - & size(aerosol%mixing_ratio, 3), & + & yradiation%rad_config%n_aerosol_types, & & single_level%solar_irradiance & #ifdef BITIDENTITY_TESTING & , iseed=iseed & @@ -429,21 +429,28 @@ program ecrad_ifs_driver ! "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. - 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_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 - 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) - - 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 - 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) + 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 From 0079260ff7674c3c3db1ac778032589ce6323402 Mon Sep 17 00:00:00 2001 From: Balthasar Reuter Date: Fri, 5 Sep 2025 17:25:04 +0200 Subject: [PATCH 08/14] Force smaller but odd block size in tests --- test/ifs/CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/test/ifs/CMakeLists.txt b/test/ifs/CMakeLists.txt index 98a50b53..bb0d15a8 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 From fc2363d8b1801cae22bdae4e28744e7934311f5f Mon Sep 17 00:00:00 2001 From: Balthasar Reuter Date: Fri, 5 Sep 2025 17:55:18 +0200 Subject: [PATCH 09/14] radiation_scheme_layer_mod: remove duplicate argument --- ifs/radiation_scheme_layer_mod.F90 | 1 - ifs/radiation_scheme_layer_mod.fypp | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/ifs/radiation_scheme_layer_mod.F90 b/ifs/radiation_scheme_layer_mod.F90 index 0934d298..da208b2f 100644 --- a/ifs/radiation_scheme_layer_mod.F90 +++ b/ifs/radiation_scheme_layer_mod.F90 @@ -388,7 +388,6 @@ SUBROUTINE RADIATION_SCHEME_LAYER_PARALLEL & P_iswa => F_iswa%GET_VIEW(IBL) P_iaer => F_iaer%GET_VIEW(IBL) P_iaero => F_iaero%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) diff --git a/ifs/radiation_scheme_layer_mod.fypp b/ifs/radiation_scheme_layer_mod.fypp index d4df6559..8ec728a3 100644 --- a/ifs/radiation_scheme_layer_mod.fypp +++ b/ifs/radiation_scheme_layer_mod.fypp @@ -36,7 +36,7 @@ ${linebreak.join(','.join(iterable[i:i+5]) for i in range(0, len(iterable), 5))} & 'icl4','ioz', & & 'iclc','ilwa','iiwa','irwa', & & 'iswa', & -& 'iaer', 'iaero', 'iaero', & +& 'iaer', 'iaero', & & 'ifrso','ifrth','iswfc','ilwfc', & & 'ifrsod','ifrted', & & 'ifrsodc','ifrtedc', & From ecdf53148ad4b61c5d88ea64fc254873769ae04f Mon Sep 17 00:00:00 2001 From: Balthasar Reuter Date: Mon, 8 Dec 2025 14:57:04 +0100 Subject: [PATCH 10/14] Use firstprivate in radiation_scheme_layer_mod for GFortran --- ifs/radiation_scheme_layer_mod.fypp | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/ifs/radiation_scheme_layer_mod.fypp b/ifs/radiation_scheme_layer_mod.fypp index 8ec728a3..b56e3fbe 100644 --- a/ifs/radiation_scheme_layer_mod.fypp +++ b/ifs/radiation_scheme_layer_mod.fypp @@ -150,6 +150,16 @@ 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& ')}$ & @@ -157,6 +167,7 @@ LEPO3RA=.FALSE. !$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 @@ -166,6 +177,15 @@ 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 From 1607647ea617857b3f31c8b9ef3b87a89fdedd55 Mon Sep 17 00:00:00 2001 From: Balthasar Reuter Date: Tue, 9 Dec 2025 09:58:06 +0100 Subject: [PATCH 11/14] Apply renaming of yomlun in radintg_zrgp_mod --- ifs/radintg_zrgp_mod.F90 | 4 ++-- ifs/radintg_zrgp_mod.fypp | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/ifs/radintg_zrgp_mod.F90 b/ifs/radintg_zrgp_mod.F90 index 221bf103..d9d7acf0 100644 --- a/ifs/radintg_zrgp_mod.F90 +++ b/ifs/radintg_zrgp_mod.F90 @@ -145,7 +145,7 @@ SUBROUTINE RADINTG_ZRGP_SETUP( & & LAPPROXLWUPDATE, LAPPROXSWUPDATE, & & LEPO3RA, LDIAGFORCING) - USE YOMLUN , ONLY : NULOUT + USE YOMLUN_ECRAD, ONLY : NULOUT IMPLICIT NONE @@ -364,7 +364,7 @@ SUBROUTINE RADINTG_ZRGP_SETUP_FIELD( & & LEPO3RA, LDIAGFORCING) USE FIELD_FACTORY_MODULE - USE YOMLUN, ONLY: NULOUT + USE YOMLUN_ECRAD, ONLY: NULOUT IMPLICIT NONE diff --git a/ifs/radintg_zrgp_mod.fypp b/ifs/radintg_zrgp_mod.fypp index ecbf5e17..45bd8195 100644 --- a/ifs/radintg_zrgp_mod.fypp +++ b/ifs/radintg_zrgp_mod.fypp @@ -95,7 +95,7 @@ SUBROUTINE RADINTG_ZRGP_SETUP( & & LAPPROXLWUPDATE, LAPPROXSWUPDATE, & & LEPO3RA, LDIAGFORCING) - USE YOMLUN , ONLY : NULOUT + USE YOMLUN_ECRAD, ONLY : NULOUT IMPLICIT NONE @@ -183,7 +183,7 @@ SUBROUTINE RADINTG_ZRGP_SETUP_FIELD( & & LEPO3RA, LDIAGFORCING) USE FIELD_FACTORY_MODULE - USE YOMLUN, ONLY: NULOUT + USE YOMLUN_ECRAD, ONLY: NULOUT IMPLICIT NONE From 95ddb7ab84f53137aa12083fc40b24695da98f3b Mon Sep 17 00:00:00 2001 From: Balthasar Reuter Date: Mon, 8 Dec 2025 16:29:54 +0100 Subject: [PATCH 12/14] GH Actions: Update gcc to 13 and nvhpc to 25.9 --- .github/workflows/build.yml | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 48be25df..0cfc9a22 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 @@ -123,7 +123,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 From 1255bb4ff5fe1a3b623816be3dbbf287a5294508 Mon Sep 17 00:00:00 2001 From: Balthasar Reuter Date: Thu, 28 Aug 2025 15:04:58 +0200 Subject: [PATCH 13/14] FIXME: Disable field deletion on GNU to avoid double free errors --- driver/ecrad_ifs_driver_field_api.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/driver/ecrad_ifs_driver_field_api.F90 b/driver/ecrad_ifs_driver_field_api.F90 index da157a76..7135f91e 100644 --- a/driver/ecrad_ifs_driver_field_api.F90 +++ b/driver/ecrad_ifs_driver_field_api.F90 @@ -473,7 +473,11 @@ program ecrad_ifs_driver 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 From a83ea85e8caf7e5578e18a3df7f3f40acc0eaf0f Mon Sep 17 00:00:00 2001 From: Balthasar Reuter Date: Tue, 9 Dec 2025 10:56:36 +0100 Subject: [PATCH 14/14] Fix Makefile dependencies for radintg_zrgp_mod and ifs_blocking --- driver/Makefile | 4 ++-- ifs/Makefile | 3 ++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/driver/Makefile b/driver/Makefile index fd63c114..7f482735 100644 --- a/driver/Makefile +++ b/driver/Makefile @@ -47,7 +47,7 @@ clean: ecrad_driver.o: ecrad_driver_config.o ecrad_driver_read_input.o ecrad_ifs_driver.o: ecrad_driver_config.o ecrad_driver_read_input.o -ecrad_ifs_driver_blocked.o: ecrad_driver_config.o ecrad_driver_read_input.o ifs_blocking.o -ecrad_driver_read_input.o ifs_blocking.o: ecrad_driver_config.o +ecrad_ifs_driver_blocked.o: ecrad_driver_config.o ecrad_driver_read_input.o +ecrad_driver_read_input.o: ecrad_driver_config.o .PHONY: driver ifs_driver test_programs all diff --git a/ifs/Makefile b/ifs/Makefile index 624b0432..92c6dc9d 100644 --- a/ifs/Makefile +++ b/ifs/Makefile @@ -2,7 +2,7 @@ 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 \ - ifs_blocking.F90 + ifs_blocking.F90 radintg_zrgp_mod.F90 OBJECTS := $(SOURCES:.F90=.o) LIBIFS = ../lib/libifs.a @@ -32,3 +32,4 @@ cloud_overlap_decorr_len.o: yoecld.o cos_sza.o ice_effective_radius.o liquid_effective_radius.o radiation_scheme.o radiation_setup.o: yoerad.o yoerad.o: yoe_spectral_planck.o satur.o: yoethf.o +ifs_blocking.o: radintg_zrgp_mod.o radiation_setup.o