Skip to content

Commit f169c26

Browse files
authored
Added analytic_sol_L33_up_ionosphere_f448_r8
1 parent 6265cc4 commit f169c26

File tree

1 file changed

+75
-0
lines changed

1 file changed

+75
-0
lines changed

Radiolocation/GMS_emw_refraction.f90

+75
Original file line numberDiff line numberDiff line change
@@ -2673,5 +2673,80 @@ elemental function analytic_sol_L32_up_ionosphere_f447_r8(fc,Nmf,H2,H3,beta,a,z0
26732673
L32 = trm1*trm2
26742674
end function analytic_sol_L32_up_ionosphere_f447_r8
26752675

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+
26762751

26772752
end module emw_refraction

0 commit comments

Comments
 (0)