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


      program calcnewdate
C     ===================
 
      implicit none
 
      integer   date1(5),date2(5)
      integer	iargc
      real      diff
      character*(80) arg,yychar,cdat
      character*(2)  cdate(4)
      integer	flag,nc
 
c     check for sufficient requested arguments
      if (iargc().ne.2) then
        print*,'USAGE: newtime date (format (YY)YYMMDD_HH) timestep'
        call exit(1)
      endif
 
c     read and transform input
      date1(5) = 0
      date2(5) = 0
      call getarg(1,arg)
      call lenchar(arg,nc)
      if (nc.eq.9) then
        yychar=''
        read(arg(1:2),'(i2)',err=120)date1(1)
        read(arg(3:4),'(i2)',err=120)date1(2)
        read(arg(5:6),'(i2)',err=120)date1(3)
        read(arg(8:9),'(i2)',err=120)date1(4)
      else if (nc.eq.11) then
        yychar=arg(1:2)
        read(arg(3:4),'(i2)',err=120)date1(1)
        read(arg(5:6),'(i2)',err=120)date1(2)
        read(arg(7:8),'(i2)',err=120)date1(3)
        read(arg(10:11),'(i2)',err=120)date1(4)
      else
        print*,'USAGE: newtime date (format (YY)YYMMDD_HH) timestep'
        call exit(1)
      endif
 
      call getarg(2,arg)
      call checkchar(arg,".",flag)
      if (flag.eq.0) arg=trim(arg)//"."
      read(arg,'(f10.2)') diff
 
      call newdate(date1,diff,date2)
 
      if ((date2(1).lt.date1(1)).and.
     >    (diff.gt.0.).and.
     >    (yychar.eq.'19')) yychar='20'
 
c      if ((date2(1).lt.date1(1)).and.
c     >    (diff.gt.0.).and.
c     >    (yychar.eq.'20')) yychar='21'
 
      if (date2(1).lt.0) date2(1)=date2(1)+100
 
      if ((date2(1).gt.date1(1)).and.
     >    (diff.lt.0.).and.
     >    (yychar.eq.'20')) yychar='19'
 
c      if ((date2(1).gt.date1(1)).and.
c     >    (diff.lt.0.).and.
c     >    (yychar.eq.'21')) yychar='20'
 
 
      if (date2(1).lt.10) then
        write(cdate(1),'(a,i1)')'0',date2(1)
      else
        write(cdate(1),'(i2)')date2(1)
      endif
      if (date2(2).lt.10) then
        write(cdate(2),'(a,i1)')'0',date2(2)
      else
        write(cdate(2),'(i2)')date2(2)
      endif
      if (date2(3).lt.10) then
        write(cdate(3),'(a,i1)')'0',date2(3)
      else
        write(cdate(3),'(i2)')date2(3)
      endif
      if (date2(4).lt.10) then
        write(cdate(4),'(a,i1)')'0',date2(4)
      else
        write(cdate(4),'(i2)')date2(4)
      endif
 
      cdat=trim(yychar)//cdate(1)//cdate(2)//cdate(3)//'_'//cdate(4)
      write(*,'(a)')trim(cdat)
 
      goto 200
 
 120  write(*,*)"*** error: date must be in format (YY)YYMMDD_HH ***"
 
 200  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
 
      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

