@@ -2673,5 +2673,80 @@ elemental function analytic_sol_L32_up_ionosphere_f447_r8(fc,Nmf,H2,H3,beta,a,z0
2673
2673
L32 = trm1* trm2
2674
2674
end function analytic_sol_L32_up_ionosphere_f447_r8
2675
2675
2676
+ ! Formula: 4.48, page: 83
2677
+ elemental function analytic_sol_L33_up_ionosphere_f448_r4 (fc ,Nmf ,H2 ,H3 ,beta ,a ,z0 ) result(L33)
2678
+ if defined(__INTEL_COMPILER) && ! defined(__GNUC__)
2679
+ ! dir$ optimize:3
2680
+ ! dir$ attributes code_align : 32 :: analytic_sol_L33_up_ionosphere_f448_r4
2681
+ ! dir$ attributes forceinline :: analytic_sol_L33_up_ionosphere_f448_r4
2682
+ #endif
2683
+ ! $omp declare simd(analytic_sol_L33_up_ionosphere_f448_r4)
2684
+ real (kind= sp), intent (in ) :: fc
2685
+ real (kind= sp), intent (in ) :: Nmf
2686
+ real (kind= sp), intent (in ) :: H2
2687
+ real (kind= sp), intent (in ) :: H3
2688
+ real (kind= sp), intent (in ) :: beta
2689
+ real (kind= sp), intent (in ) :: a
2690
+ real (kind= sp), intent (in ) :: z0
2691
+ real (kind= sp) :: L32
2692
+ real (kind= sp), parameter :: C314159265358979323846264338328 = 3.14159265358979323846264338328_sp
2693
+ real (kind= sp), automatic :: delNm, piba, earg, bactgz
2694
+ real (kind= sp), automatic :: prob1, prob2, trm1, trm2
2695
+ real (kind= sp), automatic :: ctgz0, sctgz0, exp1, t0, t1
2696
+ piba = C314159265358979323846264338328* beta* a
2697
+ t0 = tan (z0)
2698
+ ctgz0 = 1.0_sp / t0
2699
+ sctgz0= ctgz0* ctgz0
2700
+ delNm = compute_delnM_f414_r4 (fc,Nmf)
2701
+ bactgz0 = beta* a* sctgz0
2702
+ trm1 = - delnM* sqrt (piba)* ctgz0
2703
+ earg = beta* (H2+ a* sctgz0)
2704
+ exp1 = exp (earg)
2705
+ t0 = sqrt (2.0_sp * bactgz0+4.0_sp * beta* H3)
2706
+ t1 = sqrt (2.0_sp * bactgz0+4.0_sp * beta* H2)
2707
+ prob1 = prob_integral_r4 (t0)
2708
+ prob2 = prob_integral_r4 (t1)
2709
+ trm2 = exp1* (prob1- prob2)
2710
+ L32 = trm1* trm2
2711
+ end function analytic_sol_L33_up_ionosphere_f448_r4
2712
+
2713
+ elemental function analytic_sol_L33_up_ionosphere_f448_r8 (fc ,Nmf ,H2 ,H3 ,beta ,a ,z0 ) result(L33)
2714
+ if defined(__INTEL_COMPILER) && ! defined(__GNUC__)
2715
+ ! dir$ optimize:3
2716
+ ! dir$ attributes code_align : 32 :: analytic_sol_L33_up_ionosphere_f448_r8
2717
+ ! dir$ attributes forceinline :: analytic_sol_L33_up_ionosphere_f448_r8
2718
+ #endif
2719
+ ! $omp declare simd(analytic_sol_L33_up_ionosphere_f448_r8)
2720
+ real (kind= dp), intent (in ) :: fc
2721
+ real (kind= dp), intent (in ) :: Nmf
2722
+ real (kind= dp), intent (in ) :: H2
2723
+ real (kind= dp), intent (in ) :: H3
2724
+ real (kind= dp), intent (in ) :: beta
2725
+ real (kind= dp), intent (in ) :: a
2726
+ real (kind= dp), intent (in ) :: z0
2727
+ real (kind= dp) :: L33
2728
+ real (kind= dp), parameter :: C314159265358979323846264338328 = 3.14159265358979323846264338328_dp
2729
+ real (kind= dp), automatic :: delNm, piba, earg, bactgz
2730
+ real (kind= dp), automatic :: prob1, prob2, trm1, trm2
2731
+ real (kind= dp), automatic :: ctgz0, sctgz0, exp1, t0, t1
2732
+ piba = C314159265358979323846264338328* beta* a
2733
+ t0 = tan (z0)
2734
+ ctgz0 = 1.0_dp / t0
2735
+ sctgz0 = ctgz0* ctgz0
2736
+ delNm = compute_delnM_f414_r8 (fc,Nmf)
2737
+ bactgz0 = beta* a* sctgz0
2738
+ trm1 = - delnM* sqrt (piba)* ctgz0
2739
+ earg = beta* (H2+ a* sctgz0)
2740
+ exp1 = exp (earg)
2741
+ t0 = sqrt (2.0_dp * bactgz0+4.0_dp * beta* H3)
2742
+ t1 = sqrt (2.0_dp * bactgz0+4.0_dp * beta* H2)
2743
+ prob1 = prob_integral_r8 (t0)
2744
+ prob2 = prob_integral_r8 (t1)
2745
+ trm2 = exp1* (prob1- prob2)
2746
+ L32 = trm1* trm2
2747
+ end function analytic_sol_L33_up_ionosphere_f448_r8
2748
+
2749
+
2750
+
2676
2751
2677
2752
end module emw_refraction
0 commit comments