previous_versions/v11.7.1/ufbmex_8f_source.html

C> @file

C> @brief Connect a new system file to the BUFRLIB software, and read

C> the entire file contents into internal arrays.


C> This subroutine connects a new system file to the BUFRLIB software

C> for input operations, then reads the entire file contents into

C> internal arrays so that any of the individual BUFR messages can

C> later be accessed from memory, instead of having to read them one

C> at a time sequentially from the system file.

C>

C> <p>This subroutine is similar to subroutine ufbmem(), except that

C> instead of a file status it returns an array of message types that

C> were read in.  Furthermore, this subroutine doesn't process any

C> embedded DX BUFR tables contained within the system file; instead,

C> it provides an additional call argument LUNDX to allow

C> for specification of the necessary DX BUFR table information

C> associated with the messages in the file.

C>

C> @author J. Woollen

C> @date 2012-01-26

C>

C> @param[in] LUNIT   -- integer: Fortran logical unit number for BUFR

C>                       file

C> @param[in] LUNDX   -- integer: Fortran logical unit number

C>                       containing DX BUFR table information

C>                       associated with BUFR messages in LUNIT

C> @param[in] INEW    -- integer: Processing option

C>                       - 0 = Initialize the internal arrays, then

C>                             read all BUFR messages from LUNIT into

C>                             internal arrays

C>                       - Otherwise, read all BUFR messages from LUNIT

C>                         and append them to the existing messages

C>                         within the internal arrays

C> @param[out] IRET   -- integer: Number of BUFR messages that were

C>                       read from LUNIT and stored into internal arrays

C> @param[out] MESG   -- integer(*): Types of BUFR messages that were

C>                       read from LUNIT and stored into internal arrays

C>

C> <p>Logical unit numbers LUNIT and LUNDX must already be associated

C> with actual filenames on the local system, typically via a Fortran

C> "OPEN" statement.

C>

C> <b>Program history log:</b>

C> | Date | Programmer | Comments |

C> | -----|------------|----------|

C> | 2012-01-26 | J. Woollen | Original author |

C> | 2014-12-10 | J. Ator    | Use modules instead of COMMON blocks |

C> | 2015-09-24 | D. Stokes  | Fix missing declaration of COMMON /QUIET/ |

C>

      SUBROUTINE ufbmex(LUNIT,LUNDX,INEW,IRET,MESG)


      USE modv_maxmem

      USE modv_maxmsg


      USE moda_mgwa

      USE moda_msgmem


      COMMON /quiet / iprt


      CHARACTER*128 BORT_STR,ERRSTR


      INTEGER       MESG(*)


C-----------------------------------------------------------------------

C-----------------------------------------------------------------------


C  TRY TO OPEN BUFR FILE AND SET TO INITIALIZE OR CONCATENATE

C  ----------------------------------------------------------


      CALL openbf(lunit,'IN',lundx)


      IF(inew.EQ.0) THEN

         msgp(0) = 0

         munit = 0

         mlast = 0

         ndxts = 0

         ldxts = 0

         ndxm = 0

         ldxm = 0

      ENDIF


      nmsg = msgp(0)

      iret = 0

      iflg = 0

      itim = 0


C  SET SOME FLAGS SO THAT SUBSEQUENT CALLS TO THE MESSAGE READING

C  ROUTINES WILL KNOW THERE IS A BUFR TABLE IN SCOPE.


      ndxts = 1

      ldxts = 1

      ipmsgs(1) = 1


C  TRANSFER MESSAGES FROM FILE TO MEMORY - SET MESSAGE POINTERS

C  ------------------------------------------------------------


1     CALL rdmsgw(lunit,mgwa,ier)

      IF(ier.EQ.-1) GOTO 100

      IF(ier.EQ.-2) GOTO 900


      nmsg = nmsg+1

      mesg(nmsg) = iupbs01(mgwa,'MTYP')

      IF(nmsg      .GT.maxmsg) iflg = 1

      lmem = nmwrd(mgwa)

      IF(lmem+mlast.GT.maxmem) iflg = 2


      IF(iflg.EQ.0) THEN

         iret = iret+1

         DO i=1,lmem

            msgs(mlast+i) = mgwa(i)

         ENDDO

         msgp(0)    = nmsg

         msgp(nmsg) = mlast+1

      ELSE

         IF(itim.EQ.0) THEN

            mlast0 = mlast

            itim=1

         ENDIF

      ENDIF

      mlast = mlast+lmem

      GOTO 1


C  EXITS

C  -----


100   IF(iflg.EQ.1) THEN


C  EMERGENCY ROOM TREATMENT FOR MAXMSG ARRAY OVERFLOW

C  --------------------------------------------------


      IF(iprt.GE.0) THEN

      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')

      WRITE ( unit=errstr, fmt='(A,A,I8,A)' )

     . 'BUFRLIB: UFBMEX - THE NO. OF MESSAGES REQUIRED TO STORE ',

     . 'ALL MESSAGES INTERNALLY EXCEEDS MAXIMUM (', maxmsg,

     . ') - INCOMPLETE READ'

      CALL errwrt(errstr)

      WRITE ( unit=errstr, fmt='(A,I8,A,I8,A)' )

     . '>>>UFBMEX STORED ', msgp(0), ' MESSAGES OUT OF ', nmsg, '<<<'

      CALL errwrt(errstr)

      WRITE ( unit=errstr, fmt='(A,I8,A,I8,A)' )

     . '>>>UFBMEX STORED ', mlast0, ' BYTES OUT OF ', mlast, '<<<'

      CALL errwrt(errstr)

      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')

      CALL errwrt(' ')

      ENDIF

      mlast=mlast0

      ENDIF


      IF(iflg.EQ.2) THEN


