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	guez	92	module ioconf_calendar_m
2
3	guez	93	! 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	guez	132	! 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	guez	93
25	guez	132	! 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	guez	93
29	guez	92	implicit none
30
31	guez	93	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	guez	92	contains
36
37	guez	106	SUBROUTINE ioconf_calendar(str)
38	guez	92
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	guez	132	! - 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	guez	93	use calendar, only: lock_unan
52	guez	132	use strlowercase_m, only: strlowercase
53			use errioipsl, only: histerr
54	guez	92
55			CHARACTER(LEN=*), INTENT(IN):: str
56
57	guez	132	! Local:
58			INTEGER leng, ipos
59			CHARACTER(LEN=10) str10
60	guez	92	!--------------------------------------------------------------------
61
62	guez	132	CALL strlowercase(str)
63	guez	92
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	guez	132	IF ((MOD(leng, 12) == 0).AND.(leng > 1)) THEN
109	guez	92	calendar_used = str
110			un_an = leng
111			mon_len(:) = leng
112			ELSE
113			CALL histerr (3, 'ioconf_calendar', &
114	guez	93	'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	guez	92	ENDIF
118			ELSE
119			CALL histerr (3, 'ioconf_calendar', &
120	guez	93	'Unrecognized input, please ceck the man pages.', str, ' ')
121	guez	92	ENDIF
122			END SELECT
123			ELSE
124			WRITE(str10, '(f10.4)') un_an
125			CALL histerr (2, 'ioconf_calendar', &
126	guez	93	'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	guez	92	ENDIF
130
131			END SUBROUTINE ioconf_calendar
132
133			end module ioconf_calendar_m