Subversion Repositories lagranto.20cr

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

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