/[lmdze]/trunk/Sources/IOIPSL/Calendar/ioconf_calendar.f
ViewVC logotype

Diff of /trunk/Sources/IOIPSL/Calendar/ioconf_calendar.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/IOIPSL/Calendar/ioconf_calendar.f revision 92 by guez, Wed Mar 26 18:16:05 2014 UTC trunk/Sources/IOIPSL/Calendar/ioconf_calendar.f revision 134 by guez, Wed Apr 29 15:47:56 2015 UTC
# Line 1  Line 1 
1  module ioconf_calendar_m  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    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  contains
36    
37    SUBROUTINE ioconf_calendar (str)    SUBROUTINE ioconf_calendar(str)
38    
39      ! This routine allows to configure the calendar to be used.      ! This routine allows to configure the calendar to be used.
40      ! This operation is only allowed once and the first call to      ! This operation is only allowed once and the first call to
41      ! ymds2ju or ju2ymsd will lock the current configuration.      ! ymds2ju or ju2ymsd will lock the current configuration.
42      ! the argument to ioconf_calendar can be any of the following:      ! 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      ! - gregorian: this is the gregorian calendar (default here)
45      !  - xxxd: A calendar of xxx days (has to be a modulo of 12)  
46      !                with 12 month of equal length      ! - noleap: A calendar without leap years = 365 days
47    
48      use calendar, only: mon_len, calendar_used, lock_unan, un_an      ! - xxxd: A calendar of xxx days (has to be a modulo of 12) with
49      use strlowercase_m      ! 12 month of equal length
50      use errioipsl  
51        use calendar, only: lock_unan
52        use strlowercase_m, only: strlowercase
53        use errioipsl, only: histerr
54    
55      CHARACTER(LEN=*), INTENT(IN):: str      CHARACTER(LEN=*), INTENT(IN):: str
56    
57      INTEGER:: leng, ipos      ! Local:
58      CHARACTER(LEN=10):: str10      INTEGER leng, ipos
59        CHARACTER(LEN=10) str10
60      !--------------------------------------------------------------------      !--------------------------------------------------------------------
61    
62      ! 1.0 Clean up the sring !      CALL strlowercase(str)
   
     CALL strlowercase (str)  
63    
64      IF (.NOT.lock_unan) THEN      IF (.NOT.lock_unan) THEN
   
65         lock_unan=.TRUE.         lock_unan=.TRUE.
66    
67         SELECT CASE(str)         SELECT CASE(str)
# Line 74  contains Line 105  contains
105            ipos = INDEX(str, 'd')            ipos = INDEX(str, 'd')
106            IF (ipos == 4) THEN            IF (ipos == 4) THEN
107               READ(str(1:3), '(I3)') leng               READ(str(1:3), '(I3)') leng
108               IF ( (MOD(leng, 12) == 0).AND.(leng > 1) ) THEN               IF ((MOD(leng, 12) == 0).AND.(leng > 1)) THEN
109                  calendar_used = str                  calendar_used = str
110                  un_an = leng                  un_an = leng
111                  mon_len(:) = leng                  mon_len(:) = leng
112               ELSE               ELSE
113                  CALL histerr (3, 'ioconf_calendar', &                  CALL histerr (3, 'ioconf_calendar', &
114                       &         'The length of the year as to be a modulo of 12', &                       'The length of the year has to be a modulo of 12', &
115                       &         'so that it can be divided into 12 month of equal length', &                       'so that it can be divided into 12 month of equal ' &
116                       &         str)                       // 'length', str)
117               ENDIF               ENDIF
118            ELSE            ELSE
119               CALL histerr (3, 'ioconf_calendar', &               CALL histerr (3, 'ioconf_calendar', &
120                    &       'Unrecognized input, please ceck the man pages.', str, ' ')                    'Unrecognized input, please ceck the man pages.', str, ' ')
121            ENDIF            ENDIF
122         END SELECT         END SELECT
123      ELSE      ELSE
124         WRITE(str10, '(f10.4)') un_an         WRITE(str10, '(f10.4)') un_an
125         CALL histerr (2, 'ioconf_calendar', &         CALL histerr (2, 'ioconf_calendar', &
126              &   'The calendar was already used or configured. You are not', &              'The calendar was already used or configured. You are not', &
127              &   'allowed to change it again. '// &              'allowed to change it again. '// &
128              &   'The following length of year is used:', str10)              'The following length of year is used:', str10)
129      ENDIF      ENDIF
130    
131    END SUBROUTINE ioconf_calendar    END SUBROUTINE ioconf_calendar
Legend:
Removed from v.92  
changed lines
  Added in v.134
  ViewVC Help
Powered by ViewVC 1.1.21