[Dart-dev] [3820] DART/trunk/time_manager/time_manager_mod.f90: set_calendar_type() has been overloaded to take character strings as well as
nancy at ucar.edu
nancy at ucar.edu
Thu Apr 16 14:16:15 MDT 2009
An HTML attachment was scrubbed...
URL: http://mailman.ucar.edu/pipermail/dart-dev/attachments/20090416/31fa7b34/attachment.html
-------------- next part --------------
Modified: DART/trunk/time_manager/time_manager_mod.f90
===================================================================
--- DART/trunk/time_manager/time_manager_mod.f90 2009-04-16 16:46:27 UTC (rev 3819)
+++ DART/trunk/time_manager/time_manager_mod.f90 2009-04-16 20:16:15 UTC (rev 3820)
@@ -13,7 +13,7 @@
use types_mod, only : missing_i, digits12
use utilities_mod, only : error_handler, E_DBG, E_MSG, E_WARN, E_ERR, &
- register_module, dump_unit_attributes
+ register_module, dump_unit_attributes, to_upper
implicit none
private
@@ -57,7 +57,7 @@
GREGORIAN_MARS
! Subroutines and functions involving relations between time and calendar
-public :: set_calendar_type, get_calendar_type
+public :: set_calendar_type, get_calendar_type, get_calendar_string
public :: set_date, set_date_gregorian, set_date_julian, &
set_date_thirty, set_date_no_leap, &
set_date_gregorian_mars
@@ -130,10 +130,17 @@
interface operator (/=); module procedure time_ne; end interface
interface operator (//); module procedure time_real_divide; end interface
+interface set_calendar_type
+ module procedure set_calendar_type_integer
+ module procedure set_calendar_type_string
+end interface
+
!======================================================================
logical, save :: module_initialized = .false.
+character(len=129) :: errstring
+
!======================================================================
contains
@@ -155,7 +162,6 @@
type(time_type) :: set_time
integer :: days_in
-character(len=129) :: errstring
if ( .not. module_initialized ) call time_manager_init
@@ -212,8 +218,6 @@
integer, intent(out) :: seconds
integer, intent(out), optional :: days
-character(len=129) :: errstring
-
if ( .not. module_initialized ) call time_manager_init
seconds = time%seconds
@@ -247,7 +251,6 @@
type(time_type) :: increment_time
integer :: days_in
-character(len=129) :: errstring
if ( .not. module_initialized ) call time_manager_init
@@ -291,7 +294,6 @@
type(time_type) :: decrement_time
integer :: cseconds, cdays
-character(len=129) :: errstring
if ( .not. module_initialized ) call time_manager_init
@@ -493,7 +495,6 @@
integer :: days, seconds
real(digits12) :: sec_prod
-character(len=129) :: errstring
if ( .not. module_initialized ) call time_manager_init
@@ -552,7 +553,6 @@
integer :: time_divide
real(digits12) :: d1, d2
-character(len=129) :: errstring
if ( .not. module_initialized ) call time_manager_init
@@ -615,7 +615,6 @@
real(digits12) :: d, div
integer :: days, seconds
type(time_type) :: prod1, prod2
-character(len=129) :: errstring
if ( .not. module_initialized ) call time_manager_init
@@ -706,32 +705,98 @@
! CALENDAR OPERATIONS BEGIN HERE
!=========================================================================
-subroutine set_calendar_type(type)
+subroutine set_calendar_type_integer(mytype)
-! Selects calendar for default mapping from time to date.
+! Selects calendar for default mapping from time to date - if you know
+! the magic integer for the calendar of interest.
-implicit none
+integer, intent(in) :: mytype
-integer, intent(in) :: type
+if ( .not. module_initialized ) call time_manager_init
-character(len=129) :: errstring
+if(mytype < 0 .or. mytype > max_type) then
+ write(errstring,*)'Illegal calendar type ',mytype,' must be >= 0 or <= ',max_type
+ call error_handler(E_ERR,'set_calendar_type_integer', &
+ errstring,source,revision,revdate)
+endif
+calendar_type = mytype
+end subroutine set_calendar_type_integer
+
+
+
+subroutine set_calendar_type_string(calstring)
+
+! Selects calendar for default mapping from time to date - given a string.
+
+character(len=*), intent(in) :: calstring
+
+integer, parameter :: max_calendar_string_length = len_trim('THIRTY_DAY_MONTHS')
+
+character(len=len(calstring)) :: str1
+character(len=max_calendar_string_length) :: cstring
+logical :: found_calendar = .false.
+integer :: i
+
if ( .not. module_initialized ) call time_manager_init
-if(type < 0 .or. type > max_type) then
- write(errstring,*)'Illegal type ',type,' must be > 0 or < ',max_type
- call error_handler(E_ERR,'set_calendar_type',errstring,source,revision,revdate)
+str1 = adjustl(calstring)
+
+if ( len_trim(str1) > max_calendar_string_length ) then
+ write(errstring,*)'Illegal calendar ',trim(calstring)
+ call error_handler(E_ERR,'set_calendar_type_string', &
+ errstring,source,revision,revdate)
endif
-calendar_type = type
-! GREGORIAN Calendar only partially implemented; get and set_date work
-!if(type == GREGORIAN) &
-! call error_handler('set_calendar_type :: GREGORIAN CALENDAR not implemented')
+cstring = trim(str1)
+call to_upper(cstring)
-end subroutine set_calendar_type
+! Using 'cstring' as the substring (2nd argument), we remove
+! the ambiguity of someone trying to use a calendar string
+! of 'no' ... which could either match no_calendar or noleap.
+! We must check for the gregorian_mars calendar before
+! the gregorian calendar for similar reasons.
+WhichCalendar : do i = 0, max_type
+ if ( cstring == 'NO_CALENDAR' ) then
+ calendar_type = NO_CALENDAR
+ found_calendar = .true.
+ exit WhichCalendar
+ elseif ( cstring == 'THIRTY_DAY_MONTHS' ) then
+ calendar_type = THIRTY_DAY_MONTHS
+ found_calendar = .true.
+ exit WhichCalendar
+ elseif ( cstring == 'JULIAN' ) then
+ calendar_type = JULIAN
+ found_calendar = .true.
+ exit WhichCalendar
+ elseif ( cstring == 'NOLEAP' ) then
+ calendar_type = NOLEAP
+ found_calendar = .true.
+ exit WhichCalendar
+ elseif ( cstring == 'GREGORIAN_MARS' ) then
+ calendar_type = GREGORIAN_MARS
+ found_calendar = .true.
+ exit WhichCalendar
+ elseif ( cstring == 'GREGORIAN' ) then
+ calendar_type = GREGORIAN
+ found_calendar = .true.
+ exit WhichCalendar
+ endif
+enddo WhichCalendar
+
+if( .not. found_calendar ) then
+ write(errstring,*)'Unknown calendar ',calstring
+ call error_handler(E_ERR,'set_calendar_type_string', &
+ errstring,source,revision,revdate)
+endif
+
+end subroutine set_calendar_type_string
+
+
+
function get_calendar_type()
!------------------------------------------------------------------------
!
@@ -749,6 +814,38 @@
+subroutine get_calendar_string(mystring)
+!------------------------------------------------------------------------
+!
+! Returns default calendar type for mapping from time to date.
+
+character(len=*), intent(OUT) :: mystring
+
+integer :: i
+
+if ( .not. module_initialized ) call time_manager_init
+
+mystring = ' '
+
+do i = 0,max_type
+ if (calendar_type == JULIAN) mystring = 'JULIAN'
+ if (calendar_type == NOLEAP) mystring = 'NOLEAP'
+ if (calendar_type == GREGORIAN) mystring = 'GREGORIAN'
+ if (calendar_type == NO_CALENDAR) mystring = 'NO_CALENDAR'
+ if (calendar_type == GREGORIAN_MARS) mystring = 'GREGORIAN_MARS'
+ if (calendar_type == THIRTY_DAY_MONTHS) mystring = 'THIRTY_DAY_MONTHS'
+enddo
+
+if (len_trim(mystring) < 3) then
+ write(errstring,*)'unknown calendar type ', calendar_type
+ call error_handler(E_ERR,'get_calendar_string',errstring, &
+ source,revision,revdate)
+endif
+
+end subroutine get_calendar_string
+
+
+
!========================================================================
! START OF get_date BLOCK
!========================================================================
@@ -763,8 +860,6 @@
type(time_type), intent(in) :: time
integer, intent(out) :: second, minute, hour, day, month, year
-character(len=129) :: errstring
-
if ( .not. module_initialized ) call time_manager_init
select case(calendar_type)
@@ -1075,7 +1170,6 @@
type(time_type) :: set_date
integer :: oseconds, ominutes, ohours
-character(len=129) :: errstring
if ( .not. module_initialized ) call time_manager_init
@@ -1115,7 +1209,6 @@
integer, intent(in), optional :: seconds, minutes, hours
type(time_type) :: set_date_gregorian
-character(len=129) :: errstring
integer :: oseconds, ominutes, ohours
integer :: ndays, m, nleapyr
integer :: base_year = 1601
@@ -1189,7 +1282,6 @@
integer, intent(in), optional :: seconds, minutes, hours
type(time_type) :: set_date_julian
-character(len=129) :: errstring
integer :: oseconds, ominutes, ohours
integer :: ndays, m, nleapyr
logical :: leap
@@ -1256,7 +1348,6 @@
integer, intent(in), optional :: seconds, minutes, hours
type(time_type) :: set_date_thirty
-character(len=129) :: errstring
integer :: oseconds, ominutes, ohours
if ( .not. module_initialized ) call time_manager_init
@@ -1297,7 +1388,6 @@
integer, intent(in), optional :: seconds, minutes, hours
type(time_type) :: set_date_no_leap
-character(len=129) :: errstring
integer :: oseconds, ominutes, ohours
integer :: ndays, m
@@ -1351,7 +1441,6 @@
integer, intent(in), optional :: seconds, minutes, hours
type(time_type) :: set_date_gregorian_mars
-character(len=129) :: errstring
integer :: oseconds, ominutes, ohours
! "base_year" for Mars will be defined as 1 (earliest wrfout file has year = 1)
@@ -1411,7 +1500,6 @@
type(time_type) :: increment_date
integer :: oseconds, ominutes, ohours, odays, omonths, oyears
-character(len=129) :: errstring
if ( .not. module_initialized ) call time_manager_init
@@ -1462,7 +1550,6 @@
integer :: oseconds, ominutes, ohours, odays, omonths, oyears
integer :: csecond, cminute, chour, cday, cmonth, cyear
-character(len=129) :: errstring
if ( .not. module_initialized ) call time_manager_init
@@ -1522,7 +1609,6 @@
integer :: oseconds, ominutes, ohours, odays, omonths, oyears
integer :: csecond, cminute, chour, cday, cmonth, cyear, dyear
type(time_type) :: t
-character(len=129) :: errstring
if ( .not. module_initialized ) call time_manager_init
@@ -1604,7 +1690,6 @@
integer, intent(in), optional :: seconds, minutes, hours, days, months, years
type(time_type) :: increment_thirty
-character(len=129) :: errstring
integer :: oseconds, ominutes, ohours, odays, omonths, oyears
integer :: csecond, cday
@@ -1653,7 +1738,6 @@
integer :: oseconds, ominutes, ohours, odays, omonths, oyears
integer :: csecond, cminute, chour, cday, cmonth, cyear, dyear
type(time_type) :: t
-character(len=129) :: errstring
if ( .not. module_initialized ) call time_manager_init
@@ -1767,7 +1851,6 @@
type(time_type) :: decrement_date
integer :: oseconds, ominutes, ohours, odays, omonths, oyears
-character(len=129) :: errstring
if ( .not. module_initialized ) call time_manager_init
@@ -1816,7 +1899,6 @@
integer, intent(in), optional :: seconds, minutes, hours, days, months, years
type(time_type) :: decrement_gregorian
-character(len=129) :: errstring
integer :: oseconds, ominutes, ohours, odays, omonths, oyears
integer :: csecond, cminute, chour, cday, cmonth, cyear
@@ -1879,7 +1961,6 @@
integer :: oseconds, ominutes, ohours, odays, omonths, oyears
integer :: csecond, cminute, chour, cday, cmonth, cyear
type(time_type) :: t
-character(len=129) :: errstring
if ( .not. module_initialized ) call time_manager_init
@@ -1957,7 +2038,6 @@
integer, intent(in), optional :: seconds, minutes, hours, days, months, years
type(time_type) :: decrement_thirty
-character(len=129) :: errstring
integer :: oseconds, ominutes, ohours, odays, omonths, oyears
integer :: csecond, cday
@@ -2002,7 +2082,6 @@
integer :: oseconds, ominutes, ohours, odays, omonths, oyears
integer :: csecond, cminute, chour, cday, cmonth, cyear
type(time_type) :: t
-character(len=129) :: errstring
if ( .not. module_initialized ) call time_manager_init
@@ -2113,7 +2192,6 @@
type(time_type), intent(in) :: time
integer :: days_in_month
-character(len=129) :: errstring
if ( .not. module_initialized ) call time_manager_init
@@ -2250,8 +2328,6 @@
type(time_type), intent(in) :: time
logical :: leap_year
-character(len=129) :: errstring
-
if ( .not. module_initialized ) call time_manager_init
select case(calendar_type)
@@ -2391,8 +2467,6 @@
type(time_type) :: length_of_year
-character(len=129) :: errstring
-
if ( .not. module_initialized ) call time_manager_init
select case(calendar_type)
@@ -2509,8 +2583,6 @@
type(time_type), intent(in) :: time
integer :: days_in_year
-character(len=129) :: errstring
-
if ( .not. module_initialized ) call time_manager_init
select case(calendar_type)
@@ -2636,8 +2708,6 @@
'July ','August ','September',&
'October ','November ','December '/)
-character(len=129) :: errstring
-
if ( .not. module_initialized ) call time_manager_init
if( n < 1 .or. n > 12 ) then
@@ -2864,7 +2934,7 @@
integer :: secs, days, io
character(len=32) :: fileformat
-character(len=129) :: errstring, filename
+character(len=129) :: filename
logical :: is_named
integer :: rc
More information about the Dart-dev
mailing list