Subversion Repositories lagranto.arpege

Rev

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