@@ -3961,4 +3961,44 @@ elemental function ray_traj_inhomogenous_atmos_f531_r8(n,na,R0,z0,tht) result(r)
3961
3961
r = trm1* trm2
3962
3962
end function ray_traj_inhomogenous_atmos_f531_r8
3963
3963
3964
+ ! Рефракция электромагнитных волн (Х<5 см)
3965
+ ! в земной атмосфере при близких или равных
3966
+ ! высотах излучателя и приемника.
3967
+ ! Formula: 5.34, page: 100
3968
+ elemental function analytic_sol_L_atmos_wvle5cm_f534_r4 (z0 ,beta ,R0 ,thtc ) result(L)
3969
+ if defined(__INTEL_COMPILER) && ! defined(__GNUC__)
3970
+ ! dir$ optimize:3
3971
+ ! dir$ attributes code_align : 32 :: analytic_sol_L_atmos_wvle5cm_f534_r4
3972
+ ! dir$ attributes forceinline :: analytic_sol_L_atmos_wvle5cm_f534_r4
3973
+ #endif
3974
+ ! $omp declare simd(analytic_sol_L_atmos_wvle5cm_f534_r4)
3975
+ real (kind= sp), intent (in ) :: z0
3976
+ real (kind= sp), intent (in ) :: beta
3977
+ real (kind= sp), intent (in ) :: R0
3978
+ real (kind= sp), intent (in ) :: thtc
3979
+ real (kind= sp) :: L
3980
+ real (kind= sp), automatic :: ctgz0, sctgz0, btR0
3981
+ real (kind= sp), automatic :: p1, q1, sp1
3982
+ real (kind= sp), automatic :: t0, t1
3983
+ real (kind= sp), automatic :: exp1, exp2
3984
+ real (kind= sp), automatic :: rat1, rat2
3985
+ real (kind= sp), automatic :: tbtR0, trm1, trm2
3986
+ btR0 = beta* R0
3987
+ tbtR0 = btR0+ btR0
3988
+ ctgz0 = 1.0_sp / tan (z0)
3989
+ sctgz0 = ctgz0* ctgz0
3990
+ q1 = sqrt (0.5_sp * sctgz0)
3991
+ t0 = sqrt (0.5_sp + sctgz0)
3992
+ p1 = ctgz0/ (2.0_sp + t0)
3993
+ sp1 = p1* p1
3994
+ rat1 = p1/ tbtR0
3995
+ exp1 = exp (- btR0* sp1)
3996
+ t1 = (p1+ q1* thtc)/ tbtR0
3997
+ t0 = (p1+ q1* thtc)* (p1+ q1* thtc)
3998
+ exp2 = exp (- btR0* t0)
3999
+ trm1 = rat1* exp1
4000
+ trm2 = t1* exp2
4001
+ L = trm1- trm2
4002
+ end function analytic_sol_L_atmos_wvle5cm_f534_r4
4003
+
3964
4004
end module emw_refraction
0 commit comments