WebSVN – lagranto.um – Diff – /tags/2.0/goodies/newtime.f


      program calcnewdate
C     ===================
 
      implicit none
 
      integer   date1(5),date2(5)
      integer	iargc
      real      diff
      character*(80) arg,yychar,cdat
      character*(2)  cdate(5)
      integer	flag,nc
 
c     check for sufficient requested arguments
      if (iargc().ne.2) then
        print*,'USAGE: newtime date (format (YY)YYMMDD_HH(MM)) timestep'
        call exit(1)
      endif
 
c     read and transform input
      call getarg(1,arg)
      call lenchar(arg,nc)
      if (nc.eq.9) then
        yychar=''
        read(arg(1:2),'(i2)',err=120)date1(1)
        read(arg(3:4),'(i2)',err=120)date1(2)
        read(arg(5:6),'(i2)',err=120)date1(3)
        read(arg(8:9),'(i2)',err=120)date1(4)
        date1(5)=99
      else if (nc.eq.11) then
        yychar=arg(1:2)
        read(arg(3:4),'(i2)',err=120)date1(1)
        read(arg(5:6),'(i2)',err=120)date1(2)
        read(arg(7:8),'(i2)',err=120)date1(3)
        read(arg(10:11),'(i2)',err=120)date1(4)
        date1(5)=99
      else if (nc.eq.13) then
        yychar=arg(1:2)
        read(arg(3:4),'(i2)',err=120)date1(1)
        read(arg(5:6),'(i2)',err=120)date1(2)
        read(arg(7:8),'(i2)',err=120)date1(3)
        read(arg(10:11),'(i2)',err=120)date1(4)
        read(arg(12:13),'(i2)',err=120)date1(5)
      else
        print*,'USAGE: newtime date (format (YY)YYMMDD_HH(MM)) timestep'
        call exit(1)
      endif
 
      call getarg(2,arg)
      call checkchar(arg,".",flag)
      if (flag.eq.0) arg=trim(arg)//"."
      read(arg,*) diff
 
      call newdate_test(date1,diff,date2)
 
      if ((date2(1).lt.date1(1)).and.
     >    (diff.gt.0.).and.
     >    (yychar.eq.'19')) yychar='20'
 
      if (date2(1).lt.0) date2(1)=date2(1)+100
 
      if ((date2(1).gt.date1(1)).and.
     >    (diff.lt.0.).and.
     >    (yychar.eq.'20')) yychar='19'
 
      if (date2(1).lt.10) then
        write(cdate(1),'(a,i1)')'0',date2(1)
      else
        write(cdate(1),'(i2)')date2(1)
      endif
      if (date2(2).lt.10) then
        write(cdate(2),'(a,i1)')'0',date2(2)
      else
        write(cdate(2),'(i2)')date2(2)
      endif
      if (date2(3).lt.10) then
        write(cdate(3),'(a,i1)')'0',date2(3)
      else
        write(cdate(3),'(i2)')date2(3)
      endif
      if (date2(4).lt.10) then
        write(cdate(4),'(a,i1)')'0',date2(4)
      else
        write(cdate(4),'(i2)')date2(4)
      endif
      if (date1(5).eq.99) then
        cdate(5)=''
      else
        if (date2(5).lt.10) then
          write(cdate(5),'(a,i1)')'0',date2(5)
        else
          write(cdate(5),'(i2)')date2(5)
        endif
      endif
 
      cdat=trim(yychar)//cdate(1)//cdate(2)//cdate(3)//
     >     '_'//cdate(4)//cdate(5)
      write(*,'(a)')trim(cdat)
 
      goto 200
 
 120  write(*,*)
     > "*** error: date must be in format (YY)YYMMDD_HH(MM) ***"
 
 200  continue
 
      end
 
      subroutine checkchar(string,char,flag)
C     ======================================
 
      character*(*)	string
      character*(1)	char
      integer	n,flag
 
      flag=0
      do n=1,len(string)
        if (string(n:n).eq.char) then
          flag=n
          return
        endif
      enddo
      end
 
      subroutine lenchar(string,lstr)
C     ===============================
 
      character*(*)     string
      integer   n,lstr
 
      do n=1,len(string)
        if (string(n:n).eq."") then
          lstr=n-1
          goto 100
        endif
      enddo
 100  continue
      end
 
      subroutine newdate_test(date1,diff,date2)
