WebSVN – lagranto.um – Diff – /tags/1.0/lib/times.f


c     **************************************************************************
c     * This library provides subroutines related to time and file name        *
c     * handling                                                               *
c     *                                                                        *
c     **************************************************************************
 
c     ---------------------------------------------------------------------------
c     Concatenate a date string
c     ---------------------------------------------------------------------------
 
      subroutine datestring(datestr,yyyy,mm,dd,hh)
 
c     Declaration of subroutine parameters
      integer yyyy,mm,dd,hh
      character*20 datestr
 
c     Auxiliary parameters
      integer f1,f2,i0
      integer yy,ce
 
      i0=ichar('0')
      datestr=''
 
      yy=mod(yyyy,100)
      ce=int(yyyy/100)
 
      if ((ce.ne.19).and.(ce.ne.20)) then
         print*,'Invalid year... Stop'
         stop
      endif
 
      if (yy.ge.0) then
         f1=yy/10
         f2=mod(yy,10)
         if (ce.eq.19) then
            datestr=trim(datestr)//'19'//char(f1+i0)//char(f2+i0)
         else if (ce.eq.20) then
            datestr=trim(datestr)//'20'//char(f1+i0)//char(f2+i0)
         endif
      endif
      if (mm.gt.0) then
         f1=mm/10
         f2=mod(mm,10)
         datestr=trim(datestr)//char(f1+i0)//char(f2+i0)
      endif
 
      if (dd.gt.0) then
         f1=dd/10
         f2=mod(dd,10)
         datestr=trim(datestr)//char(f1+i0)//char(f2+i0)
      endif
 
      if (hh.ge.0) then
         f1=hh/10
         f2=mod(hh,10)
         datestr=trim(datestr)//'_'//char(f1+i0)//char(f2+i0)
      endif
 
      return
      end
 
 
c     ---------------------------------------------------------------------------
c     Calculates the new date when diff (in hours) is added to date1.
c     ---------------------------------------------------------------------------
 
      subroutine newdate(date1,diff,date2)
C
C     date1	int	input	array contains a date in the form
C				year,month,day,hour,step
C     diff	real	input	timestep in hours to go from date1
C     date2	int	output	array contains new date in the same form
 
      integer   date1(5),date2(5)
      integer   idays(12)       ! array containing the days of the monthes
      real	diff
      logical	yearchange
 
      data idays/31,28,31,30,31,30,31,31,30,31,30,31/
 
      yearchange=.false.
 
      if ((mod(date1(1),4).eq.0).and.(date1(2).le.2)) idays(2)=29
 
      date2(1)=date1(1)
      date2(2)=date1(2)
      date2(3)=date1(3)
      date2(4)=date1(4)
      date2(5)=0
      date2(4)=date1(4)+int(diff)+date1(5)
 
      if (date2(4).ge.24) then
        date2(3)=date2(3)+int(date2(4)/24)
        date2(4)=date2(4)-int(date2(4)/24)*24
      endif
      if (date2(4).lt.0) then
        if (mod(date2(4),24).eq.0) then
          date2(3)=date2(3)-int(abs(date2(4))/24)
          date2(4)=date2(4)+int(abs(date2(4))/24)*24
        else
          date2(3)=date2(3)-(1+int(abs(date2(4))/24))
          date2(4)=date2(4)+(1+int(abs(date2(4))/24))*24
        endif
      endif
 
  100 if (date2(3).gt.idays(date2(2))) then
        if ((date2(2).eq.2).and.(mod(date2(1),4).eq.0)) idays(2)=29
        date2(3)=date2(3)-idays(date2(2))
        if (idays(2).eq.29) idays(2)=28
        date2(2)=date2(2)+1
        if (date2(2).gt.12) then
