Subversion Repositories lagranto.ocean

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
      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
      if ((date2(1).lt.date1(1)).and.
47
     >    (diff.gt.0.).and.
48
     >    (yychar.eq.'19')) yychar='20'
49
 
50
c      if ((date2(1).lt.date1(1)).and.
51
c     >    (diff.gt.0.).and.
52
c     >    (yychar.eq.'20')) yychar='21'
53
 
54
      if (date2(1).lt.0) date2(1)=date2(1)+100
55
 
56
      if ((date2(1).gt.date1(1)).and.
57
     >    (diff.lt.0.).and.
58
     >    (yychar.eq.'20')) yychar='19'
59
 
60
c      if ((date2(1).gt.date1(1)).and.
61
c     >    (diff.lt.0.).and.
62
c     >    (yychar.eq.'21')) yychar='20'
63
 
64
 
65
      if (date2(1).lt.10) then
66
        write(cdate(1),'(a,i1)')'0',date2(1)
67
      else
68
        write(cdate(1),'(i2)')date2(1)
69
      endif
70
      if (date2(2).lt.10) then
71
        write(cdate(2),'(a,i1)')'0',date2(2)
72
      else
73
        write(cdate(2),'(i2)')date2(2)
74
      endif
75
      if (date2(3).lt.10) then
76
        write(cdate(3),'(a,i1)')'0',date2(3)
77
      else
78
        write(cdate(3),'(i2)')date2(3)
79
      endif
80
      if (date2(4).lt.10) then
81
        write(cdate(4),'(a,i1)')'0',date2(4)
82
      else
83
        write(cdate(4),'(i2)')date2(4)
84
      endif
85
 
86
      cdat=trim(yychar)//cdate(1)//cdate(2)//cdate(3)//'_'//cdate(4)
87
      write(*,'(a)')trim(cdat)
88
 
89
      goto 200
90
 
91
 120  write(*,*)"*** error: date must be in format (YY)YYMMDD_HH ***"
92
 
93
 200  continue
94
 
95
      end
96
 
97
      subroutine checkchar(string,char,flag)
98
C     ======================================
99
 
100
      character*(*)	string
101
      character*(1)	char
102
      integer	n,flag
103
 
104
      flag=0
105
      do n=1,len(string)
106
        if (string(n:n).eq.char) then
107
          flag=n
108
          return
109
        endif
110
      enddo
111
      end
112
 
113
      subroutine lenchar(string,lstr)
114
C     ===============================
115
 
116
      character*(*)     string
117
      integer   n,lstr
118
 
119
      do n=1,len(string)
120
        if (string(n:n).eq."") then
121
          lstr=n-1
122
          goto 100
123
        endif
124
      enddo
125
 100  continue
126
      end