Subversion Repositories lagranto.icon

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
3 michaesp 1 
      program gettidiff
2 
C     =================
3 
 
4 
      implicit none
5 
 
6 
      integer   idate(5),irefdat(5)
7 
      real      ihdiff
8 
 
9 
      integer   iargc
10 
      character*(80) arg
11 
      integer	nc1,nc2,flag1,flag2
12 
 
13 
c     check for sufficient requested arguments
14 
      if (iargc().ne.2) then
15 
         print*,
16 
     >  'USAGE: gettidiff date1 date2 (format (YY)YYMMDD_HH(MM))'
17 
         call exit(1)
18 
      endif
19 
 
20 
c     init
21 
      idate(1) = 0
22 
      idate(2) = 0
23 
      idate(3) = 0
24 
      idate(4) = 0
25 
      idate(5) = 0
26 
      irefdat(1) = 0
27 
      irefdat(2) = 0
28 
      irefdat(3) = 0
29 
      irefdat(4) = 0
30 
      irefdat(5) = 0
31 
 
32 
c     read and transform input
33 
      call getarg(1,arg)
34 
      call lenchar(arg,nc1)
35 
      call checkchar(arg,'_',flag1)
36 
 
37 
      if (flag1.eq.7) then
38 
        read(arg(1:2),'(i2)',err=120)idate(1)
39 
        read(arg(3:4),'(i2)',err=120)idate(2)
40 
        read(arg(5:6),'(i2)',err=120)idate(3)
41 
        read(arg(8:9),'(i2)',err=120)idate(4)
42 
        if (nc1.eq.11) then
43 
          read(arg(10:11),'(i2)',err=120)idate(5)
44 
        else if (nc1.ne.9) then
45 
          print*,
46 
     >   'USAGE: gettidiff date1 date2 (format (YY)YYMMDD_HH(MM))'
47 
          call exit(1)
48 
        endif
49 
      else if (flag1.eq.9) then
50 
        read(arg(1:4),'(i4)',err=120)idate(1)
51 
        read(arg(5:6),'(i2)',err=120)idate(2)
52 
        read(arg(7:8),'(i2)',err=120)idate(3)
53 
        read(arg(10:11),'(i2)',err=120)idate(4)
54 
        if (nc1.eq.13) then
55 
          read(arg(12:13),'(i2)',err=120)idate(5)
56 
        else if (nc1.ne.11) then
57 
          print*,
58 
     >   'USAGE: gettidiff date1 date2 (format (YY)YYMMDD_HH(MM))'
59 
          call exit(1)
60 
        endif
61 
      else
62 
        print*,
63 
     > 'USAGE: gettidiff date1 date2 (format (YY)YYMMDD_HH(MM))'
64 
        call exit(1)
65 
      endif
66 
 
67 
      call getarg(2,arg)
68 
      call lenchar(arg,nc2)
69 
      call checkchar(arg,'_',flag2)
70 
      if (flag1.ne.flag2) then
71 
        print*,
72 
     > 'error: both dates must be in same format (YY)YYMMDD_HH(MM)'
73 
        call exit(1)
74 
      endif
75 
 
76 
      if (flag2.eq.7) then
77 
        read(arg(1:2),'(i2)',err=120)irefdat(1)
78 
        read(arg(3:4),'(i2)',err=120)irefdat(2)
79 
        read(arg(5:6),'(i2)',err=120)irefdat(3)
80 
        read(arg(8:9),'(i2)',err=120)irefdat(4)
81 
        if (nc2.eq.11) then
82 
          read(arg(10:11),'(i2)',err=120)irefdat(5)
83 
        else if (nc2.ne.9) then
84 
          print*,
85 
     >   'USAGE: gettidiff date1 date2 (format (YY)YYMMDD_HH(MM))'
86 
          call exit(1)
87 
        endif
88 
      else if (flag2.eq.9) then
89 
        read(arg(1:4),'(i4)',err=120)irefdat(1)
90 
        read(arg(5:6),'(i2)',err=120)irefdat(2)
91 
        read(arg(7:8),'(i2)',err=120)irefdat(3)
92 
        read(arg(10:11),'(i2)',err=120)irefdat(4)
93 
        if (nc2.eq.13) then
94 
          read(arg(12:13),'(i2)',err=120)irefdat(5)
95 
        else if (nc2.ne.11) then
96 
          print*,
97 
     >   'USAGE: gettidiff date1 date2 (format (YY)YYMMDD_HH(MM))'
98 
          call exit(1)
99 
        endif
100 
      else
101 
        print*,
102 
     >   'USAGE: gettidiff date1 date2 (format (YY)YYMMDD_HH(MM))'
103 
        call exit(1)
104 
      endif
105 
 
106 
      call timediff(idate,irefdat,ihdiff)
107 
 
108 
      if (int(100.*ihdiff).eq.100*int(ihdiff)) then
109 
        write(*,*)int(ihdiff)
110 
      else
111 
        write(*,'(f7.2)')ihdiff
112 
      endif
113 
 
114 
      goto 200
115 
 
116 
 120  write(*,*)
117 
     >"*** error: date must be in format (YY)YYMMDD_HH(MM) ***"
118 
 
119 
 200  continue
120 
      end
121 
 
122 
      subroutine lenchar(string,lstr)
123 
C     ===============================
124 
 
125 
      character*(*)     string
126 
      integer   n,lstr
127 
 
128 
      do n=1,len(string)
129 
        if (string(n:n).eq."") then
130 
          lstr=n-1
131 
          goto 100
132 
        endif
133 
      enddo
134 
 100  continue
135 
      end
136 
 
137 
      subroutine checkchar(string,char,flag)
138 
C     ======================================
139 
 
140 
      character*(*)     string
141 
      character*(1)     char
142 
      integer   n,flag
143 
 
144 
      flag=0
145 
      do n=1,len(string)
146 
        if (string(n:n).eq.char) then
147 
          flag=n
148 
          return
149 
        endif
150 
      enddo
151 
      end