Subversion Repositories lagranto.um

Rev

Rev 3 | Details | Compare with Previous | Last modification | View Log | RSS feed

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