utils_mod.f90

Go to the documentation of this file.

module utils_mod
 
! adapated from WRFDA/var/da/da_tools/da_advance_time.inc
 
implicit none
private
public :: da_advance_time
 
contains
 
subroutine da_advance_time (date_in, dtime, date_out)
 
   ! HISTORY: 11/17/2008 modified and simplified from da_util/da_advance_time.f90
   !
   !   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 
   !
   !   eg.: da_advance_time 20070730      12             # advance 12 h 
   !        da_advance_time 2007073012   -1d2h30m30s     # back 1 day 2 hours 30 minutes and 30 seconds
   !        da_advance_time 2007073012    1s-3h30m       # back 3 hours 30 minutes less 1 second
   !
 
   implicit none
 
   character(len=*),  intent(in)            :: date_in, dtime
   character(len=14), intent(out)           :: date_out
  
   integer :: ccyy, mm, dd, hh, nn, ss, dday, dh, dn, ds, gday, gsec
   integer :: i, n
   character(len=14) :: ccyymmddhhnnss
   integer :: datelen
 
   ccyymmddhhnnss = parsedate(date_in)
   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
      write(0,*) trim(ccyymmddhhnnss)
      stop 'Start date is not valid, or has wrong format'
   endif
 
   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 (datelen<14) then
   !   if(nn /= 0) datelen=12
   !   if(ss /= 0) datelen=14
   !endif
   date_out = ccyymmddhhnnss
 
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=*), intent(in) :: 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=*),  intent(in)    :: dt
   integer,           intent(inout) :: 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 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
 
function validdate(ccyy,mm,dd,hh,nn,ss)
   integer, intent(in) :: 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 subroutine da_advance_time
 
end module utils_mod