misctools.F90 1.6 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364
  1. ! First include the set of model-wide compiler flags
  2. #include "tm5.inc"
  3. module misctools
  4. implicit none
  5. private
  6. public :: dist
  7. contains
  8. !---------------------
  9. ! subroutine dist
  10. ! compute distance between points on the globe
  11. !---------------------
  12. subroutine dist( x1g, y1g, x2g, y2g, ddg )
  13. !---------------------------------------------------------------
  14. !!! compute distance of two points on the globe.
  15. !
  16. !!! this formula is correct, also for points close together.
  17. !
  18. !!! x1g, y1g : longitude and latitude of first point (degrees)
  19. !!! x2g, y2g : longitude and latitude of second point (degrees)
  20. !!! ddg : distance between these points (km)
  21. !----------------------------------------------------------------
  22. implicit none
  23. !
  24. real,intent(in) :: x1g, x2g, y1g, y2g
  25. real,intent(out) :: ddg
  26. !
  27. real :: x1, x2, y1, y2, dd
  28. real :: cc, dx, dy, dx2, dy2, dd2
  29. real,parameter :: pi=3.141593, rearth=6378.5
  30. !
  31. cc = pi / 180.0
  32. !
  33. x1 = x1g * cc
  34. x2 = x2g * cc
  35. y1 = y1g * cc
  36. y2 = y2g * cc
  37. !
  38. ! print *,'x1,x2,y1,y2', x1,x2,y1,y2
  39. dy = 0.5 * ( y2 - y1 )
  40. dy = sin(dy)
  41. dy2 = dy * dy
  42. !
  43. dx = 0.5 * ( x2 - x1 )
  44. dx = sin(dx)
  45. dx2 = dx * dx * cos(y1) * cos(y2)
  46. !
  47. ! print *,'dx,dy,dx2,dy2',dx,dy,dx2,dy2
  48. dd2 = dx2 + dy2
  49. dd = sqrt(dd2)
  50. dd = 2.0 * asin(dd)
  51. !
  52. ddg = dd / cc
  53. ddg = (ddg * 2.0 * pi * rearth) / 360.0
  54. ! print *,'dd2,dd,ddg', dd2,dd,ddg
  55. !
  56. end subroutine dist
  57. end module misctools