Rev 3	Rev 38
1	`program calcnewdate`	1	`program calcnewdate`
2	`C ===================`	2	`C ===================`
3		3
4	`implicit none`	4	`implicit none`
5		5
6	`integer date1(5),date2(5)`	6	`integer date1(5),date2(5)`
7	`integer iargc`	7	`integer iargc`
8	`real diff`	8	`real diff`
9	`character*(80) arg,yychar,cdat`	9	`character*(80) arg,yychar,cdat`
10	`character*(2) cdate(4)`	10	`character*(2) cdate(4)`
11	`integer flag,nc`	11	`integer flag,nc`
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*,'USAGE: newtime date (format (YY)YYMMDD_HH) timestep'`	15	`print*,'USAGE: newtime date (format (YY)YYMMDD_HH) timestep'`
16	`call exit(1)`	16	`call exit(1)`
17	`endif`	17	`endif`
18		18
19	`c read and transform input`	19	`c read and transform input`
-		20	`date1(5) = 0`
-		21	`date2(5) = 0`
20	`call getarg(1,arg)`	22	`call getarg(1,arg)`
21	`call lenchar(arg,nc)`	23	`call lenchar(arg,nc)`
22	`if (nc.eq.9) then`	24	`if (nc.eq.9) then`
23	`yychar=''`	25	`yychar=''`
24	`read(arg(1:2),'(i2)',err=120)date1(1)`	26	`read(arg(1:2),'(i2)',err=120)date1(1)`
25	`read(arg(3:4),'(i2)',err=120)date1(2)`	27	`read(arg(3:4),'(i2)',err=120)date1(2)`
26	`read(arg(5:6),'(i2)',err=120)date1(3)`	28	`read(arg(5:6),'(i2)',err=120)date1(3)`
27	`read(arg(8:9),'(i2)',err=120)date1(4)`	29	`read(arg(8:9),'(i2)',err=120)date1(4)`
28	`else if (nc.eq.11) then`	30	`else if (nc.eq.11) then`
29	`yychar=arg(1:2)`	31	`yychar=arg(1:2)`
30	`read(arg(3:4),'(i2)',err=120)date1(1)`	32	`read(arg(3:4),'(i2)',err=120)date1(1)`
31	`read(arg(5:6),'(i2)',err=120)date1(2)`	33	`read(arg(5:6),'(i2)',err=120)date1(2)`
32	`read(arg(7:8),'(i2)',err=120)date1(3)`	34	`read(arg(7:8),'(i2)',err=120)date1(3)`
33	`read(arg(10:11),'(i2)',err=120)date1(4)`	35	`read(arg(10:11),'(i2)',err=120)date1(4)`
34	`else`	36	`else`
35	`print*,'USAGE: newtime date (format (YY)YYMMDD_HH) timestep'`	37	`print*,'USAGE: newtime date (format (YY)YYMMDD_HH) timestep'`
36	`call exit(1)`	38	`call exit(1)`
37	`endif`	39	`endif`
38		40
39	`call getarg(2,arg)`	41	`call getarg(2,arg)`
40	`call checkchar(arg,".",flag)`	42	`call checkchar(arg,".",flag)`
41	`if (flag.eq.0) arg=trim(arg)//"."`	43	`if (flag.eq.0) arg=trim(arg)//"."`
42	`read(arg,'(f10.2)') diff`	44	`read(arg,'(f10.2)') diff`
43		45
44	`call newdate(date1,diff,date2)`	46	`call newdate(date1,diff,date2)`
45		47
46	`if ((date2(1).lt.date1(1)).and.`	48	`if ((date2(1).lt.date1(1)).and.`
47	`> (diff.gt.0.).and.`	49	`> (diff.gt.0.).and.`
48	`> (yychar.eq.'19')) yychar='20'`	50	`> (yychar.eq.'19')) yychar='20'`
49		51
50	`c if ((date2(1).lt.date1(1)).and.`	52	`c if ((date2(1).lt.date1(1)).and.`
51	`c > (diff.gt.0.).and.`	53	`c > (diff.gt.0.).and.`
52	`c > (yychar.eq.'20')) yychar='21'`	54	`c > (yychar.eq.'20')) yychar='21'`
53		55
54	`if (date2(1).lt.0) date2(1)=date2(1)+100`	56	`if (date2(1).lt.0) date2(1)=date2(1)+100`
55		57
56	`if ((date2(1).gt.date1(1)).and.`	58	`if ((date2(1).gt.date1(1)).and.`
57	`> (diff.lt.0.).and.`	59	`> (diff.lt.0.).and.`
58	`> (yychar.eq.'20')) yychar='19'`	60	`> (yychar.eq.'20')) yychar='19'`
59		61
60	`c if ((date2(1).gt.date1(1)).and.`	62	`c if ((date2(1).gt.date1(1)).and.`
61	`c > (diff.lt.0.).and.`	63	`c > (diff.lt.0.).and.`
62	`c > (yychar.eq.'21')) yychar='20'`	64	`c > (yychar.eq.'21')) yychar='20'`
63		65
64		66
65	`if (date2(1).lt.10) then`	67	`if (date2(1).lt.10) then`
66	`write(cdate(1),'(a,i1)')'0',date2(1)`	68	`write(cdate(1),'(a,i1)')'0',date2(1)`
67	`else`	69	`else`
68	`write(cdate(1),'(i2)')date2(1)`	70	`write(cdate(1),'(i2)')date2(1)`
69	`endif`	71	`endif`
70	`if (date2(2).lt.10) then`	72	`if (date2(2).lt.10) then`
71	`write(cdate(2),'(a,i1)')'0',date2(2)`	73	`write(cdate(2),'(a,i1)')'0',date2(2)`
72	`else`	74	`else`
73	`write(cdate(2),'(i2)')date2(2)`	75	`write(cdate(2),'(i2)')date2(2)`
74	`endif`	76	`endif`
75	`if (date2(3).lt.10) then`	77	`if (date2(3).lt.10) then`
76	`write(cdate(3),'(a,i1)')'0',date2(3)`	78	`write(cdate(3),'(a,i1)')'0',date2(3)`
77	`else`	79	`else`
78	`write(cdate(3),'(i2)')date2(3)`	80	`write(cdate(3),'(i2)')date2(3)`
79	`endif`	81	`endif`
80	`if (date2(4).lt.10) then`	82	`if (date2(4).lt.10) then`
81	`write(cdate(4),'(a,i1)')'0',date2(4)`	83	`write(cdate(4),'(a,i1)')'0',date2(4)`
82	`else`	84	`else`
83	`write(cdate(4),'(i2)')date2(4)`	85	`write(cdate(4),'(i2)')date2(4)`
84	`endif`	86	`endif`
85		87
86	`cdat=trim(yychar)//cdate(1)//cdate(2)//cdate(3)//'_'//cdate(4)`	88	`cdat=trim(yychar)//cdate(1)//cdate(2)//cdate(3)//'_'//cdate(4)`
87	`write(*,'(a)')trim(cdat)`	89	`write(*,'(a)')trim(cdat)`
88		90
89	`goto 200`	91	`goto 200`
90		92
91	`120 write(,)"* error: date must be in format (YY)YYMMDD_HH *"`	93	`120 write(,)"* error: date must be in format (YY)YYMMDD_HH *"`
92		94
93	`200 continue`	95	`200 continue`
94		96
95	`end`	97	`end`
96		98
97	`subroutine checkchar(string,char,flag)`	99	`subroutine checkchar(string,char,flag)`
98	`C ======================================`	100	`C ======================================`
99		101
100	`character() string`	102	`character() string`
101	`character*(1) char`	103	`character*(1) char`
102	`integer n,flag`	104	`integer n,flag`
103		105
104	`flag=0`	106	`flag=0`
105	`do n=1,len(string)`	107	`do n=1,len(string)`
106	`if (string(n:n).eq.char) then`	108	`if (string(n:n).eq.char) then`
107	`flag=n`	109	`flag=n`
108	`return`	110	`return`
109	`endif`	111	`endif`
110	`enddo`	112	`enddo`
111	`end`	113	`end`
112		114
113	`subroutine lenchar(string,lstr)`	115	`subroutine lenchar(string,lstr)`
114	`C ===============================`	116	`C ===============================`
115		117
116	`character() string`	118	`character() string`
117	`integer n,lstr`	119	`integer n,lstr`
118		120
119	`do n=1,len(string)`	121	`do n=1,len(string)`
120	`if (string(n:n).eq."") then`	122	`if (string(n:n).eq."") then`
121	`lstr=n-1`	123	`lstr=n-1`
122	`goto 100`	124	`goto 100`
123	`endif`	125	`endif`
124	`enddo`	126	`enddo`
125	`100 continue`	127	`100 continue`
126	`end`	128	`end`

Subversion Repositories lagranto.ecmwf

(root)/trunk/goodies/newtime.f – Rev 3 → 38