ungrib/src/geth_newdate.F

   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       logical noLeapCalendar
  57
  58
  59 !*************************  Subroutine Begin  *************************
  60
  61 !
  62 !  Determine whether the routine should use a no-leap year calendar
  63 !
  64       noLeapCalendar = .false.
  65
  66 #ifdef NO_LEAP_CALENDAR
  67       noLeapCalendar = .true.
  68 #endif
  69
  70
  71 !
  72 !  Assign the number of days in a months
  73 !
  74
  75       mday( 1) = 31
  76       mday( 2) = 28
  77       mday( 3) = 31
  78       mday( 4) = 30
  79       mday( 5) = 31
  80       mday( 6) = 30
  81       mday( 7) = 31
  82       mday( 8) = 31
  83       mday( 9) = 30
  84       mday(10) = 31
  85       mday(11) = 30
  86       mday(12) = 31
  87
  88 !
  89 !  Break down old hdate into parts
  90 !
  91       hrold = 0
  92       miold = 0
  93       scold = 0
  94       olen = len(odate)
  95
  96       read(odate(1:4),  '(I4)') yrold
  97       read(odate(6:7),  '(I2)') moold
  98       read(odate(9:10), '(I2)') dyold
  99       if (olen.ge.13) then
 100          read(odate(12:13),'(I2)') hrold
 101          if (olen.ge.16) then
 102             read(odate(15:16),'(I2)') miold
 103             if (olen.ge.19) then
 104                read(odate(18:19),'(I2)') scold
 105             endif
 106          endif
 107       endif
 108 !
 109 !  Set the number of days in February for that year.
 110 !
 111       mday(2) = 28
 112       if (.not. noLeapCalendar) then
 113          if (mod(yrold,4).eq.0) then
 114             mday(2) = 29
 115             if (mod(yrold,100).eq.0) then
 116                mday(2) = 28
 117                if (mod(yrold,400).eq.0) then
 118                   mday(2) = 29
 119                endif
 120             endif
 121          endif
 122       endif
 123 !
 124 !  Check that ODATE makes sense.
 125 !
 126       opass = .TRUE.
 127
 128 !  Check that the month of ODATE makes sense.
 129
 130       if ((moold.gt.12).or.(moold.lt.1)) then
 131          print*, 'GETH_NEWDATE:  Month of ODATE = ', moold
 132          opass = .FALSE.
 133       endif
 134
 135 !  Check that the day of ODATE makes sense.
 136
 137       if ((dyold.gt.mday(moold)).or.(dyold.lt.1)) then
 138
 139          !
 140          ! Send a custom message if any leap-day files if it is a No-Leap Calendar
 141          !
 142          if (noLeapCalendar .and. (moold .eq. 2) .and. (dyold .eq. 29)) then
 143             print*,'GET_NEWDATE:  Using a no-Leap Calendar, but data for 2/29 was found.'
 144          else
 145             print*, 'GET_NEWDATE:  Day of ODATE = ', dyold
 146          endif
 147
 148             opass = .FALSE.
 149       endif
 150
 151 !  Check that the hour of ODATE makes sense.
 152
 153       if ((hrold.gt.23).or.(hrold.lt.0)) then
 154          print*, 'GET_NEWDATE:  Hour of ODATE = ', hrold
 155          opass = .FALSE.
 156       endif
 157
 158 !  Check that the minute of ODATE makes sense.
 159
 160       if ((miold.gt.59).or.(miold.lt.0)) then
 161          print*, 'GET_NEWDATE:  Minute of ODATE = ', miold
 162          opass = .FALSE.
 163       endif
 164
 165 !  Check that the second of ODATE makes sense.
 166
 167       if ((scold.gt.59).or.(scold.lt.0)) then
 168          print*, 'GET_NEWDATE:  Second of ODATE = ', scold
 169          opass = .FALSE.
 170       endif
 171
 172       if (.not.opass) then
 173          print*, 'Crazy ODATE: ', odate(1:olen), olen
 174          STOP 'Error_odate'
 175 !        stop
 176       endif
 177 !
 178 !  Date Checks are completed.  Continue.
 179 !
 180
 181 !
 182 !  Compute the number of days, hours, minutes, and seconds in idts
 183 !
 184       nday   = idts/86400  ! Integer number of days in delta-time
 185       nhour   = mod(idts,86400)/3600
 186       nmin   = mod(idts,3600)/60
 187       nsec   = mod(idts,60)
 188
 189       scnew = scold + nsec
 190       if (scnew .ge. 60) then
 191          scnew = scnew - 60
 192          nmin  = nmin + 1
 193       end if
 194       minew = miold + nmin
 195       if (minew .ge. 60) then
 196          minew = minew - 60
 197          nhour  = nhour + 1
 198       end if
 199       hrnew = hrold + nhour
 200       if (hrnew .ge. 24) then
 201          hrnew = hrnew - 24
 202          nday  = nday + 1
 203       end if
 204
 205       dynew = dyold
 206       monew = moold
 207       yrnew = yrold
 208       do i = 1, nday
 209          dynew = dynew + 1
 210          if (dynew.gt.mday(monew)) then
 211             dynew = dynew - mday(monew)
 212             monew = monew + 1
 213             if (monew .gt. 12) then
 214                monew = 1
 215                yrnew = yrnew + 1
 216
 217                mday(2) = 28
 218                if (.not. noLeapCalendar) then
 219                   if (mod(yrnew,4).eq.0) then
 220                      mday(2) = 29
 221                      if (mod(yrnew,100).eq.0) then
 222                         mday(2) = 28
 223                         if (mod(yrnew,400).eq.0) then
 224                            mday(2) = 29
 225                         endif
 226                      endif
 227                   endif
 228                endif
 229
 230             end if
 231          endif
 232       enddo
 233
 234 !
 235 !  Now construct the new mdate
 236 !
 237       nlen = len(ndate)
 238
 239       if (nlen.ge.19) then
 240          write(ndate,19) yrnew, monew, dynew, hrnew, minew, scnew
 241  19      format(I4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2,':',I2.2)
 242
 243       else if (nlen.eq.16) then
 244          write(ndate,16) yrnew, monew, dynew, hrnew, minew
 245  16      format(I4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2)
 246
 247       else if (nlen.eq.13) then
 248          write(ndate,13) yrnew, monew, dynew, hrnew
 249  13      format(I4,'-',I2.2,'-',I2.2,'_',I2.2)
 250
 251       else if (nlen.eq.10) then
 252          write(ndate,10) yrnew, monew, dynew
 253  10      format(I4,'-',I2.2,'-',I2.2)
 254
 255       endif
 256
 257 !**************************  Subroutine End  **************************
 258
 259       end