Subversion Repositories lagranto.um

Rev

Go to most recent revision | Details | 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
10 
      character*(2)  cdate(4)
11 
      integer	flag,nc
12 
 
13 
c     check for sufficient requested arguments
14 
      if (iargc().ne.2) then
15 
        print*,'USAGE: newtime date (format (YY)YYMMDD_HH) timestep'
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)
28 
      else if (nc.eq.11) then
29 
        yychar=arg(1:2)
30 
        read(arg(3:4),'(i2)',err=120)date1(1)
31 
        read(arg(5:6),'(i2)',err=120)date1(2)
32 
        read(arg(7:8),'(i2)',err=120)date1(3)
33 
        read(arg(10:11),'(i2)',err=120)date1(4)
34 
      else
35 
        print*,'USAGE: newtime date (format (YY)YYMMDD_HH) timestep'
36 
        call exit(1)
37 
      endif
38 
 
39 
      call getarg(2,arg)
40 
      call checkchar(arg,".",flag)
41 
      if (flag.eq.0) arg=trim(arg)//"."
42 
      read(arg,'(f10.2)') diff
43 
 
44 
      call newdate(date1,diff,date2)
45 
 
46 
      if ((date2(1).lt.date1(1)).and.
47 
     >    (diff.gt.0.).and.
48 
     >    (yychar.eq.'19')) yychar='20'
49 
 
50 
c      if ((date2(1).lt.date1(1)).and.
51 
c     >    (diff.gt.0.).and.
52 
c     >    (yychar.eq.'20')) yychar='21'
53 
 
54 
      if (date2(1).lt.0) date2(1)=date2(1)+100
55 
 
56 
      if ((date2(1).gt.date1(1)).and.
57 
     >    (diff.lt.0.).and.
58 
     >    (yychar.eq.'20')) yychar='19'
59 
 
60 
c      if ((date2(1).gt.date1(1)).and.
61 
c     >    (diff.lt.0.).and.
62 
c     >    (yychar.eq.'21')) yychar='20'
63 
 
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
85 
 
86 
      cdat=trim(yychar)//cdate(1)//cdate(2)//cdate(3)//'_'//cdate(4)
87 
      write(*,'(a)')trim(cdat)
88 
 
89 
      goto 200
90 
 
91 
 120  write(*,*)"*** error: date must be in format (YY)YYMMDD_HH ***"
92 
 
93 
 200  continue
94 
 
95 
      end
96 
 
97 
      subroutine checkchar(string,char,flag)
98 
C     ======================================
99 
 
100 
      character*(*)	string
101 
      character*(1)	char
102 
      integer	n,flag
103 
 
104 
      flag=0
105 
      do n=1,len(string)
106 
        if (string(n:n).eq.char) then
107 
          flag=n
108 
          return
109 
        endif
110 
      enddo
111 
      end
112 
 
113 
      subroutine lenchar(string,lstr)
114 
C     ===============================
115 
 
116 
      character*(*)     string
117 
      integer   n,lstr
118 
 
119 
      do n=1,len(string)
120 
        if (string(n:n).eq."") then
121 
          lstr=n-1
122 
          goto 100
123 
        endif
124 
      enddo
125 
 100  continue
126 
      end