Subversion Repositories lagranto.arpege

Rev

Details | Last modification | View Log | RSS feed

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