WebSVN – lagranto.ecmwf – Diff – /trunk/goodies/gettidiff.f


      program gettidiff
C     =================
 
      implicit none
 
      integer   idate(5),irefdat(5)
      real      ihdiff
 
      integer   iargc
      character*(80) arg
      integer	nc1,nc2,flag1,flag2
 
c     check for sufficient requested arguments
      if (iargc().ne.2) then
         print*,
     >  'USAGE: gettidiff date1 date2 (format (YY)YYMMDD_HH(MM))'
         call exit(1)
      endif
 
c     read and transform input
      call getarg(1,arg)
      call lenchar(arg,nc1)
      call checkchar(arg,'_',flag1)
 
      idate(5)   = 0
      irefdat(5) = 0
 
      if (flag1.eq.7) then
        read(arg(1:2),'(i2)',err=120)idate(1)
        read(arg(3:4),'(i2)',err=120)idate(2)
        read(arg(5:6),'(i2)',err=120)idate(3)
        read(arg(8:9),'(i2)',err=120)idate(4)
        if (nc1.eq.11) then
          read(arg(10:11),'(i2)',err=120)idate(5)
        else if (nc1.ne.9) then
          print*,
     >   'USAGE: gettidiff date1 date2 (format (YY)YYMMDD_HH(MM))'
          call exit(1)
        endif
      else if (flag1.eq.9) then
        read(arg(1:4),'(i4)',err=120)idate(1)
        read(arg(5:6),'(i2)',err=120)idate(2)
        read(arg(7:8),'(i2)',err=120)idate(3)
        read(arg(10:11),'(i2)',err=120)idate(4)
        if (nc1.eq.13) then
          read(arg(12:13),'(i2)',err=120)idate(5)
        else if (nc1.ne.11) then
          print*,
     >   'USAGE: gettidiff date1 date2 (format (YY)YYMMDD_HH(MM))'
          call exit(1)
        endif
      else
        print*,
     > 'USAGE: gettidiff date1 date2 (format (YY)YYMMDD_HH(MM))'
        call exit(1)
      endif
 
      call getarg(2,arg)
      call lenchar(arg,nc2)
      call checkchar(arg,'_',flag2)
      if (flag1.ne.flag2) then
        print*,
     > 'error: both dates must be in same format (YY)YYMMDD_HH(MM)'
        call exit(1)
      endif
 
      if (flag2.eq.7) then
        read(arg(1:2),'(i2)',err=120)irefdat(1)
        read(arg(3:4),'(i2)',err=120)irefdat(2)
        read(arg(5:6),'(i2)',err=120)irefdat(3)
        read(arg(8:9),'(i2)',err=120)irefdat(4)
        if (nc2.eq.11) then
          read(arg(10:11),'(i2)',err=120)irefdat(5)
        else if (nc2.ne.9) then
          print*,
     >   'USAGE: gettidiff date1 date2 (format (YY)YYMMDD_HH(MM))'
          call exit(1)
        endif
      else if (flag2.eq.9) then
        read(arg(1:4),'(i4)',err=120)irefdat(1)
        read(arg(5:6),'(i2)',err=120)irefdat(2)
        read(arg(7:8),'(i2)',err=120)irefdat(3)
        read(arg(10:11),'(i2)',err=120)irefdat(4)
        if (nc2.eq.13) then
          read(arg(12:13),'(i2)',err=120)irefdat(5)
        else if (nc2.ne.11) then
          print*,
     >   'USAGE: gettidiff date1 date2 (format (YY)YYMMDD_HH(MM))'
          call exit(1)
        endif
      else
        print*,
     >   'USAGE: gettidiff date1 date2 (format (YY)YYMMDD_HH(MM))'
        call exit(1)
      endif
 
      call timediff(idate,irefdat,ihdiff)
 
      if (int(100.*ihdiff).eq.100*int(ihdiff)) then
        write(*,*)int(ihdiff)
      else
        write(*,'(f7.2)')ihdiff
      endif
 
      goto 200
 
 120  write(*,*)
     >"*** error: date must be in format (YY)YYMMDD_HH(MM) ***"
 
 200  continue
      end
 
      subroutine lenchar(string,lstr)
C     ===============================
 
      character*(*)     string
      integer   n,lstr
 
      do n=1,len(string)
        if (string(n:n).eq."") then
          lstr=n-1
          goto 100
        endif
      enddo
 100  continue
      end
 
      subroutine checkchar(string,char,flag)
C     ======================================
 
      character*(*)     string
      character*(1)     char
      integer   n,flag
 
      flag=0
      do n=1,len(string)
        if (string(n:n).eq.char) then
          flag=n
          return
        endif
      enddo
      end

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

Subversion Repositories lagranto.ecmwf

(root)/trunk/goodies/gettidiff.f – Rev 3 → 19