<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='STRCPT'><A href='../../html_code/bufr/strcpt.f.html#STRCPT' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE STRCPT(CF,IYR,IMO,IDY,IHR,IMI) 1,3
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: STRCPT
C PRGMMR: ATOR ORG: NP12 DATE: 2009-03-23
C
C ABSTRACT: THIS SUBROUTINE CAN BE CALLED AT ANY TIME AFTER THE FIRST
C CALL TO BUFR ARCHIVE LIBRARY SUBROUTINE OPENBF. WHEN CF IS SET TO
C 'Y' (= 'YES'), THIS SUBROUTINE IS USED TO SPECIFY A TANK RECEIPT
C TIME THAT WILL BE APPENDED TO SECTION 1 OF ALL FUTURE BUFR MESSAGES
C OUTPUT BY ANY OF THE BUFR ARCHIVE LIBRARY SUBROUTINES WHICH WRITE
C SUCH MESSAGES (E.G. WRITSB, COPYMG, WRITSA, ETC.). WHEN CF IS SET
C TO 'N' (= 'NO', WHICH IS THE DEFAULT), THIS CAPABILITY IS TURNED OFF
C (IF IT WAS PREVIOUSLY TURNED ON) AND THE VALUES IN ALL OF THE OTHER
C INPUT ARGUMENTS ARE IGNORED. THE TANK RECEIPT TIME IS A LOCAL
C EXTENSION TO SECTION 1; HOWEVER, ITS INCLUSION IN A MESSAGE IS
C STILL FULLY COMPLIANT WITH THE WMO FM-94 BUFR REGULATIONS.
C
C PROGRAM HISTORY LOG:
C 2009-03-23 J. ATOR -- ORIGINAL AUTHOR
C
C USAGE: CALL STRCPT
(CF,IYR,IMO,IDY,IHR,IMI)
C INPUT ARGUMENT LIST:
C CF - CHARACTER*1: FLAG INDICATING WHETHER FUTURE CALLS TO
C BUFRLIB MESSAGE WRITING ROUTINES (E.G. WRITSB, COPYMG,
C WRITSA, ETC.) SHOULD APPEND THE GIVEN TANK RECEIPT
C TIME TO SECTION 1 OF SUCH MESSAGES:
C 'N' = 'NO' (THE DEFAULT)
C 'Y' = 'YES'
C IYR - INTEGER: TANK RECEIPT YEAR TO BE STORED
C IMO - INTEGER: TANK RECEIPT MONTH TO BE STORED
C IDY - INTEGER: TANK RECEIPT DAY TO BE STORED
C IHR - INTEGER: TANK RECEIPT HOUR TO BE STORED
C IMI - INTEGER: TANK RECEIPT MINUTE TO BE STORED
C
C REMARKS:
C THIS ROUTINE CALLS: BORT CAPIT
C THIS ROUTINE IS CALLED BY: None
C Normally called only by application
C programs.
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C MACHINE: PORTABLE TO ALL PLATFORMS
C
C$$$
COMMON /TNKRCP/ ITRYR,ITRMO,ITRDY,ITRHR,ITRMI,CTRT
CHARACTER*128 BORT_STR
CHARACTER*1 CTRT, CF
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
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