@@ -2746,7 +2746,43 @@ elemental function analytic_sol_L33_up_ionosphere_f448_r8(fc,Nmf,H2,H3,beta,a,z0
2746
2746
L32 = trm1* trm2
2747
2747
end function analytic_sol_L33_up_ionosphere_f448_r8
2748
2748
2749
-
2749
+ ! Formula: 4.49, page: 83
2750
+ elemental function analytic_sol_L34_up_ionosphere_f449_r4 (deln0 ,fc ,Nmf ,H2 ,H3 ,beta ,a ,z0 ) result(L34)
2751
+ if defined(__INTEL_COMPILER) && ! defined(__GNUC__)
2752
+ ! dir$ optimize:3
2753
+ ! dir$ attributes code_align : 32 :: analytic_sol_L34_up_ionosphere_f449_r4
2754
+ ! dir$ attributes forceinline :: analytic_sol_L34_up_ionosphere_f449_r4
2755
+ #endif
2756
+ ! $omp declare simd(analytic_sol_L34_up_ionosphere_f449_r4)
2757
+ real (kind= sp), intent (in ) :: deln0
2758
+ real (kind= sp), intent (in ) :: fc
2759
+ real (kind= sp), intent (in ) :: Nmf
2760
+ real (kind= sp), intent (in ) :: H2
2761
+ real (kind= sp), intent (in ) :: H3
2762
+ real (kind= sp), intent (in ) :: beta
2763
+ real (kind= sp), intent (in ) :: a
2764
+ real (kind= sp), intent (in ) :: z0
2765
+ real (kind= sp) :: L31
2766
+ real (kind= sp), automatic :: delNm, stgz0, ctgz0, earg
2767
+ real (kind= sp), automatic :: trm1, trm2, exp1, ssecz0
2768
+ real (kind= sp), automatic :: sqrtrm1, sqrtrm2, t0, t1
2769
+ earg = beta* (H3- H2)
2770
+ delnNm = compute_delnM_f414_r4 (fc,Nmf)
2771
+ t0 = tan (z0)
2772
+ stgz0 = t0* t0
2773
+ ctgz0 = 1.0_sp / t0
2774
+ t0 = cos (z0)
2775
+ t1 = 1.0_sp / t0
2776
+ ssecz0 = t1* t1
2777
+ exp1 = exp (earg)
2778
+ trm1 = - deln0* delNm* beta* ctgz0* ssecz0
2779
+ sqrtrm1= 1.0_sp+2.0_sp * stgz0* (H2/ a)
2780
+ sqrtrm2= 1.0_sp+2.0_sp * stgz0* (H3/ a)
2781
+ t0 = sqrt (sqrtrm1)
2782
+ t1 = sqrt (sqrtrm2)
2783
+ trm2 = t0- exp1* t1
2784
+ L31 = trm1* trm2
2785
+ end function analytic_sol_L34_up_ionosphere_f449_r4
2750
2786
2751
2787
2752
2788
end module emw_refraction
0 commit comments