trybump.f

Go to the documentation of this file.

C> @file
C> @author WOOLLEN @date 1994-01-06
      
C> THIS SUBROUTINE CHECKS THE FIRST NODE ASSOCIATED WITH A
C>   CHARACTER STRING (PARSED INTO ARRAYS IN COMMON BLOCK /USRSTR/) IN
C>   ORDER TO DETERMINE IF IT REPRESENTS A DELAYED REPLICATION SEQUENCE.
C>   IF SO, THEN THE DELAYED REPLICATION SEQUENCE IS INITIALIZED AND
C>   EXPANDED (I.E. "BUMPED") TO THE VALUE OF INPUT ARGUMENT I2.
C>   A CALL IS THEN MADE TO SUBROUTINE UFBRW IN ORDER TO WRITE USER DATA
C>   INTO THE NEWLY EXPANDED REPLICATION SEQUENCE.
C>
C>   TRYBUMP IS USUALLY CALLED FROM UFBINT AFTER UFBINT RECEIVES A
C>   NON-ZERO RETURN CODE FROM UFBRW.  THE CAUSE OF A BAD RETURN FROM
C>   UFBRW IS USUALLY A DELAYED REPLICATION SEQUENCE WHICH ISN'T
C>   EXPANDED ENOUGH TO HOLD THE ARRAY OF DATA THE USER IS TRYING TO
C>   WRITE.  SO TRYBUMP IS ONE LAST CHANCE TO RESOLVE THAT SITUATION.
C>
C> PROGRAM HISTORY LOG:
C> 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
C> 1998-07-08  J. WOOLLEN -- IMPROVED MACHINE PORTABILITY
C> 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
C>                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
C>                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
C>                           BUFR FILES UNDER THE MPI)
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) (INCOMPLETE); OUTPUTS MORE
C>                           COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
C>                           TERMINATES ABNORMALLY
C> 2009-03-31  J. WOOLLEN -- ADDED DOCUMENTATION
C> 2014-12-10  J. ATOR    -- USE MODULES INSTEAD OF COMMON BLOCKS
C>
C> USAGE:    CALL TRYBUMP (LUNIT, LUN, USR, I1, I2, IO, IRET)
C>   INPUT ARGUMENT LIST:
C>     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
C>                (SEE REMARKS)
C>     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
C>                (ASSOCIATED WITH FILE CONNECTED TO LOGICAL UNIT LUNIT)
C>     USR      - REAL*8: (I1,I2) STARTING ADDRESS OF DATA VALUES TO BE
C>                WRITTEN TO DATA SUBSET
C>     I1       - INTEGER: LENGTH OF FIRST DIMENSION OF USR
C>     I2       - INTEGER: NUMBER OF "LEVELS" OF DATA VALUES TO BE
C>                WRITTEN TO DATA SUBSET
C>     IO       - INTEGER: STATUS INDICATOR FOR BUFR FILE ASSOCIATED
C>                WITH LUNIT (SEE REMARKS):
C>                       0 = INPUT FILE (POSSIBLE FUTURE USE)
C>                       1 = OUTPUT FILE
C>
C>   OUTPUT ARGUMENT LIST:
C>     IRET     - INTEGER: RETURN CODE FROM CALL TO SUBROUTINE UFBRW
C>
C> REMARKS:
C>    ARGUMENT LUNIT IS NOT REFERENCED IN THIS SUBROUTINE.  IT WAS 
C>    INCLUDED ONLY FOR POTENTIAL FUTURE EXPANSION OF THE SUBROUTINE.
C>
C>    ARGUMENT IO IS ALWAYS PASSED IN WITH A VALUE OF 1 AT THE PRESENT
C>    TIME.  IN THE FUTURE THE SUBROUTINE MAY BE EXPANDED TO ALLOW IT
C>    TO OPERATE ON INPUT FILES.
C>
C>    THIS ROUTINE CALLS:        BORT     INVWIN   LSTJPB   UFBRW
C>                               USRTPL
C>    THIS ROUTINE IS CALLED BY: UFBINT   UFBOVR
C>                               Normally not called by any application
C>                               programs.
C>
      SUBROUTINE trybump(LUNIT,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-----------------------------------------------------------------------

C  SEE IF THERE IS A DELAYED REPLICATION GROUP INVOLVED
C  ----------------------------------------------------

      ndrp = lstjpb(nods(1),lun,'DRP')
      IF(ndrp.LE.0) goto 100

C  IF SO, CLEAN IT OUT AND BUMP IT TO I2
C  -------------------------------------

      invn = invwin(ndrp,lun,1,nval(lun))
      val(invn,lun) = 0
      jnvn = invn+1
      DO WHILE(nint(val(jnvn,lun)).GT.0)
         jnvn = jnvn+nint(val(jnvn,lun))
      ENDDO
      DO knvn=1,nval(lun)-jnvn+1
      inv(invn+knvn,lun) = inv(jnvn+knvn-1,lun)
      val(invn+knvn,lun) = val(jnvn+knvn-1,lun)
      ENDDO
      nval(lun) = nval(lun)-(jnvn-invn-1)
      CALL usrtpl(lun,invn,i2)

C  FINALLY, CALL THE MNEMONIC WRITER
C  ----------------------------------------

      CALL ufbrw(lun,usr,i1,i2,io,iret)

C  EXIT
C  ----

100   RETURN
      END