*         date2(1)=date2(1)+int(date2(2)/12)
*         date2(2)=date2(2)-int(date2(2)/12)*12
          date2(1)=date2(1)+1
          date2(2)=date2(2)-12
        endif
        if (date2(2).lt.1) then
          date2(1)=date2(1)-(1+int(abs(date2(2)/12)))
          date2(2)=date2(2)+(1+int(abs(date2(2)/12)))*12
        endif
        goto 100
      endif     
  200 if (date2(3).lt.1) then
        date2(2)=date2(2)-1
        if (date2(2).gt.12) then
          date2(1)=date2(1)+int(date2(2)/12)
          date2(2)=date2(2)-int(date2(2)/12)*12
        endif
        if (date2(2).lt.1) then
          date2(1)=date2(1)-(1+int(abs(date2(2)/12)))
          date2(2)=date2(2)+(1+int(abs(date2(2)/12)))*12
        endif
        if ((date2(2).eq.2).and.(mod(date2(1),4).eq.0)) idays(2)=29
        date2(3)=date2(3)+idays(date2(2))
        if (idays(2).eq.29) idays(2)=28
        goto 200
      endif
 
      if (date2(2).gt.12) then
        date2(1)=date2(1)+int(date2(2)/12)
        date2(2)=date2(2)-int(date2(2)/12)*12
      endif
      if (date2(2).lt.1) then
        date2(1)=date2(1)-(1+int(abs(date2(2)/12)))
        date2(2)=date2(2)+(1+int(abs(date2(2)/12)))*12
      endif
 
      if (date2(1).lt.1000) then
      if (date2(1).ge.100) date2(1)=date2(1)-100
      endif
 
      return
      end
 
c     ---------------------------------------------------------------------------
c     Convert <hh.mm> -> <frac> and <frac> -> <hhmm>
c     ---------------------------------------------------------------------------
 
      subroutine hhmm2frac (hhmm,frac)
 
      real hhmm
      real frac
      
      frac=real(int(hhmm))+
     >     100.*(hhmm-real(int(hhmm)))/60.
 
      end
 
 
      subroutine frac2hhmm (frac,hhmm)
 
      real hhmm
      real frac
 
      real hh,mm
      
      hh =  real(int(frac))
      mm =  60. * (frac-real(int(frac)))
 
      hhmm = hh + 0.01 * mm
 
      end
 
c     ---------------------------------------------------------------------------
c     Time difference between two dates
c     ---------------------------------------------------------------------------
 
      subroutine timediff(date1,date2,diff)
 
C     New version with hour and minutes! (for hour and step [in hours]
C     use the routine oldtimediff!)
C
C     Calculates the time difference in hours (and minutes) for the two
C     dates specified by the two arrays date1 and date2.
C     They are expected to contain the following date information:
C     year      month   day     hour    minute.
C
C     date1     array specifying the first date
C     date2     array specifying the second date
C     diff      time differenc between date1 and date2 in hours
C
 
      integer   date1(5),date2(5)
      integer   idays(12)       ! array containing the days of the monthes
      real      diff
      integer   ixday,imdiff,ihdiff,iddiff,j
      integer   yy,yy1,yy2
 
      idays(1)=31
      idays(2)=28
      idays(3)=31
      idays(4)=30
      idays(5)=31
      idays(6)=30
      idays(7)=31
      idays(8)=31
      idays(9)=30
      idays(10)=31
      idays(11)=30
      idays(12)=31
 
C     Check format of year (YYYY or YY - in case of YY assume 19YY)
 
      if (date1(1).lt.100) date1(1)=1900+date1(1)
      if (date2(1).lt.100) date2(1)=1900+date2(1)
 
