IOIPSL/Calendar/ioconf_calendar.f

module ioconf_calendar_m

  ! From IOIPSL/src/calendar.f90, version 2.0 2004/04/05 14:47:47

  ! This is the calendar used to do all calculations on time. Three
  ! types of calendars are possible:

  ! - Gregorian:
  ! The normal calendar. The time origin for the julian day in this
  ! case is 24 Nov -4713.

  ! - No leap:
  ! A 365 day year without leap years. The origin for the julian days
  ! is in this case 1 Jan 0.

  ! - xxxd:
  ! Year of xxx days with months of equal length. The origin for the
  ! julian days is then also 1 Jan 0.

  ! It is difficult to go from one calendar to the other. All
  ! operations involving julian days will be wrong. This calendar will
  ! lock the length of the year as soon as possible and forbid any
  ! further modification.

  ! For the no-leap calendar, the method is still brute force. We
  ! need to find an integer series which takes care of the length of
  ! the various month. (Jan)

  implicit none

  INTEGER:: mon_len(12) = (/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
  CHARACTER(LEN=20):: calendar_used = "gregorian"
  REAL:: un_an = 365.2425 ! one year in days

contains

  SUBROUTINE ioconf_calendar(str)

    ! This routine allows to configure the calendar to be used.
    ! This operation is only allowed once and the first call to
    ! ymds2ju or ju2ymsd will lock the current configuration.
    ! the argument to ioconf_calendar can be any of the following:

    ! - gregorian: this is the gregorian calendar (default here)

    ! - noleap: A calendar without leap years = 365 days

    ! - xxxd: A calendar of xxx days (has to be a modulo of 12) with
    ! 12 month of equal length

    use calendar, only: lock_unan
    use strlowercase_m, only: strlowercase
    use errioipsl, only: histerr

    CHARACTER(LEN=*), INTENT(IN):: str

    ! Local:
    INTEGER leng, ipos
    CHARACTER(LEN=10) str10
    !--------------------------------------------------------------------

    CALL strlowercase(str)

    IF (.NOT.lock_unan) THEN
       lock_unan=.TRUE.

       SELECT CASE(str)
       CASE('gregorian')
          calendar_used = 'gregorian'
          un_an = 365.2425
          mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
       CASE('standard')
          calendar_used = 'gregorian'
          un_an = 365.2425
          mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
       CASE('proleptic_gregorian')
          calendar_used = 'gregorian'
          un_an = 365.2425
          mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
       CASE('noleap')
          calendar_used = 'noleap'
          un_an = 365.0
          mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
       CASE('365_day')
          calendar_used = 'noleap'
          un_an = 365.0
          mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
       CASE('365d')
          calendar_used = 'noleap'
          un_an = 365.0
          mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
       CASE('all_leap')
          calendar_used = 'all_leap'
          un_an = 366.0
          mon_len(:)=(/31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
       CASE('366_day')
          calendar_used = 'all_leap'
          un_an = 366.0
          mon_len(:)=(/31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
       CASE('366d')
          calendar_used = 'all_leap'
          un_an = 366.0
          mon_len(:)=(/31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
       CASE DEFAULT
          ipos = INDEX(str, 'd')
          IF (ipos == 4) THEN
             READ(str(1:3), '(I3)') leng
             IF ((MOD(leng, 12) == 0).AND.(leng > 1)) THEN
                calendar_used = str
                un_an = leng
                mon_len(:) = leng
             ELSE
                CALL histerr (3, 'ioconf_calendar', &
                     'The length of the year has to be a modulo of 12', &
                     'so that it can be divided into 12 month of equal ' &
                     // 'length', str)
             ENDIF
          ELSE
             CALL histerr (3, 'ioconf_calendar', &
                  'Unrecognized input, please ceck the man pages.', str, ' ')
          ENDIF
       END SELECT
    ELSE
       WRITE(str10, '(f10.4)') un_an
       CALL histerr (2, 'ioconf_calendar', &
            'The calendar was already used or configured. You are not', &
            'allowed to change it again. '// &
            'The following length of year is used:', str10)
    ENDIF

  END SUBROUTINE ioconf_calendar

end module ioconf_calendar_m
1	module ioconf_calendar_m
2
3	! From IOIPSL/src/calendar.f90, version 2.0 2004/04/05 14:47:47
4
5	! This is the calendar used to do all calculations on time. Three
6	! types of calendars are possible:
7
8	! - Gregorian:
9	! The normal calendar. The time origin for the julian day in this
10	! case is 24 Nov -4713.
11
12	! - No leap:
13	! A 365 day year without leap years. The origin for the julian days
14	! is in this case 1 Jan 0.
15
16	! - xxxd:
17	! Year of xxx days with months of equal length. The origin for the
18	! julian days is then also 1 Jan 0.
19
20	! It is difficult to go from one calendar to the other. All
21	! operations involving julian days will be wrong. This calendar will
22	! lock the length of the year as soon as possible and forbid any
23	! further modification.
24
25	! For the no-leap calendar, the method is still brute force. We
26	! need to find an integer series which takes care of the length of
27	! the various month. (Jan)
28
29	implicit none
30
31	INTEGER:: mon_len(12) = (/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
32	CHARACTER(LEN=20):: calendar_used = "gregorian"
33	REAL:: un_an = 365.2425 ! one year in days
34
35	contains
36
37	SUBROUTINE ioconf_calendar(str)
38
39	! This routine allows to configure the calendar to be used.
40	! This operation is only allowed once and the first call to
41	! ymds2ju or ju2ymsd will lock the current configuration.
42	! the argument to ioconf_calendar can be any of the following:
43
44	! - gregorian: this is the gregorian calendar (default here)
45
46	! - noleap: A calendar without leap years = 365 days
47
48	! - xxxd: A calendar of xxx days (has to be a modulo of 12) with
49	! 12 month of equal length
50
51	use calendar, only: lock_unan
52	use strlowercase_m, only: strlowercase
53	use errioipsl, only: histerr
54
55	CHARACTER(LEN=*), INTENT(IN):: str
56
57	! Local:
58	INTEGER leng, ipos
59	CHARACTER(LEN=10) str10
60	!--------------------------------------------------------------------
61
62	CALL strlowercase(str)
63
64	IF (.NOT.lock_unan) THEN
65	lock_unan=.TRUE.
66
67	SELECT CASE(str)
68	CASE('gregorian')
69	calendar_used = 'gregorian'
70	un_an = 365.2425
71	mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
72	CASE('standard')
73	calendar_used = 'gregorian'
74	un_an = 365.2425
75	mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
76	CASE('proleptic_gregorian')
77	calendar_used = 'gregorian'
78	un_an = 365.2425
79	mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
80	CASE('noleap')
81	calendar_used = 'noleap'
82	un_an = 365.0
83	mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
84	CASE('365_day')
85	calendar_used = 'noleap'
86	un_an = 365.0
87	mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
88	CASE('365d')
89	calendar_used = 'noleap'
90	un_an = 365.0
91	mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
92	CASE('all_leap')
93	calendar_used = 'all_leap'
94	un_an = 366.0
95	mon_len(:)=(/31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
96	CASE('366_day')
97	calendar_used = 'all_leap'
98	un_an = 366.0
99	mon_len(:)=(/31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
100	CASE('366d')
101	calendar_used = 'all_leap'
102	un_an = 366.0
103	mon_len(:)=(/31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
104	CASE DEFAULT
105	ipos = INDEX(str, 'd')
106	IF (ipos == 4) THEN
107	READ(str(1:3), '(I3)') leng
108	IF ((MOD(leng, 12) == 0).AND.(leng > 1)) THEN
109	calendar_used = str
110	un_an = leng
111	mon_len(:) = leng
112	ELSE
113	CALL histerr (3, 'ioconf_calendar', &
114	'The length of the year has to be a modulo of 12', &
115	'so that it can be divided into 12 month of equal ' &
116	// 'length', str)
117	ENDIF
118	ELSE
119	CALL histerr (3, 'ioconf_calendar', &
120	'Unrecognized input, please ceck the man pages.', str, ' ')
121	ENDIF
122	END SELECT
123	ELSE
124	WRITE(str10, '(f10.4)') un_an
125	CALL histerr (2, 'ioconf_calendar', &
126	'The calendar was already used or configured. You are not', &
127	'allowed to change it again. '// &
128	'The following length of year is used:', str10)
129	ENDIF
130
131	END SUBROUTINE ioconf_calendar
132
133	end module ioconf_calendar_m