diff --git a/tests/check_equivalence.F90 b/tests/check_equivalence.F90 index 48868cd8e..03cc9aee5 100644 --- a/tests/check_equivalence.F90 +++ b/tests/check_equivalence.F90 @@ -276,8 +276,8 @@ program rte_check_equivalence ! Orientation invariance ! call lw_clear_sky_vr - if(.not. allclose(tst_flux_up, ref_flux_up) .or. & - .not. allclose(tst_flux_dn, ref_flux_dn) ) & + if(.not. allclose(tst_flux_up, ref_flux_up, tol=4._wp) .or. & + .not. allclose(tst_flux_dn, ref_flux_dn, tol=4._wp) ) & call report_err(" Vertical invariance failure") print *, " Vertical orientation invariance" ! ------------------------------------------------------- diff --git a/tests/optical_prop_unit_tests.F90 b/tests/optical_prop_unit_tests.F90 index b8b515fbe..7b21227c8 100644 --- a/tests/optical_prop_unit_tests.F90 +++ b/tests/optical_prop_unit_tests.F90 @@ -46,6 +46,22 @@ program optical_prop_unit_tests ! Divide optical depth evenly among layers ! ref_1scl%tau(1:ncol,1:nlay,1) = spread(total_tau(1:ncol)/real(nlay, wp), dim=2, ncopies=nlay) + ! + ! 2- and n-stream optical properties + ! + call stop_on_err(ref_2str%alloc_2str(ncol, nlay, ref_1scl)) + ref_2str%tau = ref_1scl%tau + ref_2str%ssa = ssa + ref_2str%g = g + + call stop_on_err(ref_nstr%alloc_nstr(nmom, ncol, nlay, ref_1scl)) + ref_nstr%tau = ref_1scl%tau + ref_nstr%ssa = ssa + ! Henyey-Greenstein phase function + do imom = 1, nmom + ref_nstr%p(imom,:,:,:) = g**imom + end do + passed = .true. ! ---------------------------------------------------------------------------- ! @@ -83,11 +99,6 @@ program optical_prop_unit_tests ! ! Increment 2str ! - call stop_on_err(ref_2str%alloc_2str(ncol, nlay, ref_1scl)) - ref_2str%tau = ref_1scl%tau - ref_2str%ssa = ssa - ref_2str%g = g - call make_copy_2str call increment_with_1scl(tst_2str) if(.not. ops_match(tst_2str, ref_2str)) then @@ -115,14 +126,6 @@ program optical_prop_unit_tests ! ! Increment nstr ! - call stop_on_err(ref_nstr%alloc_nstr(nmom, ncol, nlay, ref_1scl)) - ref_nstr%tau = ref_1scl%tau - ref_nstr%ssa = ssa - ! Henyey-Greenstein phase function - do imom = 1, nmom - ref_nstr%p(imom,:,:,:) = g**imom - end do - call make_copy_nstr call increment_with_1scl(tst_nstr) if(.not. ops_match(tst_nstr, ref_nstr)) then @@ -146,7 +149,7 @@ program optical_prop_unit_tests call tst_2str%finalize() ! ---------------------------------------------------------------------------- - print *, "Halving/doubling optical thickness" + print *, " Halving/doubling optical thickness" ! ! Adding two media of half optical thickness to recover original values ! @@ -174,8 +177,20 @@ program optical_prop_unit_tests passed = .false. end if ! ---------------------------------------------------------------------------- + print *, " Delta scaling" + ! + ! Delta-scale with forward-fraction f=0 (i.e. Rayleigh scattering) + ! + call make_copy_2str + call stop_on_err(tst_2str%delta_scale(spread(spread(spread(0._wp, 1, ncol), 2, nlay), 3, 1))) + if(.not. ops_match(tst_2str, ref_2str)) then + call report_err("2str half/double fails") + passed = .false. + end if + ! ---------------------------------------------------------------------------- if (.not. passed) call stop_on_err("Optical props unit tests fail") print *, "Optical properties unit testing finished" + ! ---------------------------------------------------------------------------- contains ! ---------------------------------------------------------------------------- ! diff --git a/tests/rte_unit_tests.F90 b/tests/rte_unit_tests.F90 index b1c3f70fe..7867f7481 100644 --- a/tests/rte_unit_tests.F90 +++ b/tests/rte_unit_tests.F90 @@ -180,7 +180,7 @@ program rte_unit_tests ! Comparision of fluxes with increased surface T aren't expected to match ! fluxes + their Jacobian w.r.t. surface T exactly ! - print '(" Jacobian accurate to within ", f7.3, "%")', & + print '(" Jacobian accurate to within ", f6.2, "%")', & maxval((tst_flux_up - ref_flux_up + jFluxUp)/tst_flux_up * 100._wp) ! ------------------------------------------------------------------------------------