C     Determine if the period between date1 and date2 contains a Feb.29
 
      ixday=0   ! extra day flag
 
      yy1=min(date1(1),date2(1))
      yy2=max(date1(1),date2(1))
      if (yy1.eq.yy2) then
        if (mod(yy1,4).eq.0) then
          idays(2)=29
        endif
      else
        if (mod(yy1,4).eq.0) then
          if (((yy1.eq.date1(1)).and.(date1(2).le.2)).or.
     >        ((yy1.eq.date2(1)).and.(date2(2).le.2))) then
            ixday=ixday+1
          endif
        endif
        if (mod(yy2,4).eq.0) then
          if (((yy2.eq.date1(1)).and.(date1(2).gt.2)).or.
     >        ((yy2.eq.date2(1)).and.(date2(2).gt.2))) then
            ixday=ixday+1
          endif
        endif
        if (yy2-yy1.gt.1) then
          do yy=yy1+1,yy2-1
            if (mod(yy,4).eq.0) then
              ixday=ixday+1
            endif
          enddo
        endif
      endif
 
      ihdiff=0  ! diff. in hours between date1/date2
      iddiff=0  ! diff. in days  between date1/date2
 
      if (date1(1).gt.date2(1)) then            ! compare years
        do j=date2(1),date1(1)-1
          iddiff=iddiff+365
        enddo
        iddiff=iddiff+ixday
      else if (date1(1).lt.date2(1)) then
        do j=date1(1),date2(1)-1
          iddiff=iddiff-365
        enddo
        iddiff=iddiff-ixday
      endif
 
      if (date1(2).gt.date2(2)) then            ! compare monthes
        do j=date2(2),date1(2)-1
          iddiff=iddiff+idays(j)
        enddo
      else if (date1(2).lt.date2(2)) then
        do j=date1(2),date2(2)-1
          iddiff=iddiff-idays(j)
        enddo
      endif
 
      iddiff=iddiff+date1(3)-date2(3)
      ihdiff=iddiff*24+date1(4)-date2(4)
      imdiff=ihdiff*60+date1(5)-date2(5)
 
      ihdiff=imdiff/60
      imdiff=mod(imdiff,60)
 
      diff=real(ihdiff)+real(imdiff)/100.
 
      return
      end

