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/dev_1784_OBS/NEMO/OPA_SRC – NEMO

source: branches/dev_1784_OBS/NEMO/OPA_SRC/jul2greg.h90 @ 2001

Last change on this file since 2001 was 2001, checked in by djlea, 14 years ago

Adding observation operator code

File size: 3.0 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      !!-----------------------------------------------------------------------
19
20      ! * Arguments
21      INTEGER, INTENT(IN), OPTIONAL :: &
22         & krefdate
23      INTEGER, INTENT(OUT) :: &
24         & ksec,   &
25         & kminut, &
26         & khour,  &
27         & kday,   &
28         & kmonth, &
29         & kyear
30      REAL(KIND=dp), INTENT(IN) :: &
31         & prelday
32
33      !! * Local declarations
34      INTEGER, PARAMETER :: &
35         & jpgreg = 2299161, &
36         & jporef = 2433283, &
37         & jparef = 2415021
38      INTEGER :: &
39         & ijulian, &
40         & ij1,     &
41         & ija,     &
42         & ijb,     &
43         & ijc,     &
44         & ijd,     &
45         & ije,     &
46         & isec,    &
47         & imin,    &
48         & ihou,    &
49         & iday,    &
50         & imon,    &
51         & iyea,    &
52         & iref
53      REAL(KIND=wp) :: &
54         & zday, &
55         & zref
56      CHARACTER(len=200) :: &
57         & cerr
58
59      ! Main computation
60      IF ( PRESENT( krefdate ) ) THEN
61
62         SELECT CASE ( krefdate )
63
64         CASE( 0 )
65            iref = jpgreg
66
67         CASE( 19500101 )
68            iref = jporef
69
70         CASE( 19000101 )
71            iref = jparef
72
73         CASE DEFAULT
74            WRITE(cerr,'(A,I8.8)')'jul2greg: Unknown krefdate:', krefdate
75            CALL ctl_stop( cerr )
76
77         END SELECT
78
79      ELSE
80         iref = jporef
81      ENDIF
82
83      zday = prelday
84      ksec = NINT( 86400. * MOD( zday, 1. ) )
85
86      IF ( ksec < 0. ) ksec = 86400. + ksec
87
88      khour  = ksec / 3600
89      kminut = ( ksec - 3600 * khour ) / 60
90      ksec   = MOD( ksec , 60 )
91
92      ijulian = iref + INT( zday )
93      IF ( zday < 0. ) ijulian = ijulian - 1
94
95      ! If input date after 10/15/1582 :
96      IF ( ijulian >= jpgreg ) THEN
97    ij1 = INT( ( DBLE( ijulian - 1867216 ) - 0.25 ) / 36524.25 )
98    ija = ijulian + 1 + ij1 - INT( ( 0.25 * ij1 ) )
99      ELSE
100    ija = ijulian
101      ENDIF
102
103      ijb = ija + 1524
104      ijc = INT( 6680. + ( DBLE ( ijb - 2439870 ) - 122.1 ) / 365.25 )
105      ijd = 365 * ijc + INT( 0.25 * ijc )
106      ije = INT( ( ijb - ijd ) / 30.6001 )
107      kday = ijb - ijd - INT( 30.6001 * ije )
108      kmonth = ije - 1
109      IF ( kmonth > 12 ) kmonth = kmonth - 12
110      kyear = ijc - 4715
111      IF ( kmonth > 2 ) kyear = kyear - 1
112      IF ( kyear <= 0 ) kyear = kyear - 1
113
114   END SUBROUTINE jul2greg
Note: See TracBrowser for help on using the repository browser.