strcpt.f

Go to the documentation of this file.

C> @file
C> @brief Specify a tank receipt time to be included in Section 1
C> when writing BUFR messages.
C>
C> @author J. Ator @date 2009-03-23
 
C> This subroutine is used to specify a tank receipt time to be
C> included within Section 1 of all BUFR messages output by future calls
C> to [message-writing subroutines](@ref hierarchy) and
C> [subset-writing subroutines](@ref hierarchy).
C>
C> This subroutine can be called at any time after the first call
C> to subroutine openbf(), and the specified value for CF will remain
C> in effect for all future calls to
C> [message-writing subroutines](@ref hierarchy) and
C> [subset-writing subroutines](@ref hierarchy), for all Fortran logical
C> units that are open for output within the application program,
C> unless a subsequent call is made to this subroutine to reset the
C> value of CF again.  If this subroutine is never called, a default
C> value of 'N' is used for CF, as set within subroutine bfrini().
C>
C> Whenever this subroutine is called with CF = 'N', the values in
C> IYR, IMO, IDY, IHR, and IMI are ignored.
C>
C> @remarks
C> - Tank receipt time is an NCEP extension to Section 1 of the
C> [official WMO BUFR regulations](@ref manual).
C> However, it's encoded by the BUFRLIB software in such a way that
C> its inclusion within an output BUFR message is still fully
C> compliant with the regulations.
C>
C> @param[in] CF - character*1: Flag indicating whether future BUFR
C> output messages should include the tank receipt
C> time defined by IYR, IMO, IDY, IHR, and IMI:
C> - 'N' = No (the default)
C> - 'Y' = Yes
C> @param[in] IYR - integer: Tank receipt year.
C> @param[in] IMO - integer: Tank receipt month.
C> @param[in] IDY - integer: Tank receipt day.
C> @param[in] IHR - integer: Tank receipt hour.
C> @param[in] IMI - integer: Tank receipt minute.
C>
C> @author J. Ator @date 2009-03-23
      RECURSIVE SUBROUTINE strcpt(CF,IYR,IMO,IDY,IHR,IMI)
 
      USE modv_im8b
 
      COMMON /tnkrcp/ itryr,itrmo,itrdy,itrhr,itrmi,ctrt
 
      CHARACTER*128 bort_str
      CHARACTER*1   ctrt, cf
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  CHECK FOR I8 INTEGERS
C  ---------------------
 
      IF(im8b) THEN
         im8b=.false.
 
         CALL x84(iyr,my_iyr,1)
         CALL x84(imo,my_imo,1)
         CALL x84(idy,my_idy,1)
         CALL x84(ihr,my_ihr,1)
         CALL x84(imi,my_imi,1)
         CALL strcpt(cf,my_iyr,my_imo,my_idy,my_ihr,my_imi)
 
         im8b=.true.
         RETURN
      ENDIF
 
      CALL capit(cf)
      IF(cf.NE.'Y'.AND. cf.NE.'N') GOTO 900
 
      ctrt = cf
      IF(ctrt.EQ.'Y') THEN
        itryr = iyr
        itrmo = imo
        itrdy = idy
        itrhr = ihr
        itrmi = imi
      ENDIF
 
C  EXITS
C  -----
 
      RETURN
900   WRITE(bort_str,'("BUFRLIB: STRCPT - INPUT ARGUMENT IS ",A1,'//
     . '", IT MUST BE EITHER Y OR N")') cf
      CALL bort(bort_str)
      END