var/external/bufr/ufbmms.f

   1       SUBROUTINE UFBMMS(IMSG,ISUB,SUBSET,JDATE)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    UFBMMS
   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 PARTICULAR BUFR MESSAGE IN INTERNAL MEMORY
  10 C   BASED ON THE SUBSET NUMBER IN THE MESSAGE AND THE MESSAGE NUMBER IN
  11 C   INTERNAL MEMORY.  THIS SUBROUTINE IS ACTUALLY A COMBINATION OF
  12 C   BUFR ARCHIVE LIBRARY SUBROUTINES RDMEMM AND RDMEMS.
  13 C
  14 C PROGRAM HISTORY LOG:
  15 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  16 C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
  17 C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
  18 C                           ROUTINE "BORT"
  19 C 1999-11-18  J. WOOLLEN -- THE MAXIMUM NUMBER OF BYTES REQUIRED TO
  20 C                           STORE ALL MESSAGES INTERNALLY WAS INCREASED
  21 C                           FROM 4 MBYTES TO 8 MBYTES
  22 C 2001-08-15  D. KEYSER  -- PARAMETER MAXMEM (THE MAXIMUM NUMBER OF
  23 C                           BYTES REQUIRED TO STORE ALL MESSAGES
  24 C                           INTERNALLY) WAS INCREASED FROM 8 MBYTES TO
  25 C                           16 MBYTES
  26 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  27 C                           INTERDEPENDENCIES
  28 C 2003-11-04  D. KEYSER  -- PARAMETER MAXMSG (THE MAXIMUM NUMBER OF
  29 C                           BUFR MESSAGES WHICH CAN BE STORED
  30 C                           INTERNALLY) INCREASED FROM 50000 TO 200000;
  31 C                           UNIFIED/PORTABLE FOR WRF; ADDED
  32 C                           DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
  33 C                           MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
  34 C                           TERMINATES ABNORMALLY
  35 C 2004-11-15  D. KEYSER  -- PARAMETER MAXMEM (THE MAXIMUM NUMBER OF
  36 C                           BYTES REQUIRED TO STORE ALL MESSAGES
  37 C                           INTERNALLY) WAS INCREASED FROM 16 MBYTES TO
  38 C                           50 MBYTES
  39 C
  40 C USAGE:    CALL UFBMMS (IMSG, ISUB, SUBSET, JDATE)
  41 C   INPUT ARGUMENT LIST:
  42 C     IMSG     - INTEGER: POINTER TO BUFR MESSAGE NUMBER (RECORD) IN
  43 C                STORAGE
  44 C     ISUB     - INTEGER: POINTER TO SUBSET NUMBER TO READ IN BUFR
  45 C                MESSAGE
  46 C
  47 C   OUTPUT ARGUMENT LIST:
  48 C     SUBSET   - CHARACTER*8: TABLE A MNEMONIC FOR BUFR MESSAGE
  49 C                CONTAINING SUBSET
  50 C     JDATE    - INTEGER: DATE-TIME FROM SECTION 1 OF BUFR MESSAGE
  51 C                CONTAINING SUBSET, IN FORMAT OF EITHER YYMMDDHH OR
  52 C                YYYYMMDDHH, DEPENDING ON DATELEN() VALUE
  53 C
  54 C REMARKS:
  55 C    NOTE THAT UFBMEM IS CALLED PRIOR TO THIS TO STORE THE BUFR
  56 C    MESSAGES INTO INTERNAL MEMORY.
  57 C
  58 C    THIS ROUTINE CALLS:        BORT     RDMEMM   RDMEMS   STATUS
  59 C    THIS ROUTINE IS CALLED BY: None
  60 C                               Normally called only by application
  61 C                               programs.
  62 C
  63 C ATTRIBUTES:
  64 C   LANGUAGE: FORTRAN 77
  65 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  66 C
  67 C$$$
  68
  69       INCLUDE 'bufrlib.prm'
  70
  71       COMMON /MSGMEM/ MUNIT,MLAST,MSGP(0:MAXMSG),MSGS(MAXMEM),
  72      .                MDX(MXDXW),IPDXM(MXDXM),LDXM,NDXM,LDXTS,NDXTS,
  73      .                IFDXTS(MXDXTS),ICDXTS(MXDXTS),IPMSGS(MXDXTS)
  74       COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
  75      .                INODE(NFILES),IDATE(NFILES)
  76
  77       CHARACTER*128 BORT_STR
  78       CHARACTER*8   SUBSET
  79
  80 C-----------------------------------------------------------------------
  81 C-----------------------------------------------------------------------
  82
  83 C  READ SUBSET #ISUB FROM MEMORY MESSAGE #IMSG
  84 C  -------------------------------------------
  85
  86       CALL RDMEMM(IMSG,SUBSET,JDATE,IRET)
  87       IF(IRET.LT.0) GOTO 900
  88       CALL RDMEMS(ISUB,IRET)
  89       IF(IRET.NE.0) GOTO 901
  90
  91 C  EXITS
  92 C  -----
  93
  94       RETURN
  95 900   IF(IMSG.GT.0)  THEN
  96       WRITE(BORT_STR,'("BUFRLIB: UFBMMS - REQUESTED MEMORY MESSAGE '//
  97      . 'NUMBER TO READ IN (",I5,") EXCEEDS THE NUMBER OF MESSAGES IN '//
  98      . 'MEMORY (",I5,")")') IMSG,MSGP(0)
  99       ELSE
 100       WRITE(BORT_STR,'("BUFRLIB: UFBMMS - REQUESTED MEMORY MESSAGE '//
 101      . 'NUMBER TO READ IN IS ZERO - THIS IS NOT VALID")')
 102       ENDIF
 103       CALL BORT(BORT_STR)
 104 901   CALL STATUS(MUNIT,LUN,IL,IM)
 105       WRITE(BORT_STR,'("BUFRLIB: UFBMMS - REQ. SUBSET NUMBER TO READ '//
 106      . 'IN (",I3,") EXCEEDS THE NUMBER OF SUBSETS (",I3,") IN THE '//
 107      . 'REG. MEMORY MESSAGE (",I5,")")') ISUB,MSUB(LUN),IMSG
 108       CALL BORT(BORT_STR)
 109       END