Subversion Repositories lagranto.ecmwf

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