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	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			! 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	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			! - 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	guez	93	use calendar, only: lock_unan
49	guez	92	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	guez	93	'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	guez	92	ENDIF
117			ELSE
118			CALL histerr (3, 'ioconf_calendar', &
119	guez	93	'Unrecognized input, please ceck the man pages.', str, ' ')
120	guez	92	ENDIF
121			END SELECT
122			ELSE
123			WRITE(str10, '(f10.4)') un_an
124			CALL histerr (2, 'ioconf_calendar', &
125	guez	93	'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	guez	92	ENDIF
129
130			END SUBROUTINE ioconf_calendar
131
132			end module ioconf_calendar_m