WPS/ungrib/src/geth_newdate.F90

   1       subroutine geth_newdate (ndate, odate, idts)
   2       implicit none
   3
   4 !**********************************************************************
   5 !
   6 !  purpose      -  from old date ('YYYY-MM-DD*HH:MM:SS') and time in
   7 !                  seconds, compute the new date.
   8 !
   9 !  on entry     -  odate  -  the old hdate.
  10 !                  idts   -  the change in time in seconds.
  11 !
  12 !  on exit      -  ndate  -  the new hdate.
  13 !                  idts    -  the change in time in seconds.
  14 !
  15 !**********************************************************************
  16
  17       integer idts
  18       character*(*) ndate, odate
  19       integer nlen, olen
  20
  21 !
  22 !  Local Variables
  23 !
  24 !  yrold    -  indicates the year associated with "odate"
  25 !  moold    -  indicates the month associated with "odate"
  26 !  dyold    -  indicates the day associated with "odate"
  27 !  hrold    -  indicates the hour associated with "odate"
  28 !  miold    -  indicates the minute associated with "odate"
  29 !  scold    -  indicates the second associated with "odate"
  30 !
  31 !  yrnew    -  indicates the year associated with "ndate"
  32 !  monew    -  indicates the month associated with "ndate"
  33 !  dynew    -  indicates the day associated with "ndate"
  34 !  hrnew    -  indicates the hour associated with "ndate"
  35 !  minew    -  indicates the minute associated with "ndate"
  36 !  scnew    -  indicates the second associated with "ndate"
  37 !
  38 !  mday     -  a list assigning the number of days in each month
  39
  40 !  dth      -  the number of hours represented by "idts"
  41 !  i        -  loop counter
  42 !  nday     -  the integer number of days represented by "idts"
  43 !  nhour    -  the integer number of hours in "idts" after taking out
  44 !              all the whole days
  45 !  nmin     -  the integer number of minutes in "idts" after taking out
  46 !              all the whole days and whole hours.
  47 !  nsec     -  the integer number of minutes in "idts" after taking out
  48 !              all the whole days, whole hours, and whole minutes.
  49 !
  50
  51       integer yrnew, monew, dynew, hrnew, minew, scnew
  52       integer yrold, moold, dyold, hrold, miold, scold
  53       integer mday(12), nday, nhour, nmin, nsec, i
  54       real    dth
  55       logical opass
  56
  57 !*************************  Subroutine Begin  *************************
  58
  59 !
  60 !  Assign the number of days in a months
  61 !
  62
  63       mday( 1) = 31
  64       mday( 2) = 28
  65       mday( 3) = 31
  66       mday( 4) = 30
  67       mday( 5) = 31
  68       mday( 6) = 30
  69       mday( 7) = 31
  70       mday( 8) = 31
  71       mday( 9) = 30
  72       mday(10) = 31
  73       mday(11) = 30
  74       mday(12) = 31
  75
  76 !
  77 !  Break down old hdate into parts
  78 !
  79       hrold = 0
  80       miold = 0
  81       scold = 0
  82       olen = len(odate)
  83
  84       read(odate(1:4),  '(I4)') yrold
  85       read(odate(6:7),  '(I2)') moold
  86       read(odate(9:10), '(I2)') dyold
  87       if (olen.ge.13) then
  88          read(odate(12:13),'(I2)') hrold
  89          if (olen.ge.16) then
  90             read(odate(15:16),'(I2)') miold
  91             if (olen.ge.19) then
  92                read(odate(18:19),'(I2)') scold
  93             endif
  94          endif
  95       endif
  96 !
  97 !  Set the number of days in February for that year.
  98 !
  99       mday(2) = 28
 100       if (mod(yrold,4).eq.0) then
 101          mday(2) = 29
 102          if (mod(yrold,100).eq.0) then
 103             mday(2) = 28
 104             if (mod(yrold,400).eq.0) then
 105                mday(2) = 29
 106             endif
 107          endif
 108       endif
 109 !
 110 !  Check that ODATE makes sense.
 111 !
 112       opass = .TRUE.
 113
 114 !  Check that the month of ODATE makes sense.
 115
 116       if ((moold.gt.12).or.(moold.lt.1)) then
 117          print*, 'GETH_NEWDATE:  Month of ODATE = ', moold
 118          opass = .FALSE.
 119       endif
 120
 121 !  Check that the day of ODATE makes sense.
 122
 123       if ((dyold.gt.mday(moold)).or.(dyold.lt.1)) then
 124          print*, 'GET_NEWDATE:  Day of ODATE = ', dyold
 125          opass = .FALSE.
 126       endif
 127
 128 !  Check that the hour of ODATE makes sense.
 129
 130       if ((hrold.gt.23).or.(hrold.lt.0)) then
 131          print*, 'GET_NEWDATE:  Hour of ODATE = ', hrold
 132          opass = .FALSE.
 133       endif
 134
 135 !  Check that the minute of ODATE makes sense.
 136
 137       if ((miold.gt.59).or.(miold.lt.0)) then
 138          print*, 'GET_NEWDATE:  Minute of ODATE = ', miold
 139          opass = .FALSE.
 140       endif
 141
 142 !  Check that the second of ODATE makes sense.
 143
 144       if ((scold.gt.59).or.(scold.lt.0)) then
 145          print*, 'GET_NEWDATE:  Second of ODATE = ', scold
 146          opass = .FALSE.
 147       endif
 148
 149       if (.not.opass) then
 150          print*, 'Crazy ODATE: ', odate(1:olen), olen
 151          STOP 'Error_odate'
 152 !        stop
 153       endif
 154 !
 155 !  Date Checks are completed.  Continue.
 156 !
 157
 158 !
 159 !  Compute the number of days, hours, minutes, and seconds in idts
 160 !
 161       nday   = idts/86400  ! Integer number of days in delta-time
 162       nhour   = mod(idts,86400)/3600
 163       nmin   = mod(idts,3600)/60
 164       nsec   = mod(idts,60)
 165
 166       scnew = scold + nsec
 167       if (scnew .ge. 60) then
 168          scnew = scnew - 60
 169          nmin  = nmin + 1
 170       end if
 171       minew = miold + nmin
 172       if (minew .ge. 60) then
 173          minew = minew - 60
 174          nhour  = nhour + 1
 175       end if
 176       hrnew = hrold + nhour
 177       if (hrnew .ge. 24) then
 178          hrnew = hrnew - 24
 179          nday  = nday + 1
 180       end if
 181
 182       dynew = dyold
 183       monew = moold
 184       yrnew = yrold
 185       do i = 1, nday
 186          dynew = dynew + 1
 187          if (dynew.gt.mday(monew)) then
 188             dynew = dynew - mday(monew)
 189             monew = monew + 1
 190             if (monew .gt. 12) then
 191                monew = 1
 192                yrnew = yrnew + 1
 193
 194                mday(2) = 28
 195                if (mod(yrnew,4).eq.0) then
 196                   mday(2) = 29
 197                   if (mod(yrnew,100).eq.0) then
 198                      mday(2) = 28
 199                      if (mod(yrnew,400).eq.0) then
 200                         mday(2) = 29
 201                      endif
 202                   endif
 203                endif
 204
 205             end if
 206          endif
 207       enddo
 208 !
 209 !  Now construct the new mdate
 210 !
 211       nlen = len(ndate)
 212
 213       if (nlen.ge.19) then
 214          write(ndate,19) yrnew, monew, dynew, hrnew, minew, scnew
 215  19      format(I4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2,':',I2.2)
 216
 217       else if (nlen.eq.16) then
 218          write(ndate,16) yrnew, monew, dynew, hrnew, minew
 219  16      format(I4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2)
 220
 221       else if (nlen.eq.13) then
 222          write(ndate,13) yrnew, monew, dynew, hrnew
 223  13      format(I4,'-',I2.2,'-',I2.2,'_',I2.2)
 224
 225       else if (nlen.eq.10) then
 226          write(ndate,10) yrnew, monew, dynew
 227  10      format(I4,'-',I2.2,'-',I2.2)
 228
 229       endif
 230
 231 !**************************  Subroutine End  **************************
 232
 233       end