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

Subversion Repositories lagranto.um

(root)/tags/2.0/goodies/gettidiff.f – Rev 3 → 10