Rev 3	Rev 4
1	`c **************************************************************************`	1	`c **************************************************************************`
2	`c * This library provides subroutines related to time and file name *`	2	`c * This library provides subroutines related to time and file name *`
3	`c * handling *`	3	`c * handling *`
4	`c * *`	4	`c * *`
5	`c **************************************************************************`	5	`c **************************************************************************`
6		6
7	`c ---------------------------------------------------------------------------`	7	`c ---------------------------------------------------------------------------`
8	`c Concatenate a date string`	8	`c Concatenate a date string`
9	`c ---------------------------------------------------------------------------`	9	`c ---------------------------------------------------------------------------`
10		10
11	`subroutine datestring(datestr,yyyy,mm,dd,hh)`	11	`subroutine datestring(datestr,yyyy,mm,dd,hh)`
12		12
13	`c Declaration of subroutine parameters`	13	`c Declaration of subroutine parameters`
14	`integer yyyy,mm,dd,hh`	14	`integer yyyy,mm,dd,hh`
15	`character*20 datestr`	15	`character*20 datestr`
16		16
17	`c Auxiliary parameters`	17	`c Auxiliary parameters`
18	`integer f1,f2,i0`	18	`integer f1,f2,i0`
19	`integer yy,ce`	19	`integer yy,ce`
20		20
21	`i0=ichar('0')`	21	`i0=ichar('0')`
22	`datestr=''`	22	`datestr=''`
23		23
24	`yy=mod(yyyy,100)`	24	`yy=mod(yyyy,100)`
25	`ce=int(yyyy/100)`	25	`ce=int(yyyy/100)`
26		26
27	`if ((ce.ne.19).and.(ce.ne.20)) then`	27	`if ((ce.ne.19).and.(ce.ne.20)) then`
28	`print*,'Invalid year... Stop'`	28	`print*,'Invalid year... Stop'`
29	`stop`	29	`stop`
30	`endif`	30	`endif`
31		31
32	`if (yy.ge.0) then`	32	`if (yy.ge.0) then`
33	`f1=yy/10`	33	`f1=yy/10`
34	`f2=mod(yy,10)`	34	`f2=mod(yy,10)`
35	`if (ce.eq.19) then`	35	`if (ce.eq.19) then`
36	`datestr=trim(datestr)//'19'//char(f1+i0)//char(f2+i0)`	36	`datestr=trim(datestr)//'19'//char(f1+i0)//char(f2+i0)`
37	`else if (ce.eq.20) then`	37	`else if (ce.eq.20) then`
38	`datestr=trim(datestr)//'20'//char(f1+i0)//char(f2+i0)`	38	`datestr=trim(datestr)//'20'//char(f1+i0)//char(f2+i0)`
39	`endif`	39	`endif`
40	`endif`	40	`endif`
41	`if (mm.gt.0) then`	41	`if (mm.gt.0) then`
42	`f1=mm/10`	42	`f1=mm/10`
43	`f2=mod(mm,10)`	43	`f2=mod(mm,10)`
44	`datestr=trim(datestr)//char(f1+i0)//char(f2+i0)`	44	`datestr=trim(datestr)//char(f1+i0)//char(f2+i0)`
45	`endif`	45	`endif`
46		46
47	`if (dd.gt.0) then`	47	`if (dd.gt.0) then`
48	`f1=dd/10`	48	`f1=dd/10`
49	`f2=mod(dd,10)`	49	`f2=mod(dd,10)`
50	`datestr=trim(datestr)//char(f1+i0)//char(f2+i0)`	50	`datestr=trim(datestr)//char(f1+i0)//char(f2+i0)`
51	`endif`	51	`endif`
52		52
53	`if (hh.ge.0) then`	53	`if (hh.ge.0) then`
54	`f1=hh/10`	54	`f1=hh/10`
55	`f2=mod(hh,10)`	55	`f2=mod(hh,10)`
56	`datestr=trim(datestr)//'_'//char(f1+i0)//char(f2+i0)`	56	`datestr=trim(datestr)//'_'//char(f1+i0)//char(f2+i0)`
57	`endif`	57	`endif`
58		58
59	`return`	59	`return`
60	`end`	60	`end`
61		61
62		62
63	`c ---------------------------------------------------------------------------`	63	`c ---------------------------------------------------------------------------`
64	`c Calculates the new date when diff (in hours) is added to date1.`	64	`c Calculates the new date when diff (in hours) is added to date1.`
65	`c ---------------------------------------------------------------------------`	65	`c ---------------------------------------------------------------------------`
66		66
67	`subroutine newdate(date1,diff,date2)`	67	`subroutine newdate(date1,diff,date2)`
68	`C`	68	`C`
69	`C date1 int input array contains a date in the form`	69	`C date1 int input array contains a date in the form`
70	`C year,month,day,hour,step`	70	`C year,month,day,hour,step`
71	`C diff real input timestep in hours to go from date1`	71	`C diff real input timestep in hours to go from date1`
72	`C date2 int output array contains new date in the same form`	72	`C date2 int output array contains new date in the same form`
73		73
74	`integer date1(5),date2(5)`	74	`integer date1(5),date2(5)`
75	`integer idays(12) ! array containing the days of the monthes`	75	`integer idays(12) ! array containing the days of the monthes`
76	`real diff`	76	`real diff`
77	`logical yearchange`	77	`logical yearchange`
78		78
79	`data idays/31,28,31,30,31,30,31,31,30,31,30,31/`	79	`data idays/31,28,31,30,31,30,31,31,30,31,30,31/`
80		80
81	`yearchange=.false.`	81	`yearchange=.false.`
82		82
83	`if ((mod(date1(1),4).eq.0).and.(date1(2).le.2)) idays(2)=29`	83	`if ((mod(date1(1),4).eq.0).and.(date1(2).le.2)) idays(2)=29`
84		84
85	`date2(1)=date1(1)`	85	`date2(1)=date1(1)`
86	`date2(2)=date1(2)`	86	`date2(2)=date1(2)`
87	`date2(3)=date1(3)`	87	`date2(3)=date1(3)`
88	`date2(4)=date1(4)`	88	`date2(4)=date1(4)`
89	`date2(5)=0`	89	`date2(5)=0`
90	`date2(4)=date1(4)+int(diff)+date1(5)`	90	`date2(4)=date1(4)+int(diff)+date1(5)`
91		91
92	`if (date2(4).ge.24) then`	92	`if (date2(4).ge.24) then`
93	`date2(3)=date2(3)+int(date2(4)/24)`	93	`date2(3)=date2(3)+int(date2(4)/24)`
94	`date2(4)=date2(4)-int(date2(4)/24)*24`	94	`date2(4)=date2(4)-int(date2(4)/24)*24`
95	`endif`	95	`endif`
96	`if (date2(4).lt.0) then`	96	`if (date2(4).lt.0) then`
97	`if (mod(date2(4),24).eq.0) then`	97	`if (mod(date2(4),24).eq.0) then`
98	`date2(3)=date2(3)-int(abs(date2(4))/24)`	98	`date2(3)=date2(3)-int(abs(date2(4))/24)`
99	`date2(4)=date2(4)+int(abs(date2(4))/24)*24`	99	`date2(4)=date2(4)+int(abs(date2(4))/24)*24`
100	`else`	100	`else`
101	`date2(3)=date2(3)-(1+int(abs(date2(4))/24))`	101	`date2(3)=date2(3)-(1+int(abs(date2(4))/24))`
102	`date2(4)=date2(4)+(1+int(abs(date2(4))/24))*24`	102	`date2(4)=date2(4)+(1+int(abs(date2(4))/24))*24`
103	`endif`	103	`endif`
104	`endif`	104	`endif`
105		105
106	`100 if (date2(3).gt.idays(date2(2))) then`	106	`100 if (date2(3).gt.idays(date2(2))) then`
107	`if ((date2(2).eq.2).and.(mod(date2(1),4).eq.0)) idays(2)=29`	107	`if ((date2(2).eq.2).and.(mod(date2(1),4).eq.0)) idays(2)=29`
108	`date2(3)=date2(3)-idays(date2(2))`	108	`date2(3)=date2(3)-idays(date2(2))`
109	`if (idays(2).eq.29) idays(2)=28`	109	`if (idays(2).eq.29) idays(2)=28`
110	`date2(2)=date2(2)+1`	110	`date2(2)=date2(2)+1`
111	`if (date2(2).gt.12) then`	111	`if (date2(2).gt.12) then`
112	`* date2(1)=date2(1)+int(date2(2)/12)`	112	`* date2(1)=date2(1)+int(date2(2)/12)`
113	`* date2(2)=date2(2)-int(date2(2)/12)*12`	113	`* date2(2)=date2(2)-int(date2(2)/12)*12`
114	`date2(1)=date2(1)+1`	114	`date2(1)=date2(1)+1`
115	`date2(2)=date2(2)-12`	115	`date2(2)=date2(2)-12`
116	`endif`	116	`endif`
117	`if (date2(2).lt.1) then`	117	`if (date2(2).lt.1) then`
118	`date2(1)=date2(1)-(1+int(abs(date2(2)/12)))`	118	`date2(1)=date2(1)-(1+int(abs(date2(2)/12)))`
119	`date2(2)=date2(2)+(1+int(abs(date2(2)/12)))*12`	119	`date2(2)=date2(2)+(1+int(abs(date2(2)/12)))*12`
120	`endif`	120	`endif`
121	`goto 100`	121	`goto 100`
122	`endif`	122	`endif`
123	`200 if (date2(3).lt.1) then`	123	`200 if (date2(3).lt.1) then`
124	`date2(2)=date2(2)-1`	124	`date2(2)=date2(2)-1`
125	`if (date2(2).gt.12) then`	125	`if (date2(2).gt.12) then`
126	`date2(1)=date2(1)+int(date2(2)/12)`	126	`date2(1)=date2(1)+int(date2(2)/12)`
127	`date2(2)=date2(2)-int(date2(2)/12)*12`	127	`date2(2)=date2(2)-int(date2(2)/12)*12`
128	`endif`	128	`endif`
129	`if (date2(2).lt.1) then`	129	`if (date2(2).lt.1) then`
130	`date2(1)=date2(1)-(1+int(abs(date2(2)/12)))`	130	`date2(1)=date2(1)-(1+int(abs(date2(2)/12)))`
131	`date2(2)=date2(2)+(1+int(abs(date2(2)/12)))*12`	131	`date2(2)=date2(2)+(1+int(abs(date2(2)/12)))*12`
132	`endif`	132	`endif`
133	`if ((date2(2).eq.2).and.(mod(date2(1),4).eq.0)) idays(2)=29`	133	`if ((date2(2).eq.2).and.(mod(date2(1),4).eq.0)) idays(2)=29`
134	`date2(3)=date2(3)+idays(date2(2))`	134	`date2(3)=date2(3)+idays(date2(2))`
135	`if (idays(2).eq.29) idays(2)=28`	135	`if (idays(2).eq.29) idays(2)=28`
136	`goto 200`	136	`goto 200`
137	`endif`	137	`endif`
138		138
139	`if (date2(2).gt.12) then`	139	`if (date2(2).gt.12) then`
140	`date2(1)=date2(1)+int(date2(2)/12)`	140	`date2(1)=date2(1)+int(date2(2)/12)`
141	`date2(2)=date2(2)-int(date2(2)/12)*12`	141	`date2(2)=date2(2)-int(date2(2)/12)*12`
142	`endif`	142	`endif`
143	`if (date2(2).lt.1) then`	143	`if (date2(2).lt.1) then`
144	`date2(1)=date2(1)-(1+int(abs(date2(2)/12)))`	144	`date2(1)=date2(1)-(1+int(abs(date2(2)/12)))`
145	`date2(2)=date2(2)+(1+int(abs(date2(2)/12)))*12`	145	`date2(2)=date2(2)+(1+int(abs(date2(2)/12)))*12`
146	`endif`	146	`endif`
147		147
148	`if (date2(1).lt.1000) then`	148	`if (date2(1).lt.1000) then`
149	`if (date2(1).ge.100) date2(1)=date2(1)-100`	149	`if (date2(1).ge.100) date2(1)=date2(1)-100`
150	`endif`	150	`endif`
151		151
152	`return`	152	`return`
153	`end`	153	`end`
154		154
155	`c ---------------------------------------------------------------------------`	155	`c ---------------------------------------------------------------------------`
156	`c Convert <hh.mm> -> <frac> and <frac> -> <hhmm>`	156	`c Convert <hh.mm> -> <frac> and <frac> -> <hhmm>`
157	`c ---------------------------------------------------------------------------`	157	`c ---------------------------------------------------------------------------`
158		158
159	`subroutine hhmm2frac (hhmm,frac)`	159	`subroutine hhmm2frac (hhmm,frac)`
160		160
161	`real hhmm`	161	`real hhmm`
162	`real frac`	162	`real frac`
163		163
164	`frac=real(int(hhmm))+`	164	`frac=real(int(hhmm))+`
165	`> 100.*(hhmm-real(int(hhmm)))/60.`	165	`> 100.*(hhmm-real(int(hhmm)))/60.`
166		166
167	`end`	167	`end`
168		168
169		169
170	`subroutine frac2hhmm (frac,hhmm)`	170	`subroutine frac2hhmm (frac,hhmm)`
171		171
172	`real hhmm`	172	`real hhmm`
173	`real frac`	173	`real frac`
174		174
175	`real hh,mm`	175	`real hh,mm`
176		176
177	`hh = real(int(frac))`	177	`hh = real(int(frac))`
178	`mm = 60. * (frac-real(int(frac)))`	178	`mm = 60. * (frac-real(int(frac)))`
179		179
180	`hhmm = hh + 0.01 * mm`	180	`hhmm = hh + 0.01 * mm`
181		181
182	`end`	182	`end`
183		183
184	`c ---------------------------------------------------------------------------`	184	`c ---------------------------------------------------------------------------`
185	`c Time difference between two dates`	185	`c Time difference between two dates`
186	`c ---------------------------------------------------------------------------`	186	`c ---------------------------------------------------------------------------`
187		187
188	`subroutine timediff(date1,date2,diff)`	188	`subroutine timediff(date1,date2,diff)`
189		189
190	`C New version with hour and minutes! (for hour and step [in hours]`	190	`C New version with hour and minutes! (for hour and step [in hours]`
191	`C use the routine oldtimediff!)`	191	`C use the routine oldtimediff!)`
192	`C`	192	`C`
193	`C Calculates the time difference in hours (and minutes) for the two`	193	`C Calculates the time difference in hours (and minutes) for the two`
194	`C dates specified by the two arrays date1 and date2.`	194	`C dates specified by the two arrays date1 and date2.`
195	`C They are expected to contain the following date information:`	195	`C They are expected to contain the following date information:`
196	`C year month day hour minute.`	196	`C year month day hour minute.`
197	`C`	197	`C`
198	`C date1 array specifying the first date`	198	`C date1 array specifying the first date`
199	`C date2 array specifying the second date`	199	`C date2 array specifying the second date`
200	`C diff time differenc between date1 and date2 in hours`	200	`C diff time differenc between date1 and date2 in hours`
201	`C`	201	`C`
202		202
203	`integer date1(5),date2(5)`	203	`integer date1(5),date2(5)`
204	`integer idays(12) ! array containing the days of the monthes`	204	`integer idays(12) ! array containing the days of the monthes`
205	`real diff`	205	`real diff`
206	`integer ixday,imdiff,ihdiff,iddiff,j`	206	`integer ixday,imdiff,ihdiff,iddiff,j`
207	`integer yy,yy1,yy2`	207	`integer yy,yy1,yy2`
208		208
209	`idays(1)=31`	209	`idays(1)=31`
210	`idays(2)=28`	210	`idays(2)=28`
211	`idays(3)=31`	211	`idays(3)=31`
212	`idays(4)=30`	212	`idays(4)=30`
213	`idays(5)=31`	213	`idays(5)=31`
214	`idays(6)=30`	214	`idays(6)=30`
215	`idays(7)=31`	215	`idays(7)=31`
216	`idays(8)=31`	216	`idays(8)=31`
217	`idays(9)=30`	217	`idays(9)=30`
218	`idays(10)=31`	218	`idays(10)=31`
219	`idays(11)=30`	219	`idays(11)=30`
220	`idays(12)=31`	220	`idays(12)=31`
221		221
222	`C Check format of year (YYYY or YY - in case of YY assume 19YY)`	222	`C Check format of year (YYYY or YY - in case of YY assume 19YY)`
223		223
224	`if (date1(1).lt.100) date1(1)=1900+date1(1)`	224	`if (date1(1).lt.100) date1(1)=1900+date1(1)`
225	`if (date2(1).lt.100) date2(1)=1900+date2(1)`	225	`if (date2(1).lt.100) date2(1)=1900+date2(1)`
226		226
227	`C Determine if the period between date1 and date2 contains a Feb.29`	227	`C Determine if the period between date1 and date2 contains a Feb.29`
228		228
229	`ixday=0 ! extra day flag`	229	`ixday=0 ! extra day flag`
230		230
231	`yy1=min(date1(1),date2(1))`	231	`yy1=min(date1(1),date2(1))`
232	`yy2=max(date1(1),date2(1))`	232	`yy2=max(date1(1),date2(1))`
233	`if (yy1.eq.yy2) then`	233	`if (yy1.eq.yy2) then`
234	`if (mod(yy1,4).eq.0) then`	234	`if (mod(yy1,4).eq.0) then`
235	`idays(2)=29`	235	`idays(2)=29`
236	`endif`	236	`endif`
237	`else`	237	`else`
238	`if (mod(yy1,4).eq.0) then`	238	`if (mod(yy1,4).eq.0) then`
239	`if (((yy1.eq.date1(1)).and.(date1(2).le.2)).or.`	239	`if (((yy1.eq.date1(1)).and.(date1(2).le.2)).or.`
240	`> ((yy1.eq.date2(1)).and.(date2(2).le.2))) then`	240	`> ((yy1.eq.date2(1)).and.(date2(2).le.2))) then`
241	`ixday=ixday+1`	241	`ixday=ixday+1`
242	`endif`	242	`endif`
243	`endif`	243	`endif`
244	`if (mod(yy2,4).eq.0) then`	244	`if (mod(yy2,4).eq.0) then`
245	`if (((yy2.eq.date1(1)).and.(date1(2).gt.2)).or.`	245	`if (((yy2.eq.date1(1)).and.(date1(2).gt.2)).or.`
246	`> ((yy2.eq.date2(1)).and.(date2(2).gt.2))) then`	246	`> ((yy2.eq.date2(1)).and.(date2(2).gt.2))) then`
247	`ixday=ixday+1`	247	`ixday=ixday+1`
248	`endif`	248	`endif`
249	`endif`	249	`endif`
250	`if (yy2-yy1.gt.1) then`	250	`if (yy2-yy1.gt.1) then`
251	`do yy=yy1+1,yy2-1`	251	`do yy=yy1+1,yy2-1`
252	`if (mod(yy,4).eq.0) then`	252	`if (mod(yy,4).eq.0) then`
253	`ixday=ixday+1`	253	`ixday=ixday+1`
254	`endif`	254	`endif`
255	`enddo`	255	`enddo`
256	`endif`	256	`endif`
257	`endif`	257	`endif`
258		258
259	`ihdiff=0 ! diff. in hours between date1/date2`	259	`ihdiff=0 ! diff. in hours between date1/date2`
260	`iddiff=0 ! diff. in days between date1/date2`	260	`iddiff=0 ! diff. in days between date1/date2`
261		261
262	`if (date1(1).gt.date2(1)) then ! compare years`	262	`if (date1(1).gt.date2(1)) then ! compare years`
263	`do j=date2(1),date1(1)-1`	263	`do j=date2(1),date1(1)-1`
264	`iddiff=iddiff+365`	264	`iddiff=iddiff+365`
265	`enddo`	265	`enddo`
266	`iddiff=iddiff+ixday`	266	`iddiff=iddiff+ixday`
267	`else if (date1(1).lt.date2(1)) then`	267	`else if (date1(1).lt.date2(1)) then`
268	`do j=date1(1),date2(1)-1`	268	`do j=date1(1),date2(1)-1`
269	`iddiff=iddiff-365`	269	`iddiff=iddiff-365`
270	`enddo`	270	`enddo`
271	`iddiff=iddiff-ixday`	271	`iddiff=iddiff-ixday`
272	`endif`	272	`endif`
273		273
274	`if (date1(2).gt.date2(2)) then ! compare monthes`	274	`if (date1(2).gt.date2(2)) then ! compare monthes`
275	`do j=date2(2),date1(2)-1`	275	`do j=date2(2),date1(2)-1`
276	`iddiff=iddiff+idays(j)`	276	`iddiff=iddiff+idays(j)`
277	`enddo`	277	`enddo`
278	`else if (date1(2).lt.date2(2)) then`	278	`else if (date1(2).lt.date2(2)) then`
279	`do j=date1(2),date2(2)-1`	279	`do j=date1(2),date2(2)-1`
280	`iddiff=iddiff-idays(j)`	280	`iddiff=iddiff-idays(j)`
281	`enddo`	281	`enddo`
282	`endif`	282	`endif`
283		283
284	`iddiff=iddiff+date1(3)-date2(3)`	284	`iddiff=iddiff+date1(3)-date2(3)`
285	`ihdiff=iddiff*24+date1(4)-date2(4)`	285	`ihdiff=iddiff*24+date1(4)-date2(4)`
286	`imdiff=ihdiff*60+date1(5)-date2(5)`	286	`imdiff=ihdiff*60+date1(5)-date2(5)`
287		287
288	`ihdiff=imdiff/60`	288	`ihdiff=imdiff/60`
289	`imdiff=mod(imdiff,60)`	289	`imdiff=mod(imdiff,60)`
290		290
291	`diff=real(ihdiff)+real(imdiff)/100.`	291	`diff=real(ihdiff)+real(imdiff)/100.`
292		292
293	`return`	293	`return`
294	`end`	294	`end`

Subversion Repositories lagranto.um

(root)/tags/1.0/lib/times.f – Rev 3 → 4