time_setdoy.f

Go to the documentation of this file.

c this is <time_setdoy.f> (extracted from ../libtime.f)
c automatically generated by "SPLITF.PL   V1.0   SPLIT Fortran source code"
c----------------------------------------------------------------------
c
c Copyright 2000 by Thomas Forbriger (IfG Stuttgart)
c
c ----
c libtime is free software; you can redistribute it and/or modify
c it under the terms of the GNU General Public License as published by
c the Free Software Foundation; either version 2 of the License, or
c (at your option) any later version. 
c 
c This program is distributed in the hope that it will be useful,
c but WITHOUT ANY WARRANTY; without even the implied warranty of
c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
c GNU General Public License for more details.
c 
c You should have received a copy of the GNU General Public License
c along with this program; if not, write to the Free Software
c Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
c ----
c
c set doy index from given day and month index
c
c REVISIONS and CHANGES
c    05/08/2000   V1.0   Thomas Forbriger
c                 V2.0   call language specific warning handler
c    25/12/2012   V2.1   provide more details upon abort
c
c ============================================================================
cS
      subroutine time_setdoy(day, month, date)
c 
c Set doy in date from day and month (january first is doy 1).
c This routine will call time_fullyear first!
c 
c This routine is senseless in combination with relative times!
c
c input:
c   day:    day index within month
c   month:  month index within year (contained in date)
c input/output:
c   date:   doy index in time record is changed according to given day and
c           month index and year value in date
c
c last change: V2.10 (25/12/2012)
c
      integer day, month, date(7)
cE
      integer result
      integer sel, mon
      logical time_isleapyear
      integer days(12,2)
      data days/31,28,31,30,31,30,31,31,30,31,30,31,
     &          31,29,31,30,31,30,31,31,30,31,30,31/
c 
      if (date(1).eq.0) then
        call time_util_warning('time_setdoy',
     &                         'do not use this with relative times')
        call time_util_warning('time_setdoy',
     &                         'routine skipped...')
      else
        call time_fullyear(date(1))
        if (time_isleapyear(date(1))) then
          sel=2
        else
          sel=1
        endif
        result=0
        mon=1
    1   if (mon.ge.month) goto 2
          result=result+days(mon,sel)
          mon=mon+1
          if (mon.gt.13) then
            call time_util_warning_report_time('time_setdoy',
     &                                         date)
            call time_util_warning_n('time_setdoy',
     &                               'month value',month)
            call time_util_fatal('time_setdoy',
     &                           'month value out of range')
          endif
          goto 1
    2   continue
        result=result+day
        date(2)=result
      endif
      return
      end
c
c ----- END OF <time_setdoy.f> -----