libf/IOIPSL/ioget_calendar.f90

MODULE ioget_calendar_m

  use calendar, only: lock_unan

  IMPLICIT NONE

  PRIVATE
  PUBLIC ioget_calendar

  INTERFACE ioget_calendar
     MODULE PROCEDURE ioget_calendar_real1, ioget_calendar_real2, &
          ioget_calendar_str
  END INTERFACE

CONTAINS

  SUBROUTINE ioget_calendar_str (str)
    !---------------------------------------------------------------------
    !- This subroutine returns the name of the calendar used here.
    !- Three options exist :
    !-  - 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

    !- This routine will lock the calendar.
    !- You do not want it to change after your inquiry.
    !---------------------------------------------------------------------
    use calendar, only: calendar_used

    CHARACTER(LEN=*),INTENT(OUT) :: str
    !---------------------------------------------------------------------
    lock_unan = .TRUE.

    str = calendar_used
    !--------------------------------
  END SUBROUTINE ioget_calendar_str
  !-
  !===
  !-
  SUBROUTINE ioget_calendar_real1 (long_an)
    !---------------------------------------------------------------------
    !- This subroutine returns the name of the calendar used here.
    !- Three options exist :
    !-  - 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

    !- This routine will lock the calendar.
    !- You do not want it to change after your inquiry.
    !---------------------------------------------------------------------
    use calendar, only: un_an

    REAL,INTENT(OUT) :: long_an
    !---------------------------------------------------------------------
    lock_unan = .TRUE.

    long_an = un_an
    !----------------------------------
  END SUBROUTINE ioget_calendar_real1
  !-
  !===
  !-
  SUBROUTINE ioget_calendar_real2 (long_an,long_jour)
    !---------------------------------------------------------------------
    !- This subroutine returns the name of the calendar used here.
    !- Three options exist :
    !-  - 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

    !- This routine will lock the calendar.
    !- You do not want it to change after your inquiry.
    !---------------------------------------------------------------------
    use calendar, only: un_an, un_jour

    REAL,INTENT(OUT) :: long_an,long_jour
    !---------------------------------------------------------------------
    lock_unan = .TRUE.

    long_an = un_an
    long_jour = un_jour
    !----------------------------------
  END SUBROUTINE ioget_calendar_real2

END MODULE ioget_calendar_m
1	MODULE ioget_calendar_m
2
3	use calendar, only: lock_unan
4
5	IMPLICIT NONE
6
7	PRIVATE
8	PUBLIC ioget_calendar
9
10	INTERFACE ioget_calendar
11	MODULE PROCEDURE ioget_calendar_real1, ioget_calendar_real2, &
12	ioget_calendar_str
13	END INTERFACE
14
15	CONTAINS
16
17	SUBROUTINE ioget_calendar_str (str)
18	!---------------------------------------------------------------------
19	!- This subroutine returns the name of the calendar used here.
20	!- Three options exist :
21	!- - gregorian : This is the gregorian calendar (default here)
22	!- - noleap : A calendar without leap years = 365 days
23	!- - xxxd : A calendar of xxx days (has to be a modulo of 12)
24	!- with 12 month of equal length
25
26	!- This routine will lock the calendar.
27	!- You do not want it to change after your inquiry.
28	!---------------------------------------------------------------------
29	use calendar, only: calendar_used
30
31	CHARACTER(LEN=*),INTENT(OUT) :: str
32	!---------------------------------------------------------------------
33	lock_unan = .TRUE.
34
35	str = calendar_used
36	!--------------------------------
37	END SUBROUTINE ioget_calendar_str
38	!-
39	!===
40	!-
41	SUBROUTINE ioget_calendar_real1 (long_an)
42	!---------------------------------------------------------------------
43	!- This subroutine returns the name of the calendar used here.
44	!- Three options exist :
45	!- - gregorian : This is the gregorian calendar (default here)
46	!- - noleap : A calendar without leap years = 365 days
47	!- - xxxd : A calendar of xxx days (has to be a modulo of 12)
48	!- with 12 month of equal length
49
50	!- This routine will lock the calendar.
51	!- You do not want it to change after your inquiry.
52	!---------------------------------------------------------------------
53	use calendar, only: un_an
54
55	REAL,INTENT(OUT) :: long_an
56	!---------------------------------------------------------------------
57	lock_unan = .TRUE.
58
59	long_an = un_an
60	!----------------------------------
61	END SUBROUTINE ioget_calendar_real1
62	!-
63	!===
64	!-
65	SUBROUTINE ioget_calendar_real2 (long_an,long_jour)
66	!---------------------------------------------------------------------
67	!- This subroutine returns the name of the calendar used here.
68	!- Three options exist :
69	!- - gregorian : This is the gregorian calendar (default here)
70	!- - noleap : A calendar without leap years = 365 days
71	!- - xxxd : A calendar of xxx days (has to be a modulo of 12)
72	!- with 12 month of equal length
73
74	!- This routine will lock the calendar.
75	!- You do not want it to change after your inquiry.
76	!---------------------------------------------------------------------
77	use calendar, only: un_an, un_jour
78
79	REAL,INTENT(OUT) :: long_an,long_jour
80	!---------------------------------------------------------------------
81	lock_unan = .TRUE.
82
83	long_an = un_an
84	long_jour = un_jour
85	!----------------------------------
86	END SUBROUTINE ioget_calendar_real2
87
88	END MODULE ioget_calendar_m