C     ====================================
C
C     Routine calculates the new date when diff (in hours) is added to
C     date1.
C     date1	int	input	array contains a date in the form
C				year,month,day,hour,minute
C     diff	real	input	timestep to go from date1; if date1(5)
C                               is equal to 99, diff is assumed to be
C                               given in hours, otherwise in minutes
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)
      if (date1(5).eq.99) then
        date2(4)=date1(4)+int(diff)
        date2(5)=0
      else
        date2(4)=date1(4)
        date2(5)=date1(5)+int(diff)
      endif
 
      if (date2(5).ge.60) then
        date2(4)=date2(4)+int(date2(5)/60)
        date2(5)=date2(5)-int(date2(5)/60)*60
      endif
      if (date2(5).lt.0) then
        if (mod(date2(5),60).eq.0) then
          date2(4)=date2(4)-int(abs(date2(5))/60)
          date2(5)=date2(5)+int(abs(date2(5))/60)*60
        else
          date2(4)=date2(4)-(1+int(abs(date2(5))/60))
          date2(5)=date2(5)+(1+int(abs(date2(5))/60))*60
        endif
      endif
 
      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

Rev 5	Rev 10
1	`program calcnewdate`	1	`program calcnewdate`
2	`C ===================`	2	`C ===================`
3		3
4	`implicit none`	4	`implicit none`
5		5
6	`integer date1(5),date2(5)`	6	`integer date1(5),date2(5)`
7	`integer iargc`	7	`integer iargc`
8	`real diff`	8	`real diff`
9	`character*(80) arg,yychar,cdat`	9	`character*(80) arg,yychar,cdat`
10	`character*(2) cdate(5)`	10	`character*(2) cdate(5)`
11	`integer flag,nc`	11	`integer flag,nc`
12		12
13	`c check for sufficient requested arguments`	13	`c check for sufficient requested arguments`
14	`if (iargc().ne.2) then`	14	`if (iargc().ne.2) then`
15	`print*,'USAGE: newtime date (format (YY)YYMMDD_HH(MM)) timestep'`	15	`print*,'USAGE: newtime date (format (YY)YYMMDD_HH(MM)) timestep'`
16	`call exit(1)`	16	`call exit(1)`
17	`endif`	17	`endif`
18		18
19	`c read and transform input`	19	`c read and transform input`
20	`call getarg(1,arg)`	20	`call getarg(1,arg)`
21	`call lenchar(arg,nc)`	21	`call lenchar(arg,nc)`
22	`if (nc.eq.9) then`	22	`if (nc.eq.9) then`
23	`yychar=''`	23	`yychar=''`
24	`read(arg(1:2),'(i2)',err=120)date1(1)`	24	`read(arg(1:2),'(i2)',err=120)date1(1)`
25	`read(arg(3:4),'(i2)',err=120)date1(2)`	25	`read(arg(3:4),'(i2)',err=120)date1(2)`
26	`read(arg(5:6),'(i2)',err=120)date1(3)`	26	`read(arg(5:6),'(i2)',err=120)date1(3)`
27	`read(arg(8:9),'(i2)',err=120)date1(4)`	27	`read(arg(8:9),'(i2)',err=120)date1(4)`
28	`date1(5)=99`	28	`date1(5)=99`
29	`else if (nc.eq.11) then`	29	`else if (nc.eq.11) then`
30	`yychar=arg(1:2)`	30	`yychar=arg(1:2)`
31	`read(arg(3:4),'(i2)',err=120)date1(1)`	31	`read(arg(3:4),'(i2)',err=120)date1(1)`
32	`read(arg(5:6),'(i2)',err=120)date1(2)`	32	`read(arg(5:6),'(i2)',err=120)date1(2)`
33	`read(arg(7:8),'(i2)',err=120)date1(3)`	33	`read(arg(7:8),'(i2)',err=120)date1(3)`
34	`read(arg(10:11),'(i2)',err=120)date1(4)`	34	`read(arg(10:11),'(i2)',err=120)date1(4)`
35	`date1(5)=99`	35	`date1(5)=99`
36	`else if (nc.eq.13) then`	36	`else if (nc.eq.13) then`
37	`yychar=arg(1:2)`	37	`yychar=arg(1:2)`
38	`read(arg(3:4),'(i2)',err=120)date1(1)`	38	`read(arg(3:4),'(i2)',err=120)date1(1)`
39	`read(arg(5:6),'(i2)',err=120)date1(2)`	39	`read(arg(5:6),'(i2)',err=120)date1(2)`
40	`read(arg(7:8),'(i2)',err=120)date1(3)`	40	`read(arg(7:8),'(i2)',err=120)date1(3)`
41	`read(arg(10:11),'(i2)',err=120)date1(4)`	41	`read(arg(10:11),'(i2)',err=120)date1(4)`
42	`read(arg(12:13),'(i2)',err=120)date1(5)`	42	`read(arg(12:13),'(i2)',err=120)date1(5)`
43	`else`	43	`else`
44	`print*,'USAGE: newtime date (format (YY)YYMMDD_HH(MM)) timestep'`	44	`print*,'USAGE: newtime date (format (YY)YYMMDD_HH(MM)) timestep'`
45	`call exit(1)`	45	`call exit(1)`
46	`endif`	46	`endif`
47		47
48	`call getarg(2,arg)`	48	`call getarg(2,arg)`
49	`call checkchar(arg,".",flag)`	49	`call checkchar(arg,".",flag)`
50	`if (flag.eq.0) arg=trim(arg)//"."`	50	`if (flag.eq.0) arg=trim(arg)//"."`
51	`read(arg,*) diff`	51	`read(arg,*) diff`
52		52
53	`call newdate_test(date1,diff,date2)`	53	`call newdate_test(date1,diff,date2)`
54		54
55	`if ((date2(1).lt.date1(1)).and.`	55	`if ((date2(1).lt.date1(1)).and.`
56	`> (diff.gt.0.).and.`	56	`> (diff.gt.0.).and.`
57	`> (yychar.eq.'19')) yychar='20'`	57	`> (yychar.eq.'19')) yychar='20'`
58		58
59	`if (date2(1).lt.0) date2(1)=date2(1)+100`	59	`if (date2(1).lt.0) date2(1)=date2(1)+100`
60		60
61	`if ((date2(1).gt.date1(1)).and.`	61	`if ((date2(1).gt.date1(1)).and.`
62	`> (diff.lt.0.).and.`	62	`> (diff.lt.0.).and.`
63	`> (yychar.eq.'20')) yychar='19'`	63	`> (yychar.eq.'20')) yychar='19'`
64		64
65	`if (date2(1).lt.10) then`	65	`if (date2(1).lt.10) then`
66	`write(cdate(1),'(a,i1)')'0',date2(1)`	66	`write(cdate(1),'(a,i1)')'0',date2(1)`
67	`else`	67	`else`
68	`write(cdate(1),'(i2)')date2(1)`	68	`write(cdate(1),'(i2)')date2(1)`
69	`endif`	69	`endif`
70	`if (date2(2).lt.10) then`	70	`if (date2(2).lt.10) then`
71	`write(cdate(2),'(a,i1)')'0',date2(2)`	71	`write(cdate(2),'(a,i1)')'0',date2(2)`
72	`else`	72	`else`
73	`write(cdate(2),'(i2)')date2(2)`	73	`write(cdate(2),'(i2)')date2(2)`
74	`endif`	74	`endif`
75	`if (date2(3).lt.10) then`	75	`if (date2(3).lt.10) then`
76	`write(cdate(3),'(a,i1)')'0',date2(3)`	76	`write(cdate(3),'(a,i1)')'0',date2(3)`
77	`else`	77	`else`
78	`write(cdate(3),'(i2)')date2(3)`	78	`write(cdate(3),'(i2)')date2(3)`
79	`endif`	79	`endif`
80	`if (date2(4).lt.10) then`	80	`if (date2(4).lt.10) then`
81	`write(cdate(4),'(a,i1)')'0',date2(4)`	81	`write(cdate(4),'(a,i1)')'0',date2(4)`
82	`else`	82	`else`
83	`write(cdate(4),'(i2)')date2(4)`	83	`write(cdate(4),'(i2)')date2(4)`
84	`endif`	84	`endif`
85	`if (date1(5).eq.99) then`	85	`if (date1(5).eq.99) then`
86	`cdate(5)=''`	86	`cdate(5)=''`
87	`else`	87	`else`
88	`if (date2(5).lt.10) then`	88	`if (date2(5).lt.10) then`
89	`write(cdate(5),'(a,i1)')'0',date2(5)`	89	`write(cdate(5),'(a,i1)')'0',date2(5)`
90	`else`	90	`else`
91	`write(cdate(5),'(i2)')date2(5)`	91	`write(cdate(5),'(i2)')date2(5)`
92	`endif`	92	`endif`
93	`endif`	93	`endif`
94		94
95	`cdat=trim(yychar)//cdate(1)//cdate(2)//cdate(3)//`	95	`cdat=trim(yychar)//cdate(1)//cdate(2)//cdate(3)//`
96	`> '_'//cdate(4)//cdate(5)`	96	`> '_'//cdate(4)//cdate(5)`
97	`write(*,'(a)')trim(cdat)`	97	`write(*,'(a)')trim(cdat)`
98		98
99	`goto 200`	99	`goto 200`
100		100
101	`120 write(,)`	101	`120 write(,)`
102	`> "* error: date must be in format (YY)YYMMDD_HH(MM) *"`	102	`> "* error: date must be in format (YY)YYMMDD_HH(MM) *"`
103		103
104	`200 continue`	104	`200 continue`
105		105
106	`end`	106	`end`
107		107
108	`subroutine checkchar(string,char,flag)`	108	`subroutine checkchar(string,char,flag)`
109	`C ======================================`	109	`C ======================================`
110		110
111	`character() string`	111	`character() string`
112	`character*(1) char`	112	`character*(1) char`
113	`integer n,flag`	113	`integer n,flag`
114		114
115	`flag=0`	115	`flag=0`
116	`do n=1,len(string)`	116	`do n=1,len(string)`
117	`if (string(n:n).eq.char) then`	117	`if (string(n:n).eq.char) then`
118	`flag=n`	118	`flag=n`
119	`return`	119	`return`
120	`endif`	120	`endif`
121	`enddo`	121	`enddo`
122	`end`	122	`end`
123		123
124	`subroutine lenchar(string,lstr)`	124	`subroutine lenchar(string,lstr)`
125	`C ===============================`	125	`C ===============================`
126		126
127	`character() string`	127	`character() string`
128	`integer n,lstr`	128	`integer n,lstr`
129		129
130	`do n=1,len(string)`	130	`do n=1,len(string)`
131	`if (string(n:n).eq."") then`	131	`if (string(n:n).eq."") then`
132	`lstr=n-1`	132	`lstr=n-1`
133	`goto 100`	133	`goto 100`
134	`endif`	134	`endif`
135	`enddo`	135	`enddo`
136	`100 continue`	136	`100 continue`
137	`end`	137	`end`
138		138
139	`subroutine newdate_test(date1,diff,date2)`	139	`subroutine newdate_test(date1,diff,date2)`
140	`C ====================================`	140	`C ====================================`
141	`C`	141	`C`
142	`C Routine calculates the new date when diff (in hours) is added to`	142	`C Routine calculates the new date when diff (in hours) is added to`
143	`C date1.`	143	`C date1.`
144	`C date1 int input array contains a date in the form`	144	`C date1 int input array contains a date in the form`
145	`C year,month,day,hour,minute`	145	`C year,month,day,hour,minute`
146	`C diff real input timestep to go from date1; if date1(5)`	146	`C diff real input timestep to go from date1; if date1(5)`
147	`C is equal to 99, diff is assumed to be`	147	`C is equal to 99, diff is assumed to be`
148	`C given in hours, otherwise in minutes`	148	`C given in hours, otherwise in minutes`
149	`C date2 int output array contains new date in the same form`	149	`C date2 int output array contains new date in the same form`
150		150
151	`integer date1(5),date2(5)`	151	`integer date1(5),date2(5)`
152	`integer idays(12) ! array containing the days of the monthes`	152	`integer idays(12) ! array containing the days of the monthes`
153	`real diff`	153	`real diff`
154	`logical yearchange`	154	`logical yearchange`
155		155
156	`data idays/31,28,31,30,31,30,31,31,30,31,30,31/`	156	`data idays/31,28,31,30,31,30,31,31,30,31,30,31/`
157		157
158	`yearchange=.false.`	158	`yearchange=.false.`
159		159
160	`if ((mod(date1(1),4).eq.0).and.(date1(2).le.2)) idays(2)=29`	160	`if ((mod(date1(1),4).eq.0).and.(date1(2).le.2)) idays(2)=29`
161		161
162	`date2(1)=date1(1)`	162	`date2(1)=date1(1)`
163	`date2(2)=date1(2)`	163	`date2(2)=date1(2)`
164	`date2(3)=date1(3)`	164	`date2(3)=date1(3)`
165	`if (date1(5).eq.99) then`	165	`if (date1(5).eq.99) then`
166	`date2(4)=date1(4)+int(diff)`	166	`date2(4)=date1(4)+int(diff)`
167	`date2(5)=0`	167	`date2(5)=0`
168	`else`	168	`else`
169	`date2(4)=date1(4)`	169	`date2(4)=date1(4)`
170	`date2(5)=date1(5)+int(diff)`	170	`date2(5)=date1(5)+int(diff)`
171	`endif`	171	`endif`
172		172
173	`if (date2(5).ge.60) then`	173	`if (date2(5).ge.60) then`
174	`date2(4)=date2(4)+int(date2(5)/60)`	174	`date2(4)=date2(4)+int(date2(5)/60)`
175	`date2(5)=date2(5)-int(date2(5)/60)*60`	175	`date2(5)=date2(5)-int(date2(5)/60)*60`
176	`endif`	176	`endif`
177	`if (date2(5).lt.0) then`	177	`if (date2(5).lt.0) then`
178	`if (mod(date2(5),60).eq.0) then`	178	`if (mod(date2(5),60).eq.0) then`
179	`date2(4)=date2(4)-int(abs(date2(5))/60)`	179	`date2(4)=date2(4)-int(abs(date2(5))/60)`
180	`date2(5)=date2(5)+int(abs(date2(5))/60)*60`	180	`date2(5)=date2(5)+int(abs(date2(5))/60)*60`
181	`else`	181	`else`
182	`date2(4)=date2(4)-(1+int(abs(date2(5))/60))`	182	`date2(4)=date2(4)-(1+int(abs(date2(5))/60))`
183	`date2(5)=date2(5)+(1+int(abs(date2(5))/60))*60`	183	`date2(5)=date2(5)+(1+int(abs(date2(5))/60))*60`
184	`endif`	184	`endif`
185	`endif`	185	`endif`
186		186
187	`if (date2(4).ge.24) then`	187	`if (date2(4).ge.24) then`
188	`date2(3)=date2(3)+int(date2(4)/24)`	188	`date2(3)=date2(3)+int(date2(4)/24)`
189	`date2(4)=date2(4)-int(date2(4)/24)*24`	189	`date2(4)=date2(4)-int(date2(4)/24)*24`
190	`endif`	190	`endif`
191	`if (date2(4).lt.0) then`	191	`if (date2(4).lt.0) then`
192	`if (mod(date2(4),24).eq.0) then`	192	`if (mod(date2(4),24).eq.0) then`
193	`date2(3)=date2(3)-int(abs(date2(4))/24)`	193	`date2(3)=date2(3)-int(abs(date2(4))/24)`
194	`date2(4)=date2(4)+int(abs(date2(4))/24)*24`	194	`date2(4)=date2(4)+int(abs(date2(4))/24)*24`
195	`else`	195	`else`
196	`date2(3)=date2(3)-(1+int(abs(date2(4))/24))`	196	`date2(3)=date2(3)-(1+int(abs(date2(4))/24))`
197	`date2(4)=date2(4)+(1+int(abs(date2(4))/24))*24`	197	`date2(4)=date2(4)+(1+int(abs(date2(4))/24))*24`
198	`endif`	198	`endif`
199	`endif`	199	`endif`
200		200
201	`100 if (date2(3).gt.idays(date2(2))) then`	201	`100 if (date2(3).gt.idays(date2(2))) then`
202	`if ((date2(2).eq.2).and.(mod(date2(1),4).eq.0)) idays(2)=29`	202	`if ((date2(2).eq.2).and.(mod(date2(1),4).eq.0)) idays(2)=29`
203	`date2(3)=date2(3)-idays(date2(2))`	203	`date2(3)=date2(3)-idays(date2(2))`
204	`if (idays(2).eq.29) idays(2)=28`	204	`if (idays(2).eq.29) idays(2)=28`
205	`date2(2)=date2(2)+1`	205	`date2(2)=date2(2)+1`
206	`if (date2(2).gt.12) then`	206	`if (date2(2).gt.12) then`
207	`* date2(1)=date2(1)+int(date2(2)/12)`	207	`* date2(1)=date2(1)+int(date2(2)/12)`
208	`* date2(2)=date2(2)-int(date2(2)/12)*12`	208	`* date2(2)=date2(2)-int(date2(2)/12)*12`
209	`date2(1)=date2(1)+1`	209	`date2(1)=date2(1)+1`
210	`date2(2)=date2(2)-12`	210	`date2(2)=date2(2)-12`
211	`endif`	211	`endif`
212	`if (date2(2).lt.1) then`	212	`if (date2(2).lt.1) then`
213	`date2(1)=date2(1)-(1+int(abs(date2(2)/12)))`	213	`date2(1)=date2(1)-(1+int(abs(date2(2)/12)))`
214	`date2(2)=date2(2)+(1+int(abs(date2(2)/12)))*12`	214	`date2(2)=date2(2)+(1+int(abs(date2(2)/12)))*12`
215	`endif`	215	`endif`
216	`goto 100`	216	`goto 100`
217	`endif`	217	`endif`
218	`200 if (date2(3).lt.1) then`	218	`200 if (date2(3).lt.1) then`
219	`date2(2)=date2(2)-1`	219	`date2(2)=date2(2)-1`
220	`if (date2(2).gt.12) then`	220	`if (date2(2).gt.12) then`
221	`date2(1)=date2(1)+int(date2(2)/12)`	221	`date2(1)=date2(1)+int(date2(2)/12)`
222	`date2(2)=date2(2)-int(date2(2)/12)*12`	222	`date2(2)=date2(2)-int(date2(2)/12)*12`
223	`endif`	223	`endif`
224	`if (date2(2).lt.1) then`	224	`if (date2(2).lt.1) then`
225	`date2(1)=date2(1)-(1+int(abs(date2(2)/12)))`	225	`date2(1)=date2(1)-(1+int(abs(date2(2)/12)))`
226	`date2(2)=date2(2)+(1+int(abs(date2(2)/12)))*12`	226	`date2(2)=date2(2)+(1+int(abs(date2(2)/12)))*12`
227	`endif`	227	`endif`
228	`if ((date2(2).eq.2).and.(mod(date2(1),4).eq.0)) idays(2)=29`	228	`if ((date2(2).eq.2).and.(mod(date2(1),4).eq.0)) idays(2)=29`
229	`date2(3)=date2(3)+idays(date2(2))`	229	`date2(3)=date2(3)+idays(date2(2))`
230	`if (idays(2).eq.29) idays(2)=28`	230	`if (idays(2).eq.29) idays(2)=28`
231	`goto 200`	231	`goto 200`
232	`endif`	232	`endif`
233		233
234	`if (date2(2).gt.12) then`	234	`if (date2(2).gt.12) then`
235	`date2(1)=date2(1)+int(date2(2)/12)`	235	`date2(1)=date2(1)+int(date2(2)/12)`
236	`date2(2)=date2(2)-int(date2(2)/12)*12`	236	`date2(2)=date2(2)-int(date2(2)/12)*12`
237	`endif`	237	`endif`
238	`if (date2(2).lt.1) then`	238	`if (date2(2).lt.1) then`
239	`date2(1)=date2(1)-(1+int(abs(date2(2)/12)))`	239	`date2(1)=date2(1)-(1+int(abs(date2(2)/12)))`
240	`date2(2)=date2(2)+(1+int(abs(date2(2)/12)))*12`	240	`date2(2)=date2(2)+(1+int(abs(date2(2)/12)))*12`
241	`endif`	241	`endif`
242		242
243	`if (date2(1).lt.1000) then`	243	`if (date2(1).lt.1000) then`
244	`if (date2(1).ge.100) date2(1)=date2(1)-100`	244	`if (date2(1).ge.100) date2(1)=date2(1)-100`
245	`endif`	245	`endif`
246		246
247	`return`	247	`return`
248	`end`	248	`end`

Subversion Repositories lagranto.um

(root)/tags/2.0/goodies/newtime.f – Rev 5 → 10