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.

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

  ! For the non leap-year 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
    use errioipsl

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

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

    ! 1.0 Clean up the sring !

    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	! As one can see it is difficult to go from one calendar to the
21	! other. All operations involving julian days will be wrong. This
22	! calendar will lock as soon as possible the length of the year and
23	! forbid any further modification.
24
25	! For the non leap-year calendar the method is still brute force.
26	! We need to find an integer series which takes care of the length
27	! of 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	! - gregorian: This is the gregorian calendar (default here)
44	! - noleap: A calendar without leap years = 365 days
45	! - xxxd: A calendar of xxx days (has to be a modulo of 12)
46	! with 12 month of equal length
47
48	use calendar, only: lock_unan
49	use strlowercase_m
50	use errioipsl
51
52	CHARACTER(LEN=*), INTENT(IN):: str
53
54	INTEGER:: leng, ipos
55	CHARACTER(LEN=10):: str10
56	!--------------------------------------------------------------------
57
58	! 1.0 Clean up the sring !
59
60	CALL strlowercase (str)
61
62	IF (.NOT.lock_unan) THEN
63
64	lock_unan=.TRUE.
65
66	SELECT CASE(str)
67	CASE('gregorian')
68	calendar_used = 'gregorian'
69	un_an = 365.2425
70	mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
71	CASE('standard')
72	calendar_used = 'gregorian'
73	un_an = 365.2425
74	mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
75	CASE('proleptic_gregorian')
76	calendar_used = 'gregorian'
77	un_an = 365.2425
78	mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
79	CASE('noleap')
80	calendar_used = 'noleap'
81	un_an = 365.0
82	mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
83	CASE('365_day')
84	calendar_used = 'noleap'
85	un_an = 365.0
86	mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
87	CASE('365d')
88	calendar_used = 'noleap'
89	un_an = 365.0
90	mon_len(:)=(/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
91	CASE('all_leap')
92	calendar_used = 'all_leap'
93	un_an = 366.0
94	mon_len(:)=(/31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
95	CASE('366_day')
96	calendar_used = 'all_leap'
97	un_an = 366.0
98	mon_len(:)=(/31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
99	CASE('366d')
100	calendar_used = 'all_leap'
101	un_an = 366.0
102	mon_len(:)=(/31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/)
103	CASE DEFAULT
104	ipos = INDEX(str, 'd')
105	IF (ipos == 4) THEN
106	READ(str(1:3), '(I3)') leng
107	IF ( (MOD(leng, 12) == 0).AND.(leng > 1) ) THEN
108	calendar_used = str
109	un_an = leng
110	mon_len(:) = leng
111	ELSE
112	CALL histerr (3, 'ioconf_calendar', &
113	'The length of the year has to be a modulo of 12', &
114	'so that it can be divided into 12 month of equal ' &
115	// 'length', str)
116	ENDIF
117	ELSE
118	CALL histerr (3, 'ioconf_calendar', &
119	'Unrecognized input, please ceck the man pages.', str, ' ')
120	ENDIF
121	END SELECT
122	ELSE
123	WRITE(str10, '(f10.4)') un_an
124	CALL histerr (2, 'ioconf_calendar', &
125	'The calendar was already used or configured. You are not', &
126	'allowed to change it again. '// &
127	'The following length of year is used:', str10)
128	ENDIF
129
130	END SUBROUTINE ioconf_calendar
131
132	end module ioconf_calendar_m