New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
jul2greg.h90 in branches/UKMO/dev_r5518_fa_am_dt_deltadelta_toa/NEMOGCM/NEMO/OPA_SRC/OBS – NEMO

source: branches/UKMO/dev_r5518_fa_am_dt_deltadelta_toa/NEMOGCM/NEMO/OPA_SRC/OBS/jul2greg.h90 @ 7051

Last change on this file since 7051 was 7051, checked in by kuniko, 7 years ago

Removed $Id ...

File size: 3.1 KB
Line 
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
18      !!      ! 2014-09 (D. Lea) Change to use FLOOR to deal with negative prelday
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
85      ksec = FLOOR( 86400. * MOD( zday, 1. ) )
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
Note: See TracBrowser for help on using the repository browser.