From 676861a4558e07c0c25ce3486beb6fe0f1aa63d2 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Thu, 18 Jan 2024 17:38:05 -0800 Subject: [PATCH] draft burkholder parameterization and tests --- data/cross_sections/HO2NO2_JPL06.nc | Bin 0 -> 2704 bytes data/cross_sections/HO2NO2_temp_JPL06.nc | Bin 0 -> 2992 bytes src/cross_sections/temperature_based.F90 | 15 ++ src/cross_sections/util/CMakeLists.txt | 1 + ...emperature_parameterization_burkholder.F90 | 244 ++++++++++++++++++ ...erature_parameterization_taylor_series.F90 | 1 + .../util/burkholder.config.json | 22 ++ test/data/cross_sections/util/burkholder.nc | Bin 0 -> 436 bytes test/unit/cross_section/util/CMakeLists.txt | 2 + ...emperature_parameterization_burkholder.F90 | 102 ++++++++ 10 files changed, 387 insertions(+) create mode 100644 data/cross_sections/HO2NO2_JPL06.nc create mode 100644 data/cross_sections/HO2NO2_temp_JPL06.nc create mode 100644 src/cross_sections/util/temperature_parameterization_burkholder.F90 create mode 100644 test/data/cross_sections/util/burkholder.config.json create mode 100644 test/data/cross_sections/util/burkholder.nc create mode 100644 test/unit/cross_section/util/temperature_parameterization_burkholder.F90 diff --git a/data/cross_sections/HO2NO2_JPL06.nc b/data/cross_sections/HO2NO2_JPL06.nc new file mode 100644 index 0000000000000000000000000000000000000000..e1a767e984435ef87a696f963435657df47720fc GIT binary patch literal 2704 zcmc&#Yitx%6keefJ4oc=GbD0TC3bap+?{RdcJD}+wiIk>Sz2hpAGWi*w>y{4W0|?r zQlqgL<0A?PHTa0p8cmEbB=toM5?mq=V8R+lo7K?9F2Jn39MiP zdllRlFY}mgJMb0?&4Byzwd?v&o5nP>e#mxA;-I)31N*F;Lo`P6m30f0m{K2&#iQ{g ziZ`TU$y9o4n5n>Rlz;tf*^Wwo;;5k>{drx7hN$B*l;>PIBxgJM2(mmg3zXSIe>J;O zFLS&cXFpXFYfoG%p2JsoOv_C!DGQMxshAwxo_f!qVD5 z%bBWCnwCVBrevqo{|7sfA_@Y8M=>sE?&2saMX(s8_S{ z#EGCDxkpCr4kdXbg4*OR8LhC5Jh39EOYV?Sr{|0rb_A`EJ7v^m+YT#eEP__T3^5Gi zM0>nE8IGWg45of+kqBDGJ@#lL)YUa>7(^LCt@3i%U>jNCwaYfB1@;#HiFRrk+L&uw z(F|qG#{p2T)g4!oe>0dql^b+<$}o=Fbr10P{y%~ zp5byOuhOzMw3O|PLE4(D0a=g=FOV#?+NMb?<^s!=()kkMR?rJ)(X=f%&;XTQQzEwrYVb#15U$Ly=Q(pfGST_7%BL1;uP+D@bv0kwZnBSWi3 zP*Y&GKun@p+!NEu{}~j|U6OjZE_x|w85G(fcgqM4lTm{J z;~iYQEuI5okV-!+%jp)OzLvQf{wCDgE~2^6f4nM{^#0Cdv~os4`WG}L$`Uq8h=qVG zzc7hJ3@XQ^#i{Ze4k--@#Cs8SUckFwf-JQS8Pz8vDBc)ND1HT+{0b!fMm=8&E1*{_ zTF{}-{-Kw6k{xo3Pr|UydlfkPw*sjolc-Pl$taBpKjw@+25rIntMUvi^$>A=LW#no z5%EJv3CmLSKVFidnc2MNpLs4Vm>R0fnYSxp3DsF9fs+DD0?Pr4pJ3WWVw@H@C~#chq`;EE za)ADC7x-dGjMD-K1&#}x6j%~i4$$)0jPyw&)i8<(m2G##wvt=U+VW(ONVqhyHfwy) zjQ3W{1$OO8{Q3`DI;VdA4!E?Y(Umetu~C(#sBe_}Re|$LADp z#82&Mo4zt}06!jmH9h~8HTcmZ?X&03TZ(twH9hv-S0TLh(7f@xhPUAdwr!j<|JQ~1 zUa@~mDxCRb(Hwl|!uyV_{JIlw7W-NAXKze<{dkj@H%}d?p4#^krn#HxZmj+e8ocyn literal 0 HcmV?d00001 diff --git a/data/cross_sections/HO2NO2_temp_JPL06.nc b/data/cross_sections/HO2NO2_temp_JPL06.nc new file mode 100644 index 0000000000000000000000000000000000000000..6ae279c37f85b045d15804d130b9929488831c9f GIT binary patch literal 2992 zcmc&#eRLGn6<`XEr zAyMp!fl`DO9 zD}C#$LN%TOUhmSGk4)PSw^8V%5|vx^I5Rtv9I!mtbDANGx}6;Jmm(+N4*9_}g78^z zv#;Y}{SA>=v0m?!`IsD!nZ&?z+7JC+lpjE!joVR+sA@WjF|Je^Rn(XZ$wndqlqoIO zn>8-1t45TuUz}m($kjoOiZhblpg2lbHzc5nQ6xmg7-v-_?@lVH&f*MU#O?EV3i8;^ z$u)dd&f*MTQGwf66s+dfd`b{f1-TX6dy717f4)afA+qirq};=!~=l&K3XXCCW?PEm^savO-!g-ZDqutAX`w%1xk5@oQLuuqhW zvLtkCitG-Fx~{R1V0EP-g0DuthDR&aHWA_(+Flx`2{9^2s2V<`i%|_h5-1c`bS0Xc zG8GI0MyoZ7L>VpD6N=Uzr;OmRZp1{Y@n}V-AQ^(G%Q~xY-u$8ME(CO=kO5>xtw|3s z3|6Y6kgBvBlE#!=BSaKvDMjsuv;|E7vLF>!Af78#5(z5n8nB!!ohcD!1--y_m|@lN zdGe8*a9L_mS~#wTZ(sy7Ud*ga_LDs2Kx+ySO;Ov;n4{Nsmc~S9iOWJ-`))s=&Q z+E1zBp;cX|sL<{81W}&1DCl*%IL_yVKnkru5>$|xCp}L8pFy$QIj)}RA}oTIL7`QA z9gpBJ*(gz9yo!mp#8BZKq_PH3yC_ck+ya^lxfN z6ruV?N@WCOnT7HDJy1C&Ek>2uaLAYMN30i7^-a8+C5VWM#G^pag}jAszt5~dky(MD z*{C;4p#pkE7F*-cXaA*_SdvwIiAh3Rob@Vj^uG!unT$W+H@}h}#J|~CrPXLouHzxMj<2bQEv!>8XkG;!y%r|^mX!^dV0JMl5?wyUAaIe2hv>q8yq zH{c`BO!eko?8g0@4+ly|+Hl|9QepGaZ{mZ-<&PJ9!sC5E|83@sMbF_~!lrp|tojn( zv2bVEM`_vkM_bD3aq9%$HmSd5toRprOWyD+3#%gdo}azY2_fQ6f8~;QkIcaxFTHYM z>d-iDV_Dx(jw5Hy0PyOX$JeJ{ev~w1vvlf6c zRj{aB`!)%+n1j^4+<4}X`%jXZ;nDM_zk8BY9f$C{&XCF%D-LAebAgl}UYCzI{hgHk zVE0*WSqCX;x!5)G@i-xOFPn0_dL3DM&cY(IJPuOe*nErp*u%s>DShFaUzyVb;iumYe|YkBeC*+sZ+$&>7ar1&Z1~o{&*6bc z?dgB)yNZvnuda3C-}mkEKRNv Calculator for temperature-based cross sections type, extends(cross_section_t) :: cross_section_temperature_based_t @@ -63,6 +64,8 @@ function constructor( config, grid_warehouse, profile_warehouse ) & use tuvx_grid_warehouse, only : grid_warehouse_t use tuvx_netcdf, only : netcdf_t use tuvx_profile_warehouse, only : profile_warehouse_t + use tuvx_temperature_parameterization_burkholder, & + only : temperature_parameterization_burkholder_t use tuvx_temperature_parameterization_taylor_series, & only : temperature_parameterization_taylor_series_t @@ -135,6 +138,9 @@ function constructor( config, grid_warehouse, profile_warehouse ) & if( param_type == "TAYLOR_SERIES" ) then allocate( this%parameterization_, source = & temperature_parameterization_taylor_series_t( param_config ) ) + else if( param_type == "BURKHOLDER" ) then + allocate( this%parameterization_, source = & + temperature_parameterization_burkholder_t( param_config ) ) else call die_msg( 370773773, "Invalid temperature-based "// & "parameterization type: '"//param_type//"'" ) @@ -274,6 +280,8 @@ subroutine mpi_pack( this, buffer, position, comm ) use musica_assert, only : assert, die use musica_mpi, only : musica_mpi_pack + use tuvx_temperature_parameterization_burkholder, & + only : temperature_parameterization_burkholder_t use tuvx_temperature_parameterization_taylor_series, & only : temperature_parameterization_taylor_series_t @@ -299,6 +307,8 @@ subroutine mpi_pack( this, buffer, position, comm ) param_type = PARAM_BASE type is( temperature_parameterization_taylor_series_t ) param_type = PARAM_TAYLOR_SERIES + type is( temperature_parameterization_burkholder_t ) + param_type = PARAM_BURKHOLDER class default call die( 424852458 ) end select @@ -317,6 +327,8 @@ subroutine mpi_unpack( this, buffer, position, comm ) use musica_assert, only : assert, die use musica_mpi, only : musica_mpi_unpack + use tuvx_temperature_parameterization_burkholder, & + only : temperature_parameterization_burkholder_t use tuvx_temperature_parameterization_taylor_series, & only : temperature_parameterization_taylor_series_t @@ -342,6 +354,9 @@ subroutine mpi_unpack( this, buffer, position, comm ) case( PARAM_TAYLOR_SERIES ) allocate( temperature_parameterization_taylor_series_t :: & this%parameterization_ ) + case( PARAM_BURKHOLDER ) + allocate( temperature_parameterization_burkholder_t :: & + this%parameterization_ ) case default call die( 324803089 ) end select diff --git a/src/cross_sections/util/CMakeLists.txt b/src/cross_sections/util/CMakeLists.txt index 47bc13e5..e24da0bd 100644 --- a/src/cross_sections/util/CMakeLists.txt +++ b/src/cross_sections/util/CMakeLists.txt @@ -4,6 +4,7 @@ target_sources(tuvx_object PRIVATE temperature_parameterization.F90 + temperature_parameterization_burkholder.F90 temperature_parameterization_taylor_series.F90 temperature_range.F90 ) diff --git a/src/cross_sections/util/temperature_parameterization_burkholder.F90 b/src/cross_sections/util/temperature_parameterization_burkholder.F90 new file mode 100644 index 00000000..97d42e1e --- /dev/null +++ b/src/cross_sections/util/temperature_parameterization_burkholder.F90 @@ -0,0 +1,244 @@ +! Copyright (C) 2024 National Center for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 + +module tuvx_temperature_parameterization_burkholder +! Calculates cross-section elements using a temperature-based +! parameterization from Burkholder et al. Phys. Chem. Chem. Phys. 4, 1432-1437 (2002). + + ! Including musica_config at the module level to avoid an ICE + ! with Intel 2022.1 compiler + use musica_config, only : config_t + use musica_constants, only : dk => musica_dk + use tuvx_temperature_parameterization, & + only : temperature_parameterization_t + use tuvx_temperature_range, only : temperature_range_t + + implicit none + + private + public :: temperature_parameterization_burkholder_t + + !> Parameters for calculating cross section values based on + !! temperature using the algoritm in Burkholder et al. + !! Phys. Chem. Chem. Phys. 4, 1432-1437 (2002). + !! + !! Cross section elements are calculated as: + !! + !! \f[ + !! Q(T) = 1 + e^{\frac{A}{B*T}} + !! \sigma(T,\lambda) = \frac{aa(\lambda)}{Q(T)} + bb(\lambda)*\[1-\frac{1}{Q(T)}\] + !! \f] + !! + !! where A, B, aa, and bb are constants, T is temperature [K] and \f$\lambda\f$ is + !! wavelength [nm]. + type, extends(temperature_parameterization_t) :: temperature_parameterization_burkholder_t + real(kind=dk) :: A_ + real(kind=dk) :: B_ + contains + !> Calculate the cross section value for a specific temperature and wavelength + procedure :: calculate + !> Returns the number of bytes required to pack the parameterization + !! onto a character buffer + procedure :: pack_size => pack_size + !> Packs the parameterization onto a character buffer + procedure :: mpi_pack => mpi_pack + !> Unpacks the parameterization from a character buffer + procedure :: mpi_unpack => mpi_unpack + end type temperature_parameterization_burkholder_t + + !> Constructor for temperature_parameterization_burkholder_t + interface temperature_parameterization_burkholder_t + module procedure :: constructor + end interface temperature_parameterization_burkholder_t + +contains + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + !> Constructs a Burkholder (2002) temperature-based parameterization + function constructor( config ) result ( this ) + + use musica_assert, only : assert_msg + use musica_config, only : config_t + use musica_iterator, only : iterator_t + use musica_string, only : string_t + use tuvx_grid, only : grid_t + use tuvx_netcdf, only : netcdf_t + + type(temperature_parameterization_burkholder_t) :: this + type(config_t), intent(inout) :: config + + character(len=*), parameter :: my_name = & + "Burkholder (2002) temperature parameterization constructor" + type(string_t) :: required_keys(3), optional_keys(2), file_path + type(config_t) :: temp_ranges, temp_range, netcdf_file + class(iterator_t), pointer :: iter + type(netcdf_t) :: netcdf + integer :: i_range, i_param, n_param + logical :: found + + required_keys(1) = "netcdf file" + required_keys(2) = "A" + required_keys(3) = "B" + optional_keys(1) = "type" + optional_keys(2) = "temperature ranges" + call assert_msg( 235183546, & + config%validate( required_keys, optional_keys ), & + "Bad configuration for Burkholder (2002) temperature "// & + "parameterization." ) + + ! Load NetCDF file + call config%get( "netcdf file", netcdf_file, my_name ) + call netcdf_file%get( "file path", file_path, my_name ) + call netcdf%read_netcdf_file( file_path = file_path%to_char( ), & + variable_name = "temperature_" ) + n_param = size( netcdf%parameters, dim = 2 ) + call assert_msg( 164185428, n_param >= 2, "Burkholder (2002) "// & + "parameterization must have at two sets of "// & + "coefficients" ) + + ! Load parameters + call config%get( "A", this%A_, my_name ) + call config%get( "B", this%B_, my_name ) + this%wavelengths_ = netcdf%wavelength(:) + this%AA_ = netcdf%parameters(:,1) + this%BB_ = netcdf%parameters(:,2) + call config%get( "temperature ranges", temp_ranges, my_name, & + found = found ) + if( .not. found ) then + allocate( this%ranges_( 1 ) ) + return + end if + allocate( this%ranges_( temp_ranges%number_of_children( ) ) ) + iter => temp_ranges%get_iterator( ) + i_range = 0 + do while( iter%next( ) ) + i_range = i_range + 1 + call temp_ranges%get( iter, temp_range, my_name ) + this%ranges_( i_range ) = temperature_range_t( temp_range ) + end do + deallocate( iter ) + + ! initialize unused data members + allocate( this%lp_(0) ) + + end function constructor + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine calculate( this, temperature, wavelengths, cross_section ) + + use tuvx_profile, only : profile_t + + class(temperature_parameterization_burkholder_t), intent(in) :: this + real(kind=dk), intent(in) :: temperature + real(kind=dk), intent(in) :: wavelengths(:) + real(kind=dk), intent(inout) :: cross_section(:) + + real(kind=dk) :: temp, Q + integer :: i_range, w_min, w_max + + w_min = this%min_wavelength_index_ + w_max = this%max_wavelength_index_ + do i_range = 1, size( this%ranges_ ) + associate( temp_range => this%ranges_( i_range ) ) + if( temperature < temp_range%min_temperature_ .or. & + temperature > temp_range%max_temperature_ ) cycle + if( temp_range%is_fixed_ ) then + temp = temp_range%fixed_temperature_ - this%base_temperature_ + else + temp = temperature - this%base_temperature_ + end if + Q = 1.0 + exp( this%A_ / ( this%B_ * temp ) ) + cross_section( w_min:w_max ) = ( this%AA_(:) / Q + & + this%BB_(:) * ( 1.0 - 1.0 / Q ) & + ) * 1.0e-20 + end associate + end do + + end subroutine calculate + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + !> Returns the size of a character buffer required to pack the + !! parameterization + integer function pack_size( this, comm ) + + use musica_mpi, only : musica_mpi_pack_size + + !> Parameterization to be packed + class(temperature_parameterization_burkholder_t), intent(in) :: this + !> MPI communicator + integer, intent(in) :: comm + +#ifdef MUSICA_USE_MPI + pack_size = this%temperature_parameterization_t%pack_size( comm ) + & + musica_mpi_pack_size( this%A_, comm ) + & + musica_mpi_pack_size( this%B_, comm ) +#else + pack_size = 0 +#endif + + end function pack_size + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + !> Packs the parameterization onto a character buffer + subroutine mpi_pack( this, buffer, position, comm ) + + use musica_assert, only : assert + use musica_mpi, only : musica_mpi_pack + + !> Parameterization to be packed + class(temperature_parameterization_burkholder_t), intent(in) :: this + !> Memory buffer + character, intent(inout) :: buffer(:) + !> Current buffer position + integer, intent(inout) :: position + !> MPI communicator + integer, intent(in) :: comm + +#ifdef MUSICA_USE_MPI + integer :: prev_pos + + prev_pos = position + call this%temperature_parameterization_t%mpi_pack( buffer, position, comm ) + call musica_mpi_pack( buffer, position, this%A_, comm ) + call musica_mpi_pack( buffer, position, this%B_, comm ) + call assert( 190816083, position - prev_pos <= this%pack_size( comm ) ) +#endif + + end subroutine mpi_pack + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + !> Unpacks a parameterization from a character buffer + subroutine mpi_unpack( this, buffer, position, comm ) + + use musica_assert, only : assert + use musica_mpi, only : musica_mpi_unpack + + !> The parameterization to be unpacked + class(temperature_parameterization_burkholder_t), intent(out) :: this + !> Memory buffer + character, intent(inout) :: buffer(:) + !> Current buffer position + integer, intent(inout) :: position + !> MPI communicator + integer, intent(in) :: comm + +#ifdef MUSICA_USE_MPI + integer :: prev_pos + + prev_pos = position + call this%temperature_parameterization_t%mpi_unpack( buffer, position, comm ) + call musica_mpi_unpack( buffer, position, this%A_, comm ) + call musica_mpi_unpack( buffer, position, this%B_, comm ) + call assert( 634825156, position - prev_pos <= this%pack_size( comm ) ) +#endif + + end subroutine mpi_unpack + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +end module tuvx_temperature_parameterization_burkholder \ No newline at end of file diff --git a/src/cross_sections/util/temperature_parameterization_taylor_series.F90 b/src/cross_sections/util/temperature_parameterization_taylor_series.F90 index a15c6b7f..8003af83 100644 --- a/src/cross_sections/util/temperature_parameterization_taylor_series.F90 +++ b/src/cross_sections/util/temperature_parameterization_taylor_series.F90 @@ -263,6 +263,7 @@ subroutine mpi_unpack( this, buffer, position, comm ) call this%temperature_parameterization_t%mpi_unpack( buffer, position, comm ) call musica_mpi_unpack( buffer, position, this%sigma_, comm ) call musica_mpi_unpack( buffer, position, this%A_, comm ) + call assert( 966515884, position - prev_pos <= this%pack_size( comm ) ) #endif end subroutine mpi_unpack diff --git a/test/data/cross_sections/util/burkholder.config.json b/test/data/cross_sections/util/burkholder.config.json new file mode 100644 index 00000000..36a3efcf --- /dev/null +++ b/test/data/cross_sections/util/burkholder.config.json @@ -0,0 +1,22 @@ +{ + "type": "BURKHOLDER", + "netcdf file": { + "file path": "test/data/cross_sections/util/burkholder.nc" + }, + "A": 12.5, + "B": 202.3, + "temperature ranges": [ + { + "maximum": 209.999999999999, + "fixed value": 210.0 + }, + { + "minimum": 210.0, + "maximum": 300.0 + }, + { + "minimum": 300.00000000001, + "fixed value": 300.0 + } + ] +} \ No newline at end of file diff --git a/test/data/cross_sections/util/burkholder.nc b/test/data/cross_sections/util/burkholder.nc new file mode 100644 index 0000000000000000000000000000000000000000..1b73b9d55dd3af29bd7265d5c2ce86b40e39e180 GIT binary patch literal 436 zcmZ>EabskF04^ZK48%MosksHIMTsS)MXAM5IhLf%JP?}|h`9<9ixP8FOHzvIt23QJY2MF^3F<3s{Ei)%4EHS4v6)evNlCS>(W`hXU(!9(P zsO2E_OnJFrIgmOHpi&VaEr#UIcr-VG^#Ikt>;%zV1ndNvT>;c$<52Vf$Yfw}fI7gT zSOLm+fYJ#NT5Bc<%yQ5<0|I9q^ufXm4hB$h!_CGZ;9!~t1`cLE5OwBYVPgjiNr-++ Ts6GiOEd!+$ptKT{R)Np}mrP8* literal 0 HcmV?d00001 diff --git a/test/unit/cross_section/util/CMakeLists.txt b/test/unit/cross_section/util/CMakeLists.txt index c33376f5..6b2abbbd 100644 --- a/test/unit/cross_section/util/CMakeLists.txt +++ b/test/unit/cross_section/util/CMakeLists.txt @@ -6,6 +6,8 @@ include(test_util) ################################################################################ # Cross section utility tests +create_standard_test( NAME temperature_parameterization_burkholder + SOURCES temperature_parameterization_burkholder.F90 ) create_standard_test( NAME temperature_parameterization_taylor_series SOURCES temperature_parameterization_taylor_series.F90 ) diff --git a/test/unit/cross_section/util/temperature_parameterization_burkholder.F90 b/test/unit/cross_section/util/temperature_parameterization_burkholder.F90 new file mode 100644 index 00000000..eb05df26 --- /dev/null +++ b/test/unit/cross_section/util/temperature_parameterization_burkholder.F90 @@ -0,0 +1,102 @@ +! Copyright (C) 2024 National Center for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +! +!> \file +!> Tests for the temperature_parameterization_burkholder_t type +program test_temperature_parameterization_burkholder + + use musica_mpi, only : musica_mpi_init, & + musica_mpi_finalize + use tuvx_temperature_parameterization_burkholder + + implicit none + + call musica_mpi_init( ) + call test_burkholder_t( ) + call musica_mpi_finalize( ) + +contains + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine test_burkholder_t( ) + + use musica_assert, only : assert + use musica_constants, only : dk => musica_dk + use musica_config, only : config_t + use musica_mpi + use musica_string, only : string_t + use tuvx_test_utils, only : check_values + + type(temperature_parameterization_burkholder_t) :: burkholder_param + type(config_t) :: config + character, allocatable :: buffer(:) + integer :: pack_size, pos + integer, parameter :: comm = MPI_COMM_WORLD + + call config%from_file( & + "test/data/cross_sections/util/burkholder.config.json" ) + + if( musica_mpi_rank( comm ) == 0 ) then + burkholder_param = temperature_parameterization_burkholder_t( config ) + pack_size = burkholder_param%pack_size( comm ) + allocate( buffer( pack_size ) ) + pos = 0 + call burkholder_param%mpi_pack( buffer, pos, comm ) + call assert( 984049167, pos <= pack_size ) + end if + + call musica_mpi_bcast( pack_size, comm ) + if( musica_mpi_rank( comm ) .ne. 0 ) allocate( buffer( pack_size ) ) + call musica_mpi_bcast( buffer, comm ) + + if( musica_mpi_rank( comm ) .ne. 0 ) then + pos = 0 + call burkholder_param%mpi_unpack( buffer, pos, comm ) + call assert( 761318011, pos <= pack_size ) + end if + deallocate( buffer ) + + ! Check temperature parameterization data members + call check_values( 756053704, burkholder_param%wavelengths_, & + (/ 302.0_dk, 304.0_dk, 306.0_dk, 308.0_dk, 310.0_dk /),& + 1.0e-6_dk ) + call check_values( 973109062, burkholder_param%AA_, & + (/ 13.3_dk, 14.4_dk, 15.5_dk, 16.6_dk, 17.7_dk /), & + 1.0e-6_dk ) + call check_values( 187744433, burkholder_param%BB_, & + (/ 21.4_dk, 22.3_dk, 23.2_dk, 24.1_dk, 25.0_dk /), & + 1.0e-6_dk ) + call assert( 301968312, burkholder_param%A_ == 12.5_dk ) + call assert( 521340695, burkholder_param%B_ == 202.3_dk ) + call assert( 405663577, size( burkholder_param%ranges_ ) == 3 ) + call assert( 800457171, burkholder_param%ranges_(1)%min_temperature_ == & + 0.0_dk ) + call assert( 412833418, burkholder_param%ranges_(1)%max_temperature_ == & + 209.999999999999_dk ) + call assert( 860201264, burkholder_param%ranges_(1)%is_fixed_ .eqv. & + .true. ) + call assert( 125093862, burkholder_param%ranges_(1)%fixed_temperature_ == & + 210.0_dk ) + call assert( 289986459, burkholder_param%ranges_(2)%min_temperature_ == & + 210.0_dk ) + call assert( 802362705, burkholder_param%ranges_(2)%max_temperature_ == & + 300.0_dk ) + call assert( 967255302, burkholder_param%ranges_(2)%is_fixed_ .eqv. & + .false. ) + call assert( 514623149, burkholder_param%ranges_(2)%fixed_temperature_ == & + 0.0_dk ) + call assert( 126999396, burkholder_param%ranges_(3)%min_temperature_ == & + 300.00000000001_dk ) + call assert( 574367242, burkholder_param%ranges_(3)%max_temperature_ == & + huge(1.0_dk) ) + call assert( 739259839, burkholder_param%ranges_(3)%is_fixed_ .eqv. & + .true. ) + call assert( 351636086, burkholder_param%ranges_(3)%fixed_temperature_ == & + 300.0_dk ) + + end subroutine test_burkholder_t + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +end program test_temperature_parameterization_burkholder \ No newline at end of file