var/external/bufr/ufbmns.f

   1       SUBROUTINE UFBMNS(IREP,SUBSET,IDATE)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    UFBMNS
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE READS A PARTICULAR SUBSET INTO INTERNAL
   9 C   SUBSET ARRAYS FROM A COLLECTION OF BUFR MESSAGES IN INTERNAL MEMORY
  10 C   BASED ON THE SUBSET NUMBER RELATIVE TO THE TOTAL NUMBER OF SUBSETS
  11 C   IN THE COLLECTION.  THE SUBROUTINE DOES NOT RETURN ANY INFORMATION
  12 C   ABOUT WHICH MESSAGE NUMBER CONTAINED THE DESIRED SUBSET.  IF THE
  13 C   REQUESTED SUBSET IS LARGER THAN THE TOTAL NUMBER OF SUBSETS IN
  14 C   MEMORY, THEN AN APPROPRIATE CALL IS MADE TO BUFR ARCHIVE LIBRARY
  15 C   SUBROUTINE BORT.
  16 C
  17 C PROGRAM HISTORY LOG:
  18 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  19 C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
  20 C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
  21 C                           ROUTINE "BORT"
  22 C 1999-11-18  J. WOOLLEN -- THE MAXIMUM NUMBER OF BYTES REQUIRED TO
  23 C                           STORE ALL MESSAGES INTERNALLY WAS INCREASED
  24 C                           FROM 4 MBYTES TO 8 MBYTES
  25 C 2001-08-15  D. KEYSER  -- PARAMETER MAXMEM (THE MAXIMUM NUMBER OF
  26 C                           BYTES REQUIRED TO STORE ALL MESSAGES
  27 C                           INTERNALLY) WAS INCREASED FROM 8 MBYTES TO
  28 C                           16 MBYTES
  29 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  30 C                           INTERDEPENDENCIES
  31 C 2003-11-04  D. KEYSER  -- PARAMETER MAXMSG (THE MAXIMUM NUMBER OF
  32 C                           BUFR MESSAGES WHICH CAN BE STORED
  33 C                           INTERNALLY) INCREASED FROM 50000 TO 200000;
  34 C                           UNIFIED/PORTABLE FOR WRF; ADDED
  35 C                           DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
  36 C                           MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
  37 C                           TERMINATES ABNORMALLY
  38 C 2004-11-15  D. KEYSER  -- PARAMETER MAXMEM (THE MAXIMUM NUMBER OF
  39 C                           BYTES REQUIRED TO STORE ALL MESSAGES
  40 C                           INTERNALLY) WAS INCREASED FROM 16 MBYTES TO
  41 C                           50 MBYTES
  42 C 2009-03-23  J. ATOR    -- USE IREADMM INSTEAD OF RDMEMM;
  43 C                           SIMPLIFY LOGIC
  44 C
  45 C USAGE:    CALL UFBMNS (IREP, SUBSET, IDATE)
  46 C   INPUT ARGUMENT LIST:
  47 C     IREP     - INTEGER: POINTER TO SUBSET NUMBER TO READ IN
  48 C                COLLECTION OF MESSAGES
  49 C
  50 C   OUTPUT ARGUMENT LIST:
  51 C     SUBSET   - CHARACTER*8: TABLE A MNEMONIC FOR BUFR MESSAGE
  52 C                CONTAINING SUBSET
  53 C     IDATE    - INTEGER: DATE-TIME FROM SECTION 1 OF BUFR MESSAGE
  54 C                CONTAINING SUBSET, IN FORMAT OF EITHER YYMMDDHH OR
  55 C                YYYYMMDDHH, DEPENDING ON DATELEN() VALUE
  56 C
  57 C REMARKS:
  58 C    NOTE THAT UFBMEM IS CALLED PRIOR TO THIS TO STORE THE BUFR
  59 C    MESSAGES INTO INTERNAL MEMORY.
  60 C
  61 C    THIS ROUTINE CALLS:        BORT     IREADMM  NMSUB    RDMEMS
  62 C    THIS ROUTINE IS CALLED BY: None
  63 C                               Normally called only by application
  64 C                               programs.
  65 C
  66 C ATTRIBUTES:
  67 C   LANGUAGE: FORTRAN 77
  68 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  69 C
  70 C$$$
  71
  72       INCLUDE 'bufrlib.prm'
  73
  74       COMMON /MSGMEM/ MUNIT,MLAST,MSGP(0:MAXMSG),MSGS(MAXMEM),
  75      .                MDX(MXDXW),IPDXM(MXDXM),LDXM,NDXM,LDXTS,NDXTS,
  76      .                IFDXTS(MXDXTS),ICDXTS(MXDXTS),IPMSGS(MXDXTS)
  77
  78       CHARACTER*128 BORT_STR
  79       CHARACTER*8   SUBSET
  80
  81 C-----------------------------------------------------------------------
  82 C-----------------------------------------------------------------------
  83
  84       JREP = 0
  85       IMSG = 1
  86
  87 C  READ SUBSET #ISUB FROM MEMORY MESSAGE #IMSG
  88 C  -------------------------------------------
  89
  90       DO WHILE(IREADMM(IMSG,SUBSET,IDATE).EQ.0)
  91         IF(JREP+NMSUB(MUNIT).GE.IREP) THEN
  92            CALL RDMEMS(IREP-JREP,IRET)
  93            GOTO 100
  94         ENDIF
  95         JREP = JREP+NMSUB(MUNIT)
  96       ENDDO
  97       GOTO 900
  98
  99 C  EXITS
 100 C  -----
 101
 102 100   RETURN
 103 900   WRITE(BORT_STR,'("BUFRLIB: UFBMNS - REQ. SUBSET NO. TO READ IN '//
 104      . '(",I5,") EXCEEDS TOTAL NO. OF SUBSETS IN THE COLLECTION OF '//
 105      . 'MEMORY MESSAGES (",I5,")")') IREP,JREP
 106       CALL BORT(BORT_STR)
 107       END