ufbsp.f

Go to the documentation of this file.

C> @file
C> @author WOOLLEN @date 1999-11-18
      
C> THIS SUBROUTINE WRITES OR READS SPECIFIED VALUES TO OR
C>   FROM THE CURRENT BUFR DATA SUBSET WITHIN INTERNAL ARRAYS, WITH THE
C>   DIRECTION OF THE DATA TRANSFER DETERMINED BY THE CONTEXT OF IO
C>   (I.E., IF IO INDICATES LUN POINTS TO A BUFR FILE THAT IS OPEN FOR
C>   INPUT, THEN DATA VALUES ARE READ FROM THE INTERNAL DATA SUBSET;
C>   OTHERWISE, DATA VALUES ARE WRITTEN TO THE INTERNAL DATA SUBSET).
C>   THE DATA VALUES CORRESPOND TO INTERNAL ARRAYS REPRESENTING PARSED
C>   STRINGS OF MNEMONICS WHICH ARE EITHER:
C>       1) PART OF A REGULAR (I.E., NON-DELAYED) REPLICATION SEQUENCE
C>                OR
C>       2) REPLICATED BY BEING DIRECTLY LISTED MORE THAN ONCE WITHIN AN
C>          OVERALL SUBSET DEFINITION
C>   SO IN THAT RESPECT IT IS VERY SIMILAR TO BUFR ARCHIVE LIBRARY
C>   SUBROUTINE UFBRP, BUT THERE IS AN IMPORTANT DIFFERENCE (SEE BELOW).
C>
C>   THIS SUBROUTINE SHOULD NEVER BE CALLED BY ANY APPLICATION PROGRAM;
C>   INSTEAD, APPLICATION PROGRAMS SHOULD ALWAYS CALL BUFR ARCHIVE
C>   LIBRARY SUBROUTINE UFBSTP.
C>
C>   SEE THE DOCBLOCK FOR BUFR ARCHIVE LIBRARY SUBROUTINE UFBREP FOR AN
C>   EXPLANATION OF HOW UFBSTP DIFFERS FROM UFBREP, AND THEREFORE HOW
C>   UFBSP DIFFERS FROM UFBRP.
C>
C> PROGRAM HISTORY LOG:
C> 1999-11-18  J. WOOLLEN -- ORIGINAL AUTHOR
C> 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
C>                           INTERDEPENDENCIES
C> 2003-11-04  D. KEYSER  -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
C>                           INCREASED FROM 15000 TO 16000 (WAS IN
C>                           VERIFICATION VERSION); UNIFIED/PORTABLE FOR
C>                           WRF; ADDED DOCUMENTATION (INCLUDING
C>                           HISTORY)
C> 2009-03-31  J. WOOLLEN -- ADD DOCUMENTATION
C> 2014-12-10  J. ATOR    -- USE MODULES INSTEAD OF COMMON BLOCKS
C>
C> USAGE:    CALL UFBSP (LUN, USR, I1, I2, IO, IRET)
C>   INPUT ARGUMENT LIST:
C>     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
C>     USR      - ONLY IF BUFR FILE OPEN FOR OUTPUT:
C>                   REAL*8: (I1,I2) STARTING ADDRESS OF DATA VALUES
C>                   WRITTEN TO DATA SUBSET
C>     I1       - INTEGER: LENGTH OF FIRST DIMENSION OF USR
C>     I2       - INTEGER: LENGTH OF SECOND DIMENSION OF USR
C>     IO       - INTEGER: STATUS INDICATOR FOR BUFR FILE ASSOCIATED
C>                WITH LUN:
C>                       0 = input file
C>                       1 = output file
C>
C>   OUTPUT ARGUMENT LIST:
C>     USR      - ONLY IF BUFR FILE OPEN FOR INPUT:
C>                   REAL*8: (I1,I2) STARTING ADDRESS OF DATA VALUES
C>                   READ FROM DATA SUBSET
C>     IRET     - INTEGER:
C>                  - IF BUFR FILE OPEN FOR INPUT: NUMBER OF "LEVELS" OF
C>                    DATA VALUES READ FROM DATA SUBSET (MUST BE NO
C>                    LARGER THAN I2)
C>                  - IF BUFR FILE OPEN FOR OUTPUT: NUMBER OF "LEVELS"
C>                    OF DATA VALUES WRITTEN TO DATA SUBSET (SHOULD BE
C>                    SAME AS I2)
C>
C> REMARKS:
C>    THIS ROUTINE CALLS:        INVTAG
C>    THIS ROUTINE IS CALLED BY: UFBSTP
C>                               Normally not called by any application
C>                               programs (they should call UFBSTP).
C>
      SUBROUTINE ufbsp(LUN,USR,I1,I2,IO,IRET)

      USE moda_usrint

      COMMON /usrstr/ nnod,ncon,nods(20),nodc(10),ivls(10),kons(10)

      REAL*8  usr(i1,i2)

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

      iret = 0
      ins1 = 0
      ins2 = 0

C  FRAME A SECTION OF THE BUFFER - RETURN WHEN NO FRAME
C  ----------------------------------------------------

1     IF(ins1+1.GT.nval(lun)) goto 100
      ins1 = invtag(nods(1),lun,ins1+1,nval(lun))
      IF(ins1.EQ.0) goto 100

      ins2 = invtag(nods(1),lun,ins1+1,nval(lun))
      IF(ins2.EQ.0) ins2 = nval(lun)
      iret = iret+1

C  READ USER VALUES
C  ----------------

      IF(io.EQ.0 .AND. iret.LE.i2) THEN
         invm = ins1
         DO i=1,nnod
         IF(nods(i).GT.0) THEN
            invn = invtag(nods(i),lun,invm,ins2)
            IF(invn.GT.0) usr(i,iret) = val(invn,lun)
            invm = max(invn,invm)
         ENDIF
         ENDDO
      ENDIF

C  WRITE USER VALUES
C  -----------------

      IF(io.EQ.1 .AND. iret.LE.i2) THEN
         invm = ins1
         DO i=1,nnod
         IF(nods(i).GT.0) THEN
            invn = invtag(nods(i),lun,invm,ins2)
            IF(invn.GT.0) val(invn,lun) = usr(i,iret)
            invm = max(invn,invm)
         ENDIF
         ENDDO
      ENDIF

C  GO FOR NEXT FRAME
C  -----------------

      goto 1

C  EXIT
C  ----

100   RETURN
      END