[Dart-dev] [4376] DART/trunk/observations/gps/advance_time.f90: The source for the time utility was moved to the
nancy at ucar.edu
nancy at ucar.edu
Thu May 27 13:05:57 MDT 2010
Revision: 4376
Author: nancy
Date: 2010-05-27 13:05:57 -0600 (Thu, 27 May 2010)
Log Message:
-----------
The source for the time utility was moved to the
DART/time_manager directory quite a while ago.
This copy is not up to date, and is not used by
the build path_names files in the work directory.
Removed Paths:
-------------
DART/trunk/observations/gps/advance_time.f90
-------------- next part --------------
Deleted: DART/trunk/observations/gps/advance_time.f90
===================================================================
--- DART/trunk/observations/gps/advance_time.f90 2010-05-27 19:05:43 UTC (rev 4375)
+++ DART/trunk/observations/gps/advance_time.f90 2010-05-27 19:05:57 UTC (rev 4376)
@@ -1,424 +0,0 @@
-! DART software - Copyright \xA9 2004 - 2010 UCAR. This open source software is
-! provided by UCAR, "as is", without charge, subject to all terms of use at
-! http://www.image.ucar.edu/DAReS/DART/DART_download
-
-program advance_time
-
-! <next few lines under version control, do not edit>
-! $URL$
-! $Id$
-! $Revision$
-! $Date$
-
- ! modified from da_advance_cymdh,
- ! - has accuracy down to second,
- ! - can use day/hour/minute/second (with/without +/- sign) to advance time,
- ! - can digest various input date format if it still has the right order (ie. cc yy mm dd hh nn ss)
- ! - can digest flexible time increment
- ! - can output in wrf date format (ccyy-mm-dd_hh:nn:ss)
- ! - can specify output date format
- ! - can output Julian day
- ! - can output Gregorian days and seconds (since year 1601)
- !
- ! eg.: advance_time 20070730 12 # advance 12 h
- ! advance_time 2007073012 -1d2h30m30s # back 1 day 2 hours 30 minutes and 30 seconds
- ! advance_time 2007073012 1s-3h30m # back 3 hours 30 minutes less 1 second
- ! advance_time 200707301200 2d1s -w # advance 2 days and 1 second, output in wrf date format
- ! advance_time 2007-07-30_12:00:00 2d1s -w # same as previous example
- ! advance_time 200707301200 2d1s -f ccyy-mm-dd_hh:nn:ss # same as previous example
- ! advance_time 2007073006 120 -j # advance 120 h, and print year and Julian day
- ! advance_time 2007073006 120 -J # advance 120 h, print year, Julian day, hour, minute and second
- ! advance_time 2007073006 0 -g # print Gregorian day and second (since year 1601)
- !
-
- implicit none
-
-! NOTE: this block is required by some fortran compilers, but causes a fatal
-! error with others. (ibm xlf needs it; gfortran cannot have it; intel
-! ifort does not seem to care either way.) If you get a compiler error
-! building this program, comment the following 4 lines in or out and try again.
-!START BLOCK
- interface
- integer function iargc()
- end function iargc
- end interface
-!END BLOCK
-
- integer :: ccyy, mm, dd, hh, nn, ss, dday, dh, dn, ds, gday, gsec
-
- integer :: nargum, i, n, id, ih, in, is
-
- character(len=80), dimension(10) :: argum
-
- character(len=14) :: ccyymmddhhnnss
-
- character(len=80) :: out_date_format, dtime
-
- integer :: datelen
-
- character(len=1) :: ch
-
- integer, parameter :: stdout=6
-
- nargum=iargc()
-
- if ( nargum < 2 ) then
- write(unit=stdout, fmt='(a)') &
- 'Usage: advance_time ccyymmddhh[nnss] [+|-]dt[d|h|m|s] [-w|-W|-wrf|-WRF] [-f|-F date_format] [-j|-J] [-g|-G]'
- write(unit=stdout, fmt='(a)') &
- 'Option: -w|-W|-wrf|-WRF output in wrf date format as ccyy-mm-dd_hh:nn:ss'
- write(unit=stdout, fmt='(a)') &
- ' -f|-F specify output date format, such as ccyy-mm-dd_hh:nn:ss, or ''ccyy/mm/dd hh:nn:ss'''
- write(unit=stdout, fmt='(a)') &
- ' -j|-J print Julian day'
- write(unit=stdout, fmt='(a)') &
- ' -g|-G print Gregorian days and seconds (since year 1601)'
- write(unit=stdout, fmt='(a)') &
- 'Example: advance_time 20070730 12 # advance 12 h'
- write(unit=stdout, fmt='(a)') &
- ' advance_time 2007073012 -1d2h30m30s # back 1 day 2 hours 30 min and 30 sec'
- write(unit=stdout, fmt='(a)') &
- ' advance_time 2007073012 1s-3h30m # back 3 hours 30 minutes less 1 second'
- write(unit=stdout, fmt='(a)') &
- ' advance_time 200707301200 1d1s -w # advance 1 day 1 sec, output in wrf date format'
- write(unit=stdout, fmt='(a)') &
- ' advance_time 2007-07-30_12:00:00 2d1s -w # same as previous example'
- write(unit=stdout, fmt='(a)') &
- ' advance_time 200707301200 2d1s -f ccyy-mm-dd_hh:nn:ss # same as previous'
- write(unit=stdout, fmt='(a)') &
- ' advance_time 2007073006 120 -j # advance 120 h, and print year and Julian day'
- write(unit=stdout, fmt='(a)') &
- ' advance_time 2007073006 120 -J # advance 120 h, print year, Julian day, hour, minute and second'
- write(unit=stdout, fmt='(a)') &
- ' advance_time 2007073006 0 -g # print Gregorian day and second (since year 1601)'
- write(unit=stdout, fmt='(a)') ''
- stop 'try again.'
- end if
-
- do i=1,nargum
- do n=1,80
- argum(i)(n:n)=' '
- end do
- call getarg(i,argum(i))
- end do
-
- ccyymmddhhnnss = parsedate(argum(1))
- datelen = len_trim(ccyymmddhhnnss)
-
- if (datelen == 8) then
- read(ccyymmddhhnnss(1:10), fmt='(i4, 2i2)') ccyy, mm, dd
- hh = 0
- nn = 0
- ss = 0
- else if (datelen == 10) then
- read(ccyymmddhhnnss(1:10), fmt='(i4, 3i2)') ccyy, mm, dd, hh
- nn = 0
- ss = 0
- else if (datelen == 12) then
- read(ccyymmddhhnnss(1:12), fmt='(i4, 4i2)') ccyy, mm, dd, hh, nn
- ss = 0
- else if (datelen == 14) then
- read(ccyymmddhhnnss(1:14), fmt='(i4, 5i2)') ccyy, mm, dd, hh, nn, ss
- else
- stop 'wrong input date'
- endif
-
- if (.not. validdate(ccyy,mm,dd,hh,nn,ss)) then
- stop 'Start date is not valid, or has wrong format'
- endif
-
- i = 0
-
- dtime = trim(argum(2))
- call parsedt(dtime,dday,dh,dn,ds)
-
- hh = hh + dh
- nn = nn + dn
- ss = ss + ds
-
- ! advance minute according to second
- do while (ss < 0)
- ss = ss + 60
- nn = nn - 1
- end do
- do while (ss > 59)
- ss = ss - 60
- nn = nn + 1
- end do
-
- ! advance hour according to minute
- do while (nn < 0)
- nn = nn + 60
- hh = hh - 1
- end do
- do while (nn > 59)
- nn = nn - 60
- hh = hh + 1
- end do
-
- ! advance day according to hour
- do while (hh < 0)
- hh = hh + 24
- dday = dday - 1
- end do
-
- do while (hh > 23)
- hh = hh - 24
- dday = dday + 1
- end do
-
- ! advance day if dday /= 0
- if (dday /= 0) call change_date ( ccyy, mm, dd, dday)
-
- write(ccyymmddhhnnss(1:14), fmt='(i4, 5i2.2)') ccyy, mm, dd, hh, nn, ss
- if ( nargum == 2 ) then
- if (datelen<14) then
- if(nn /= 0) datelen=12
- if(ss /= 0) datelen=14
- endif
- write(unit=stdout, fmt='(a)') ccyymmddhhnnss(1:datelen)
- else if ( nargum > 2 ) then
- i = 3
- do while (i <= nargum)
- select case ( trim(argum(i)) )
- case ('-w', '-W', '-wrf','-WRF')
- out_date_format = 'ccyy-mm-dd_hh:nn:ss'
- write(unit=stdout, fmt='(a)') trim(formatdate(ccyymmddhhnnss, out_date_format))
- i = i+1
- case ('-f', '-F')
- out_date_format = trim(argum(i+1))
- write(unit=stdout, fmt='(a)') trim(formatdate(ccyymmddhhnnss, out_date_format))
- i = i+2
- case ('-j')
- write(unit=stdout, fmt='(I4,I4)') ccyy, julian_day(ccyy,mm,dd)
- i = i+1
- case ('-J')
- write(unit=stdout, fmt='(I4,I4,I3,I3,I3)') ccyy, julian_day(ccyy,mm,dd),hh,nn,ss
- i = i+1
- case ('-g','-G')
- call gregorian_day_sec(ccyy,mm,dd,hh,nn,ss,gday,gsec)
- write(unit=stdout, fmt='(I8,I8)') gday, gsec
- i = i+1
- case default
- i = i+1
- end select
- end do
- end if
-
-contains
-
-subroutine change_date( ccyy, mm, dd, delta )
-
- implicit none
-
- integer, intent(inout) :: ccyy, mm, dd
- integer, intent(in) :: delta
-
- integer, dimension(12) :: mmday
- integer :: dday, direction
-
- mmday = (/31,28,31,30,31,30,31,31,30,31,30,31/)
-
- mmday(2) = 28
-
- if (mod(ccyy,4) == 0) then
- mmday(2) = 29
-
- if (mod(ccyy,100) == 0) then
- mmday(2) = 28
- end if
-
- if (mod(ccyy,400) == 0) then
- mmday(2) = 29
- end if
- end if
-
- dday = abs(delta)
- direction = sign(1,delta)
-
- do while (dday > 0)
-
- dd = dd + direction
-
- if (dd == 0) then
- mm = mm - 1
-
- if (mm == 0) then
- mm = 12
- ccyy = ccyy - 1
- end if
-
- dd = mmday(mm)
- elseif ( dd > mmday(mm)) then
- dd = 1
- mm = mm + 1
- if(mm > 12 ) then
- mm = 1
- ccyy = ccyy + 1
- end if
- end if
-
- dday = dday - 1
-
- end do
- return
-end subroutine change_date
-
-
-function parsedate(datein)
- character(len=80) :: datein
- character(len=14) :: parsedate
- character(len=1 ) :: ch
- integer :: n, i
- parsedate = '00000000000000'
- i=0
- do n = 1, len_trim(datein)
- ch = datein(n:n)
- if (ch >= '0' .and. ch <= '9') then
- i=i+1
- parsedate(i:i)=ch
- end if
- end do
- if (parsedate(11:14) == '0000') then
- parsedate(11:14) = ''
- else if(parsedate(13:14) == '00') then
- parsedate(13:14) = ''
- end if
- return
-end function parsedate
-
-subroutine parsedt(dt,dday,dh,dn,ds)
- character(len=80) :: dt
- integer :: dday, dh, dn, ds
- character(len=1 ) :: ch
- integer :: n,i,d,s,nounit
- ! initialize time and sign
- nounit=1
- dday=0
- dh=0
- dn=0
- ds=0
- d=0
- s=1
- do n = 1, len_trim(dt)
- ch = dt(n:n)
- select case (ch)
- case ('0':'9')
- read(ch,fmt='(i1)') i
- d=d*10+i
- case ('-')
- s=-1
- case ('+')
- s=1
- case ('d')
- nounit=0
- dday=dday+d*s
- d=0
- case ('h')
- nounit=0
- dh=dh+d*s
- d=0
- case ('n','m')
- nounit=0
- dn=dn+d*s
- d=0
- case ('s')
- nounit=0
- ds=ds+d*s
- d=0
- case default
- end select
- end do
- if (nounit==1) dh=d*s
-end subroutine parsedt
-
-function formatdate(datein,dateform)
- character(len=14) :: datein
- character(len=80) :: dateform
- character(len=80) :: formatdate
- integer :: ic,iy,im,id,ih,in,is
- ic=index(dateform,'cc')
- iy=index(dateform,'yy')
- im=index(dateform,'mm')
- id=index(dateform,'dd')
- ih=index(dateform,'hh')
- in=index(dateform,'nn')
- is=index(dateform,'ss')
- formatdate=trim(dateform)
- if (ic /= 0) formatdate(ic:ic+1) = datein(1:2)
- if (iy /= 0) formatdate(iy:iy+1) = datein(3:4)
- if (im /= 0) formatdate(im:im+1) = datein(5:6)
- if (id /= 0) formatdate(id:id+1) = datein(7:8)
- if (ih /= 0) formatdate(ih:ih+1) = datein(9:10)
- if (in /= 0) formatdate(in:in+1) = datein(11:12)
- if (is /= 0) formatdate(is:is+1) = datein(13:14)
- return
-end function formatdate
-
-function julian_day(ccyy,mm,dd)
- integer :: ccyy,mm,dd
- integer :: julian_day
- integer, parameter, dimension( 13) :: &
- bgn_day = (/ 0, 31, 59, 90, 120, 151, &
- 181, 212, 243, 273, 304, 334, 365 /), &
- bgn_day_ly = (/ 0, 31, 60, 91, 121, 152, &
- 182, 213, 244, 274, 305, 335, 366 /)
- if (isleapyear(ccyy)) then
- julian_day = bgn_day_ly(mm)+dd
- else
- julian_day = bgn_day(mm)+dd
- end if
-end function julian_day
-
-function isleapyear(year)
- ! check if year is leapyear
- integer,intent(in) :: year
- logical :: isleapyear
- if( mod(year,4) .ne. 0 ) then
- isleapyear=.FALSE.
- else
- isleapyear=.TRUE.
- if ( mod(year,100) == 0 .and. mod(year,400) .ne. 0 ) isleapyear=.FALSE.
- endif
-end function isleapyear
-
-subroutine gregorian_day_sec(year,month,day,hours,minutes,seconds,gday,gsec)
- integer :: day, month, year, hours, minutes, seconds
- integer :: gday, gsec
- integer :: ndays, m, nleapyr
- integer :: base_year = 1601
- integer :: days_per_month(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/)
-
- if( year < base_year ) stop "Year can not be before 1601!"
-
- ! compute number of leap years fully past since base_year
- nleapyr = (year - base_year) / 4 - (year - base_year) / 100 + (year - base_year) / 400
- ! Count up days in this year
- ndays = 0
- do m=1,month-1
- ndays = ndays + days_per_month(m)
- if(isleapyear(year) .and. m == 2) ndays = ndays + 1
- enddo
- gsec = seconds + 60*(minutes + 60*hours)
- gday = day - 1 + ndays + 365*(year - base_year - nleapyr) + 366*(nleapyr)
- return
-end subroutine gregorian_day_sec
-
-function validdate(ccyy,mm,dd,hh,nn,ss)
- integer :: ccyy,mm,dd,hh,nn,ss
- logical :: validdate
-
- validdate = .true.
-
- if(ss > 59 .or. ss < 0 .or. &
- nn > 59 .or. nn < 0 .or. &
- hh > 23 .or. hh < 0 .or. &
- dd < 1 .or. &
- mm > 12 .or. mm < 1 ) validdate = .false.
-
- if (mm == 2 .and. ( dd > 29 .or. &
- ((.not. isleapyear(ccyy)) .and. dd > 28))) &
- validdate = .false.
-end function validdate
-
-end program advance_time
More information about the Dart-dev
mailing list