ungrib/src/geth_idts.F

   1       subroutine geth_idts (ndate, odate, idts)
   2       implicit none
   3
   4 !***********************************************************************
   5 !
   6 !  purpose      -  from 2 input mdates ('YYYY-MM-DD HH:MM:SS'), compute
   7 !                  the time difference in seconds.
   8 !
   9 !  on entry     -  ndate  -  the new hdate.
  10 !                  odate  -  the old hdate.
  11 !
  12 !  on exit      -  idts    -  the change in time in seconds.
  13 !
  14 !***********************************************************************
  15
  16       character*(*) ndate, odate
  17       character*19 tdate
  18       integer idts
  19       integer olen, nlen
  20 !
  21 !  Local Variables
  22 !
  23 !  yrnew    -  indicates the year associated with "ndate"
  24 !  yrold    -  indicates the year associated with "odate"
  25 !  monew    -  indicates the month associated with "ndate"
  26 !  moold    -  indicates the month associated with "odate"
  27 !  dynew    -  indicates the day associated with "ndate"
  28 !  dyold    -  indicates the day associated with "odate"
  29 !  hrnew    -  indicates the hour associated with "ndate"
  30 !  hrold    -  indicates the hour associated with "odate"
  31 !  minew    -  indicates the minute associated with "ndate"
  32 !  miold    -  indicates the minute associated with "odate"
  33 !  scnew    -  indicates the second associated with "ndate"
  34 !  scold    -  indicates the second associated with "odate"
  35 !  i        -  loop counter
  36 !  mday     -  a list assigning the number of days in each month
  37 !  newhrs   -  the number of hours between "ndate" and 1901
  38 !              whole 24 hour days
  39 !  oldhrs   -  the number of hours between "odate" and 1901
  40 !
  41
  42       integer yrnew, monew, dynew, hrnew, minew, scnew
  43       integer yrold, moold, dyold, hrold, miold, scold
  44       integer mday(12), i, newdys, olddys
  45       logical npass, opass
  46       integer isign
  47
  48 ! External function:
  49       integer, external :: nfeb
  50
  51 !*************************  Subroutine Begin  **************************
  52
  53       if (odate.gt.ndate) then
  54          isign = -1
  55          tdate=ndate
  56          ndate=odate
  57          odate=tdate
  58       else
  59          isign = 1
  60       endif
  61
  62 !
  63 !  Assign the number of days in a months
  64 !
  65
  66       mday( 1) = 31
  67       mday( 2) = 28
  68       mday( 3) = 31
  69       mday( 4) = 30
  70       mday( 5) = 31
  71       mday( 6) = 30
  72       mday( 7) = 31
  73       mday( 8) = 31
  74       mday( 9) = 30
  75       mday(10) = 31
  76       mday(11) = 30
  77       mday(12) = 31
  78
  79 !
  80 !  Break down old hdate into parts
  81 !
  82       hrold = 0
  83       miold = 0
  84       scold = 0
  85       olen = len(odate)
  86
  87       read(odate(1:4),  '(I4)', err=101) yrold
  88       read(odate(6:7),  '(I2)', err=101) moold
  89       read(odate(9:10), '(I2)', err=101) dyold
  90       if (olen.ge.13) then
  91          read(odate(12:13),'(I2)', err=101) hrold
  92          if (olen.ge.16) then
  93             read(odate(15:16),'(I2)', err=101) miold
  94             if (olen.ge.19) then
  95                read(odate(18:19),'(I2)', err=101) scold
  96             endif
  97          endif
  98       endif
  99
 100 !
 101 !  Break down new hdate into parts
 102 !
 103       hrnew = 0
 104       minew = 0
 105       scnew = 0
 106       nlen = len(ndate)
 107
 108       read(ndate(1:4),  '(I4)', err=102) yrnew
 109       read(ndate(6:7),  '(I2)', err=102) monew
 110       read(ndate(9:10), '(I2)', err=102) dynew
 111       if (nlen.ge.13) then
 112          read(ndate(12:13),'(I2)', err=102) hrnew
 113          if (nlen.ge.16) then
 114             read(ndate(15:16),'(I2)', err=102) minew
 115             if (nlen.ge.19) then
 116                read(ndate(18:19),'(I2)', err=102) scnew
 117             endif
 118          endif
 119       endif
 120
 121 !
 122 !  Check that the dates make sense.
 123 !
 124       npass = .true.
 125       opass = .true.
 126
 127 !  Check that the month of NDATE makes sense.
 128
 129       if ((monew.gt.12).or.(monew.lt.1)) then
 130          print*, 'GETH_IDTS:  Month of NDATE = ', monew
 131          npass = .false.
 132       endif
 133
 134 !  Check that the month of ODATE makes sense.
 135
 136       if ((moold.gt.12).or.(moold.lt.1)) then
 137          print*, 'GETH_IDTS:  Month of ODATE = ', moold
 138          opass = .false.
 139       endif
 140
 141 !  Check that the day of NDATE makes sense.
 142
 143       if (monew.ne.2) then
 144 ! ...... For all months but February
 145          if ((dynew.gt.mday(monew)).or.(dynew.lt.1)) then
 146             print*, 'GETH_IDTS:  Day of NDATE = ', dynew
 147             npass = .false.
 148          endif
 149       elseif (monew.eq.2) then
 150 ! ...... For February
 151          if ((dynew .gt. nfeb(yrnew)).or.(dynew.lt.1)) then
 152             print*, 'GETH_IDTS:  Day of NDATE = ', dynew
 153             npass = .false.
 154          endif
 155       endif
 156
 157 !  Check that the day of ODATE makes sense.
 158
 159       if (moold.ne.2) then
 160 ! ...... For all months but February
 161          if ((dyold.gt.mday(moold)).or.(dyold.lt.1)) then
 162             print*, 'GETH_IDTS:  Day of ODATE = ', dyold
 163             opass = .false.
 164          endif
 165       elseif (moold.eq.2) then
 166 ! ....... For February
 167          if ((dyold .gt. nfeb(yrold)).or.(dyold .lt. 1)) then
 168             print*, 'GETH_IDTS:  Day of ODATE = ', dyold
 169             opass = .false.
 170          endif
 171       endif
 172
 173 !  Check that the hour of NDATE makes sense.
 174
 175       if ((hrnew.gt.23).or.(hrnew.lt.0)) then
 176          print*, 'GETH_IDTS:  Hour of NDATE = ', hrnew
 177          npass = .false.
 178       endif
 179
 180 !  Check that the hour of ODATE makes sense.
 181
 182       if ((hrold.gt.23).or.(hrold.lt.0)) then
 183          print*, 'GETH_IDTS:  Hour of ODATE = ', hrold
 184          opass = .false.
 185       endif
 186
 187 !  Check that the minute of NDATE makes sense.
 188
 189       if ((minew.gt.59).or.(minew.lt.0)) then
 190          print*, 'GETH_IDTS:  Minute of NDATE = ', minew
 191          npass = .false.
 192       endif
 193
 194 !  Check that the minute of ODATE makes sense.
 195
 196       if ((miold.gt.59).or.(miold.lt.0)) then
 197          print*, 'GETH_IDTS:  Minute of ODATE = ', miold
 198          opass = .false.
 199       endif
 200 !
 201 !  Check that the second of NDATE makes sense.
 202 !
 203       if ((scnew.gt.59).or.(scnew.lt.0)) then
 204          print*, 'GETH_IDTS:  SECOND of NDATE = ', scnew
 205          npass = .false.
 206       endif
 207
 208 !  Check that the second of ODATE makes sense.
 209
 210       if ((scold.gt.59).or.(scold.lt.0)) then
 211          print*, 'GETH_IDTS:  Second of ODATE = ', scold
 212          opass = .false.
 213       endif
 214
 215       if (.not. npass) then
 216          print*, 'Screwy NDATE: ', ndate(1:nlen)
 217          STOP 'Error_ndate'
 218       endif
 219
 220       if (.not. opass) then
 221          print*, 'Screwy ODATE: ', odate(1:olen)
 222          STOP 'Error_odate'
 223       endif
 224 !
 225 !  Date Checks are completed.  Continue.
 226 !
 227
 228 !
 229 !  Compute number of days from 1 January ODATE, 00:00:00 until ndate
 230 !  Compute number of hours from 1 January ODATE, 00:00:00 until ndate
 231 !  Compute number of minutes from 1 January ODATE, 00:00:00 until ndate
 232 !
 233
 234       newdys = 0
 235       do i = yrold, yrnew - 1
 236          newdys = newdys + (365 + (nfeb(i)-28))
 237       enddo
 238
 239       if (monew .gt. 1) then
 240          mday(2) = nfeb(yrnew)
 241          do i = 1, monew - 1
 242             newdys = newdys + mday(i)
 243          enddo
 244          mday(2) = 28
 245       end if
 246
 247       newdys = newdys + dynew-1
 248 !
 249 !  Compute number of hours from 1 January ODATE, 00:00:00 until odate
 250 !  Compute number of minutes from 1 January ODATE, 00:00:00 until odate
 251 !
 252
 253       olddys = 0
 254
 255       if (moold .gt. 1) then
 256          mday(2) = nfeb(yrold)
 257          do i = 1, moold - 1
 258             olddys = olddys + mday(i)
 259          enddo
 260          mday(2) = 28
 261       end if
 262
 263       olddys = olddys + dyold-1
 264 !
 265 !  Determine the time difference in seconds
 266 !
 267       idts = (newdys - olddys) * 86400
 268       idts = idts + (hrnew - hrold) * 3600
 269       idts = idts + (minew - miold) * 60
 270       idts = idts + (scnew - scold)
 271
 272       if (isign .eq. -1) then
 273          tdate=ndate
 274          ndate=odate
 275          odate=tdate
 276          idts = idts * isign
 277       endif
 278
 279
 280       return
 281   101 write(6,*) 'Error reading odate. odate = ',odate
 282       write(6,*) 'Most likely an error in namelist.wps'
 283       stop 'geth_idts 101'
 284   102 write(6,*) 'Error reading ndate. ndate = ',ndate
 285       write(6,*) 'Most likely an error in namelist.wps'
 286       stop 'geth_idts 102'
 287
 288 !**************************  Subroutine End  ***************************
 289
 290       end
 291       integer function nfeb(year)
 292 !
 293 ! Compute the number of days in February for the given year.
 294 !
 295         implicit none
 296         integer, intent(in) :: year ! Four-digit year
 297
 298         nfeb = 28 ! By default, February has 28 days ...
 299         if (mod(year,4).eq.0) then
 300            nfeb = 29  ! But every four years, it has 29 days ...
 301            if (mod(year,100).eq.0) then
 302               nfeb = 28  ! Except every 100 years, when it has 28 days ...
 303               if (mod(year,400).eq.0) then
 304                  nfeb = 29  ! Except every 400 years, when it has 29 days ...
 305                  if (mod(year,3600).eq.0) then
 306                     nfeb = 28  ! Except every 3600 years, when it has 28 days.
 307                  endif
 308               endif
 309            endif
 310         endif
 311       end function nfeb