hwrf-baseline-20120103-1354/ungrib/src/ngl/w3/w3reddat.f

   1       subroutine w3reddat(it,rinc,dinc)
   2 !$$$   SUBPROGRAM  DOCUMENTATION  BLOCK
   3 !
   4 ! SUBPROGRAM: W3REDDAT       REDUCE A TIME INTERVAL TO A CANONICAL FORM
   5 !   AUTHOR: MARK IREDELL     ORG: WP23       DATE: 98-01-05
   6 !
   7 ! ABSTRACT: THIS SUBPROGRAM REDUCES AN NCEP RELATIVE TIME INTERVAL
   8 !   INTO ONE OF SEVEN CANONICAL FORMS, DEPENDING ON THE INPUT IT VALUE.
   9 !
  10 !   First reduced format type (IT=-1):
  11 !        RINC(1) is an arbitrary integer.
  12 !        RINC(2) is an integer between 00 and 23, inclusive.
  13 !        RINC(3) is an integer between 00 and 59, inclusive.
  14 !        RINC(4) is an integer between 00 and 59, inclusive.
  15 !        RINC(5) is an integer between 000 and 999, inclusive.
  16 !      If RINC(1) is negative, then the time interval is negative.
  17 !
  18 !   Second reduced format type (IT=0):
  19 !      If the time interval is not negative, then the format is:
  20 !        RINC(1) is zero or a positive integer.
  21 !        RINC(2) is an integer between 00 and 23, inclusive.
  22 !        RINC(3) is an integer between 00 and 59, inclusive.
  23 !        RINC(4) is an integer between 00 and 59, inclusive.
  24 !        RINC(5) is an integer between 000 and 999, inclusive.
  25 !      Otherwise if the time interval is negative, then the format is:
  26 !        RINC(1) is zero or a negative integer.
  27 !        RINC(2) is an integer between 00 and -23, inclusive.
  28 !        RINC(3) is an integer between 00 and -59, inclusive.
  29 !        RINC(4) is an integer between 00 and -59, inclusive.
  30 !        RINC(5) is an integer between 000 and -999, inclusive.
  31 !
  32 !   Days format type (IT=1):
  33 !        RINC(1) is arbitrary.
  34 !        RINC(2) is zero.
  35 !        RINC(3) is zero.
  36 !        RINC(4) is zero.
  37 !        RINC(5) is zero.
  38 !
  39 !   Hours format type (IT=2):
  40 !        RINC(1) is zero.
  41 !        RINC(2) is arbitrary.
  42 !        RINC(3) is zero.
  43 !        RINC(4) is zero.
  44 !        RINC(5) is zero.
  45 !      (This format should not express time intervals longer than 300 years.)
  46 !
  47 !   Minutes format type (IT=3):
  48 !        RINC(1) is zero.
  49 !        RINC(2) is zero.
  50 !        RINC(3) is arbitrary.
  51 !        RINC(4) is zero.
  52 !        RINC(5) is zero.
  53 !      (This format should not express time intervals longer than five years.)
  54 !
  55 !   Seconds format type (IT=4):
  56 !        RINC(1) is zero.
  57 !        RINC(2) is zero.
  58 !        RINC(3) is zero.
  59 !        RINC(4) is arbitrary.
  60 !        RINC(5) is zero.
  61 !      (This format should not express time intervals longer than one month.)
  62 !
  63 !   Milliseconds format type (IT=5):
  64 !        RINC(1) is zero.
  65 !        RINC(2) is zero.
  66 !        RINC(3) is zero.
  67 !        RINC(4) is zero.
  68 !        RINC(5) is arbitrary.
  69 !     (This format should not express time intervals longer than one hour.)
  70 !
  71 ! PROGRAM HISTORY LOG:
  72 !   98-01-05  MARK IREDELL
  73 !
  74 ! USAGE:  CALL W3REDDAT(IT,RINC,DINC)
  75 !
  76 !   INPUT VARIABLES:
  77 !     IT         INTEGER RELATIVE TIME INTERVAL FORMAT TYPE
  78 !                (-1 FOR FIRST REDUCED TYPE (HOURS ALWAYS POSITIVE),
  79 !                 0 FOR SECOND REDUCED TYPE (HOURS CAN BE NEGATIVE),
  80 !                 1 FOR DAYS ONLY, 2 FOR HOURS ONLY, 3 FOR MINUTES ONLY,
  81 !                 4 FOR SECONDS ONLY, 5 FOR MILLISECONDS ONLY)
  82 !     RINC       REAL (5) NCEP RELATIVE TIME INTERVAL
  83 !                (DAYS, HOURS, MINUTES, SECONDS, MILLISECONDS)
  84 !
  85 !   OUTPUT VARIABLES:
  86 !     DINC       REAL (5) NCEP RELATIVE TIME INTERVAL
  87 !                (DAYS, HOURS, MINUTES, SECONDS, MILLISECONDS)
  88 !
  89 ! SUBPROGRAMS CALLED:
  90 !
  91 ! ATTRIBUTES:
  92 !   LANGUAGE: FORTRAN 90
  93 !
  94 !$$$
  95       real rinc(5),dinc(5)
  96 !  parameters for number of units in a day
  97 !  and number of milliseconds in a unit
  98 !  and number of next smaller units in a unit, respectively
  99       integer,dimension(5),parameter:: itd=(/1,24,1440,86400,86400000/),
 100      &                                 itm=itd(5)/itd
 101       integer,dimension(4),parameter:: itn=itd(2:5)/itd(1:4)
 102       integer,parameter:: np=16
 103       integer iinc(4),jinc(5),kinc(5)
 104 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 105 !  first reduce to the first reduced form
 106       iinc=floor(rinc(1:4))
 107 !  convert all positive fractional parts to milliseconds
 108 !  and determine canonical milliseconds
 109       jinc(5)=nint(dot_product(rinc(1:4)-iinc,real(itm(1:4)))+rinc(5))
 110       kinc(5)=modulo(jinc(5),itn(4))
 111 !  convert remainder to seconds and determine canonical seconds
 112       jinc(4)=iinc(4)+(jinc(5)-kinc(5))/itn(4)
 113       kinc(4)=modulo(jinc(4),itn(3))
 114 !  convert remainder to minutes and determine canonical minutes
 115       jinc(3)=iinc(3)+(jinc(4)-kinc(4))/itn(3)
 116       kinc(3)=modulo(jinc(3),itn(2))
 117 !  convert remainder to hours and determine canonical hours
 118       jinc(2)=iinc(2)+(jinc(3)-kinc(3))/itn(2)
 119       kinc(2)=modulo(jinc(2),itn(1))
 120 !  convert remainder to days and compute milliseconds of the day
 121       kinc(1)=iinc(1)+(jinc(2)-kinc(2))/itn(1)
 122       ms=dot_product(kinc(2:5),itm(2:5))
 123 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 124 !  next reduce to either single value canonical form
 125 !  or to one of the two reduced forms
 126       if(it.ge.1.and.it.le.5) then
 127 !  ensure that exact multiples of 1./np are expressed exactly
 128 !  (other fractions may have precision errors)
 129         rp=(np*ms)/itm(it)+mod(np*ms,itm(it))/real(itm(it))
 130         dinc=0
 131         dinc(it)=real(kinc(1))*itd(it)+rp/np
 132       else
 133 !  the reduced form is done except the second reduced form is modified
 134 !  for negative time intervals with fractional days
 135         dinc=kinc
 136         if(it.eq.0.and.kinc(1).lt.0.and.ms.gt.0) then
 137           dinc(1)=dinc(1)+1
 138           dinc(2:5)=mod(ms-itm(1),itm(1:4))/itm(2:5)
 139         endif
 140       endif
 141 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 142       end