C  EMERGENCY ROOM TREATMENT FOR MAXMEM ARRAY OVERFLOW

C  --------------------------------------------------


      IF(iprt.GE.0) THEN

      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')

      WRITE ( unit=errstr, fmt='(A,A,I8,A)' )

     . 'BUFRLIB: UFBMEX - THE NO. OF BYTES REQUIRED TO STORE ',

     . 'ALL MESSAGES INTERNALLY EXCEEDS MAXIMUM (', maxmem,

     . ') - INCOMPLETE READ'

      CALL errwrt(errstr)

      WRITE ( unit=errstr, fmt='(A,I8,A,I8,A)' )

     . '>>>UFBMEX STORED ', mlast0, ' BYTES OUT OF ', mlast, '<<<'

      CALL errwrt(errstr)

      WRITE ( unit=errstr, fmt='(A,I8,A,I8,A)' )

     . '>>>UFBMEX STORED ', msgp(0), ' MESSAGES OUT OF ', nmsg, '<<<'

      CALL errwrt(errstr)

      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')

      CALL errwrt(' ')

      ENDIF

      mlast=mlast0

      ENDIF


      IF(iret.EQ.0) THEN

         CALL closbf(lunit)

      ELSE

         IF(munit.NE.0) CALL closbf(lunit)

         IF(munit.EQ.0) munit = lunit

      ENDIF


C  EXITS

C  -----


      RETURN

900   WRITE(bort_str,'("BUFRLIB: UFBMEX - ERROR READING MESSAGE '//

     . 'NUMBER",I5," INTO MEMORY FROM UNIT",I3)') nmsg+1,lunit

      CALL bort(bort_str)

      END

bort
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:23

closbf
subroutine closbf(LUNIT)
This subroutine closes the connection between logical unit LUNIT and the BUFRLIB software.
Definition: closbf.f:35

errwrt
subroutine errwrt(STR)
This subroutine allows the user to specify a custom location for the logging of error and diagnostic ...
Definition: errwrt.f:42

iupbs01
function iupbs01(MBAY, S01MNEM)
This function returns a specified value from within Section 0 or Section 1 of a BUFR message.
Definition: iupbs01.f:74

moda_msgmem
This module contains array and variable declarations used to store the contents of one or more BUFR f...
Definition: moda_msgmem.F:14

moda_msgmem::msgs
integer, dimension(:), allocatable msgs
BUFR messages read from one or more BUFR files.
Definition: moda_msgmem.F:80

moda_msgmem::ldxm
integer ldxm
Number of array elements filled within mdx (up to a maximum of MXDXW).
Definition: moda_msgmem.F:73

moda_msgmem::mlast
integer mlast
Number of array elements filled within msgs (up to a maximum of MAXMEM).
Definition: moda_msgmem.F:72

moda_msgmem::ndxm
integer ndxm
Number of DX BUFR table messages stored within mdx (up to a maximum of MXDXM).
Definition: moda_msgmem.F:74

moda_msgmem::munit
integer munit
Fortran logical unit number for use in accessing contents of BUFR files within internal memory.
Definition: moda_msgmem.F:71

moda_msgmem::ldxts
integer ldxts
Number of DX BUFR table that is currently in scope, depending on which BUFR message within msgs is cu...
Definition: moda_msgmem.F:75

moda_msgmem::ipmsgs
integer, dimension(:), allocatable ipmsgs
Pointers to first message within msgs for which each DX BUFR table applies.
Definition: moda_msgmem.F:85

moda_msgmem::msgp
integer, dimension(:), allocatable msgp
Pointers to the beginning of each message within msgs (up to a maximum of MAXMSG, and where array ele...
Definition: moda_msgmem.F:79

moda_msgmem::ndxts
integer ndxts
Number of DX BUFR tables represented by the messages within mdx (up to a maximum of MXDXTS).
Definition: moda_msgmem.F:76

modv_maxmem
This module declares and initializes the MAXMEM variable.
Definition: modv_MAXMEM.f:13

modv_maxmem::maxmem
integer maxmem
Maximum number of bytes that can be used to store BUFR messages within internal memory.
Definition: modv_MAXMEM.f:19

modv_maxmsg
This module declares and initializes the MAXMSG variable.
Definition: modv_MAXMSG.f:13

modv_maxmsg::maxmsg
integer maxmsg
Maximum number of BUFR messages that can be stored within internal memory.
Definition: modv_MAXMSG.f:19

nmwrd
function nmwrd(MBAY)
GIVEN AN INTEGER ARRAY CONTAINING SECTION ZERO FROM A BUFR MESSAGE, THIS FUNCTION DETERMINES A COUNT ...
Definition: nmwrd.f:28

openbf
subroutine openbf(LUNIT, IO, LUNDX)
This subroutine connects a new file to the BUFRLIB software for input or output operations.
Definition: openbf.f:139

rdmsgw
subroutine rdmsgw(LUNIT, MESG, IRET)
THIS SUBROUTINE READS THE NEXT BUFR MESSAGE FROM LOGICAL UNIT LUNIT AS AN ARRAY OF INTEGER WORDS.
Definition: rdmsgw.f:38

ufbmex
subroutine ufbmex(LUNIT, LUNDX, INEW, IRET, MESG)
This subroutine connects a new system file to the BUFRLIB software for input operations,...
Definition: ufbmex.f:51