var/external/bufr/strcpt.f

   1       SUBROUTINE STRCPT(CF,IYR,IMO,IDY,IHR,IMI)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:   STRCPT
   6 C   PRGMMR: ATOR            ORG: NP12       DATE: 2009-03-23
   7 C
   8 C ABSTRACT: THIS SUBROUTINE CAN BE CALLED AT ANY TIME AFTER THE FIRST
   9 C   CALL TO BUFR ARCHIVE LIBRARY SUBROUTINE OPENBF.  WHEN CF IS SET TO
  10 C   'Y' (= 'YES'), THIS SUBROUTINE IS USED TO SPECIFY A TANK RECEIPT
  11 C   TIME THAT WILL BE APPENDED TO SECTION 1 OF ALL FUTURE BUFR MESSAGES
  12 C   OUTPUT BY ANY OF THE BUFR ARCHIVE LIBRARY SUBROUTINES WHICH WRITE
  13 C   SUCH MESSAGES (E.G. WRITSB, COPYMG, WRITSA, ETC.).  WHEN CF IS SET
  14 C   TO 'N' (= 'NO', WHICH IS THE DEFAULT), THIS CAPABILITY IS TURNED OFF
  15 C   (IF IT WAS PREVIOUSLY TURNED ON) AND THE VALUES IN ALL OF THE OTHER
  16 C   INPUT ARGUMENTS ARE IGNORED.  THE TANK RECEIPT TIME IS A LOCAL
  17 C   EXTENSION TO SECTION 1; HOWEVER, ITS INCLUSION IN A MESSAGE IS
  18 C   STILL FULLY COMPLIANT WITH THE WMO FM-94 BUFR REGULATIONS.
  19 C
  20 C PROGRAM HISTORY LOG:
  21 C 2009-03-23  J. ATOR    -- ORIGINAL AUTHOR
  22 C
  23 C USAGE:    CALL STRCPT (CF,IYR,IMO,IDY,IHR,IMI)
  24 C   INPUT ARGUMENT LIST:
  25 C     CF       - CHARACTER*1: FLAG INDICATING WHETHER FUTURE CALLS TO
  26 C                BUFRLIB MESSAGE WRITING ROUTINES (E.G. WRITSB, COPYMG,
  27 C                WRITSA, ETC.) SHOULD APPEND THE GIVEN TANK RECEIPT
  28 C                TIME TO SECTION 1 OF SUCH MESSAGES:
  29 C                       'N' = 'NO' (THE DEFAULT)
  30 C                       'Y' = 'YES'
  31 C     IYR      - INTEGER: TANK RECEIPT YEAR TO BE STORED
  32 C     IMO      - INTEGER: TANK RECEIPT MONTH TO BE STORED
  33 C     IDY      - INTEGER: TANK RECEIPT DAY TO BE STORED
  34 C     IHR      - INTEGER: TANK RECEIPT HOUR TO BE STORED
  35 C     IMI      - INTEGER: TANK RECEIPT MINUTE TO BE STORED
  36 C
  37 C REMARKS:
  38 C    THIS ROUTINE CALLS:        BORT     CAPIT
  39 C    THIS ROUTINE IS CALLED BY: None
  40 C                               Normally called only by application
  41 C                               programs.
  42 C
  43 C ATTRIBUTES:
  44 C   LANGUAGE: FORTRAN 77
  45 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  46 C
  47 C$$$
  48
  49       COMMON /TNKRCP/ ITRYR,ITRMO,ITRDY,ITRHR,ITRMI,CTRT
  50
  51       CHARACTER*128 BORT_STR
  52       CHARACTER*1   CTRT, CF
  53
  54 C-----------------------------------------------------------------------
  55 C-----------------------------------------------------------------------
  56
  57       CALL CAPIT(CF)
  58       IF(CF.NE.'Y'.AND. CF.NE.'N') GOTO 900
  59
  60       CTRT = CF
  61       IF(CTRT.EQ.'Y') THEN
  62         ITRYR = IYR
  63         ITRMO = IMO
  64         ITRDY = IDY
  65         ITRHR = IHR
  66         ITRMI = IMI
  67       ENDIF
  68
  69 C  EXITS
  70 C  -----
  71
  72       RETURN
  73 900   WRITE(BORT_STR,'("BUFRLIB: STRCPT - INPUT ARGUMENT IS ",A1,'//
  74      . '", IT MUST BE EITHER Y OR N")') CF
  75       CALL BORT(BORT_STR)
  76       END