greg2jul.h90 2.6 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889
  1. SUBROUTINE greg2jul( ksec, kmin, khour, kday, kmonth, kyear, pjulian, &
  2. & krefdate )
  3. !!-----------------------------------------------------------------------
  4. !!
  5. !! *** ROUTINE greg2jul ***
  6. !!
  7. !! ** Purpose : Produce the time relative to the current date and time.
  8. !!
  9. !! ** Method : The units are days, so hours and minutes transform to
  10. !! fractions of a day.
  11. !!
  12. !! Reference date : 19500101
  13. !! ** Action :
  14. !!
  15. !! History :
  16. !! ! 06-04 (A. Vidard) Original
  17. !! ! 06-04 (A. Vidard) Reformatted
  18. !! ! 06-10 (A. Weaver) Cleanup
  19. !!-----------------------------------------------------------------------
  20. ! * Arguments
  21. INTEGER, INTENT(IN) :: &
  22. & ksec, &
  23. & kmin, &
  24. & khour, &
  25. & kday, &
  26. & kmonth, &
  27. & kyear
  28. REAL(KIND=dp), INTENT(OUT) :: &
  29. & pjulian
  30. INTEGER, INTENT(IN), OPTIONAL :: &
  31. & krefdate
  32. !! * Local declarations
  33. INTEGER, PARAMETER :: &
  34. & jpgreg = 15 + 31 * ( 10 + 12 * 1582 ), & ! Gregorian calendar introduction date
  35. & jporef = 2433283, & ! Julian reference date: 19500101
  36. & jparef = 2415021, & ! Julian reference date: 19000101
  37. & jpgref = 2299161 ! Julian reference date start of Gregorian calender
  38. INTEGER :: &
  39. & ija, &
  40. & ijy, &
  41. & ijm, &
  42. & ijultmp, &
  43. & ijyear, &
  44. & iref
  45. CHARACTER(len=200) :: &
  46. & cerr
  47. IF ( PRESENT( krefdate ) ) THEN
  48. SELECT CASE ( krefdate )
  49. CASE( 0 )
  50. iref = jpgref
  51. CASE( 19500101 )
  52. iref = jporef
  53. CASE( 19000101 )
  54. iref = jparef
  55. CASE DEFAULT
  56. WRITE(cerr,'(A,I8.8)')'greg2jul: Unknown krefdate:', krefdate
  57. CALL ctl_stop( cerr )
  58. END SELECT
  59. ELSE
  60. iref = jporef
  61. ENDIF
  62. ! Main computation
  63. ijyear = kyear
  64. IF ( ijyear < 0 ) ijyear = ijyear + 1
  65. IF ( kmonth > 2 ) THEN
  66. ijy = ijyear
  67. ijm = kmonth + 1
  68. ELSE
  69. ijy = ijyear - 1
  70. ijm = kmonth + 13
  71. ENDIF
  72. ijultmp = INT( 365.25 * ijy ) + INT( 30.6001 * ijm ) + kday + 1720995
  73. IF ( kday + 31 * ( kmonth + 12 * ijyear ) >= jpgreg ) THEN
  74. ija = INT( 0.01 * ijy )
  75. ijultmp = ijultmp + 2 - ija + INT( 0.25 * ija )
  76. ENDIF
  77. pjulian = ( ijultmp - iref ) + ( ( 60 * khour + kmin ) * 60 + ksec ) / 86400.
  78. END SUBROUTINE greg2jul