Subversion Repositories lagranto.wrf

Rev

Rev 2 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

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