[2128] | 1 | RECURSIVE SUBROUTINE jul2greg( ksec, kminut, khour, kday, kmonth, kyear, & |
---|
| 2 | & prelday, krefdate ) |
---|
| 3 | !!----------------------------------------------------------------------- |
---|
| 4 | !! |
---|
| 5 | !! *** ROUTINE jul2greg *** |
---|
| 6 | !! |
---|
| 7 | !! ** Purpose : Take the relative time in days and re-express in terms of |
---|
| 8 | !! seconds, minutes, hours, days, month, year. |
---|
| 9 | !! |
---|
| 10 | !! ** Method : Reference date : 19500101 |
---|
| 11 | !! |
---|
| 12 | !! ** Action : |
---|
| 13 | !! |
---|
| 14 | !! History |
---|
| 15 | !! ! 06-04 (A. Vidard) Original |
---|
| 16 | !! ! 06-05 (A. Vidard) Reformatted and refdate |
---|
| 17 | !! ! 06-10 (A. Weaver) Cleanup |
---|
[4990] | 18 | !! ! 2014-09 (D. Lea) Change to use FLOOR to deal with negative prelday |
---|
[2128] | 19 | !!----------------------------------------------------------------------- |
---|
| 20 | |
---|
| 21 | ! * Arguments |
---|
| 22 | INTEGER, INTENT(IN), OPTIONAL :: & |
---|
| 23 | & krefdate |
---|
| 24 | INTEGER, INTENT(OUT) :: & |
---|
| 25 | & ksec, & |
---|
| 26 | & kminut, & |
---|
| 27 | & khour, & |
---|
| 28 | & kday, & |
---|
| 29 | & kmonth, & |
---|
| 30 | & kyear |
---|
| 31 | REAL(KIND=dp), INTENT(IN) :: & |
---|
| 32 | & prelday |
---|
| 33 | |
---|
| 34 | !! * Local declarations |
---|
| 35 | INTEGER, PARAMETER :: & |
---|
| 36 | & jpgreg = 2299161, & |
---|
| 37 | & jporef = 2433283, & |
---|
| 38 | & jparef = 2415021 |
---|
| 39 | INTEGER :: & |
---|
| 40 | & ijulian, & |
---|
| 41 | & ij1, & |
---|
| 42 | & ija, & |
---|
| 43 | & ijb, & |
---|
| 44 | & ijc, & |
---|
| 45 | & ijd, & |
---|
| 46 | & ije, & |
---|
| 47 | & isec, & |
---|
| 48 | & imin, & |
---|
| 49 | & ihou, & |
---|
| 50 | & iday, & |
---|
| 51 | & imon, & |
---|
| 52 | & iyea, & |
---|
| 53 | & iref |
---|
| 54 | REAL(KIND=wp) :: & |
---|
| 55 | & zday, & |
---|
| 56 | & zref |
---|
| 57 | CHARACTER(len=200) :: & |
---|
| 58 | & cerr |
---|
| 59 | |
---|
| 60 | ! Main computation |
---|
| 61 | IF ( PRESENT( krefdate ) ) THEN |
---|
| 62 | |
---|
| 63 | SELECT CASE ( krefdate ) |
---|
| 64 | |
---|
| 65 | CASE( 0 ) |
---|
| 66 | iref = jpgreg |
---|
| 67 | |
---|
| 68 | CASE( 19500101 ) |
---|
| 69 | iref = jporef |
---|
| 70 | |
---|
| 71 | CASE( 19000101 ) |
---|
| 72 | iref = jparef |
---|
| 73 | |
---|
| 74 | CASE DEFAULT |
---|
| 75 | WRITE(cerr,'(A,I8.8)')'jul2greg: Unknown krefdate:', krefdate |
---|
| 76 | CALL ctl_stop( cerr ) |
---|
| 77 | |
---|
| 78 | END SELECT |
---|
| 79 | |
---|
| 80 | ELSE |
---|
| 81 | iref = jporef |
---|
| 82 | ENDIF |
---|
| 83 | |
---|
| 84 | zday = prelday |
---|
[4990] | 85 | ksec = FLOOR( 86400. * MOD( zday, 1. ) ) |
---|
[2128] | 86 | |
---|
| 87 | IF ( ksec < 0. ) ksec = 86400. + ksec |
---|
| 88 | |
---|
| 89 | khour = ksec / 3600 |
---|
| 90 | kminut = ( ksec - 3600 * khour ) / 60 |
---|
| 91 | ksec = MOD( ksec , 60 ) |
---|
| 92 | |
---|
| 93 | ijulian = iref + INT( zday ) |
---|
| 94 | IF ( zday < 0. ) ijulian = ijulian - 1 |
---|
| 95 | |
---|
| 96 | ! If input date after 10/15/1582 : |
---|
| 97 | IF ( ijulian >= jpgreg ) THEN |
---|
| 98 | ij1 = INT( ( DBLE( ijulian - 1867216 ) - 0.25 ) / 36524.25 ) |
---|
| 99 | ija = ijulian + 1 + ij1 - INT( ( 0.25 * ij1 ) ) |
---|
| 100 | ELSE |
---|
| 101 | ija = ijulian |
---|
| 102 | ENDIF |
---|
| 103 | |
---|
| 104 | ijb = ija + 1524 |
---|
| 105 | ijc = INT( 6680. + ( DBLE ( ijb - 2439870 ) - 122.1 ) / 365.25 ) |
---|
| 106 | ijd = 365 * ijc + INT( 0.25 * ijc ) |
---|
| 107 | ije = INT( ( ijb - ijd ) / 30.6001 ) |
---|
| 108 | kday = ijb - ijd - INT( 30.6001 * ije ) |
---|
| 109 | kmonth = ije - 1 |
---|
| 110 | IF ( kmonth > 12 ) kmonth = kmonth - 12 |
---|
| 111 | kyear = ijc - 4715 |
---|
| 112 | IF ( kmonth > 2 ) kyear = kyear - 1 |
---|
| 113 | IF ( kyear <= 0 ) kyear = kyear - 1 |
---|
| 114 | |
---|
| 115 | END SUBROUTINE jul2greg |
---|