var/external/bufr/trybump.f

   1       SUBROUTINE TRYBUMP(LUNIT,LUN,USR,I1,I2,IO,IRET)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    TRYBUMP
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE CHECKS THE FIRST NODE ASSOCIATED WITH A
   9 C   CHARACTER STRING (PARSED INTO ARRAYS IN COMMON BLOCK /USRSTR/) IN
  10 C   ORDER TO DETERMINE IF IT REPRESENTS A DELAYED REPLICATION SEQUENCE.
  11 C   IF SO, THEN THE DELAYED REPLICATION SEQUENCE IS INITIALIZED AND
  12 C   EXPANDED (I.E. "BUMPED") TO THE VALUE OF INPUT ARGUMENT I2.
  13 C   A CALL IS THEN MADE TO SUBROUTINE UFBRW IN ORDER TO WRITE USER DATA
  14 C   INTO THE NEWLY EXPANDED REPLICATION SEQUENCE.
  15 C
  16 C   TRYBUMP IS USUALLY CALLED FROM UFBINT AFTER UFBINT RECEIVES A
  17 C   NON-ZERO RETURN CODE FROM UFBRW.  THE CAUSE OF A BAD RETURN FROM
  18 C   UFBRW IS USUALLY A DELAYED REPLICATION SEQUENCE WHICH ISN'T
  19 C   EXPANDED ENOUGH TO HOLD THE ARRAY OF DATA THE USER IS TRYING TO
  20 C   WRITE.  SO TRYBUMP IS ONE LAST CHANCE TO RESOLVE THAT SITUATION.
  21 C
  22 C PROGRAM HISTORY LOG:
  23 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  24 C 1998-07-08  J. WOOLLEN -- IMPROVED MACHINE PORTABILITY
  25 C 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
  26 C                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
  27 C                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
  28 C                           BUFR FILES UNDER THE MPI)
  29 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  30 C                           INTERDEPENDENCIES
  31 C 2003-11-04  D. KEYSER  -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
  32 C                           INCREASED FROM 15000 TO 16000 (WAS IN
  33 C                           VERIFICATION VERSION); UNIFIED/PORTABLE FOR
  34 C                           WRF; ADDED DOCUMENTATION (INCLUDING
  35 C                           HISTORY) (INCOMPLETE); OUTPUTS MORE
  36 C                           COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
  37 C                           TERMINATES ABNORMALLY
  38 C 2009-03-31  J. WOOLLEN -- ADDED DOCUMENTATION
  39 C
  40 C USAGE:    CALL TRYBUMP (LUNIT, LUN, USR, I1, I2, IO, IRET)
  41 C   INPUT ARGUMENT LIST:
  42 C     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
  43 C                (SEE REMARKS)
  44 C     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
  45 C                (ASSOCIATED WITH FILE CONNECTED TO LOGICAL UNIT LUNIT)
  46 C     USR      - REAL*8: (I1,I2) STARTING ADDRESS OF DATA VALUES TO BE
  47 C                WRITTEN TO DATA SUBSET
  48 C     I1       - INTEGER: LENGTH OF FIRST DIMENSION OF USR
  49 C     I2       - INTEGER: NUMBER OF "LEVELS" OF DATA VALUES TO BE
  50 C                WRITTEN TO DATA SUBSET
  51 C     IO       - INTEGER: STATUS INDICATOR FOR BUFR FILE ASSOCIATED
  52 C                WITH LUNIT (SEE REMARKS):
  53 C                       0 = INPUT FILE (POSSIBLE FUTURE USE)
  54 C                       1 = OUTPUT FILE
  55 C
  56 C   OUTPUT ARGUMENT LIST:
  57 C     IRET     - INTEGER: RETURN CODE FROM CALL TO SUBROUTINE UFBRW
  58 C
  59 C REMARKS:
  60 C    ARGUMENT LUNIT IS NOT REFERENCED IN THIS SUBROUTINE.  IT WAS
  61 C    INCLUDED ONLY FOR POTENTIAL FUTURE EXPANSION OF THE SUBROUTINE.
  62 C
  63 C    ARGUMENT IO IS ALWAYS PASSED IN WITH A VALUE OF 1 AT THE PRESENT
  64 C    TIME.  IN THE FUTURE THE SUBROUTINE MAY BE EXPANDED TO ALLOW IT
  65 C    TO OPERATE ON INPUT FILES.
  66 C
  67 C    THIS ROUTINE CALLS:        BORT     INVWIN   LSTJPB   UFBRW
  68 C                               USRTPL
  69 C    THIS ROUTINE IS CALLED BY: UFBINT   UFBOVR
  70 C                               Normally not called by any application
  71 C                               programs.
  72 C
  73 C ATTRIBUTES:
  74 C   LANGUAGE: FORTRAN 77
  75 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  76 C
  77 C$$$
  78
  79       INCLUDE 'bufrlib.prm'
  80
  81       COMMON /USRINT/ NVAL(NFILES),INV(MAXSS,NFILES),VAL(MAXSS,NFILES)
  82       COMMON /USRSTR/ NNOD,NCON,NODS(20),NODC(10),IVLS(10),KONS(10)
  83
  84       REAL*8 USR(I1,I2),VAL
  85
  86 C-----------------------------------------------------------------------
  87 C-----------------------------------------------------------------------
  88
  89 C  SEE IF THERE IS A DELAYED REPLICATION GROUP INVOLVED
  90 C  ----------------------------------------------------
  91
  92       NDRP = LSTJPB(NODS(1),LUN,'DRP')
  93       IF(NDRP.LE.0) GOTO 100
  94
  95 C  IF SO, CLEAN IT OUT AND BUMP IT TO I2
  96 C  -------------------------------------
  97
  98       INVN = INVWIN(NDRP,LUN,1,NVAL(LUN))
  99       VAL(INVN,LUN) = 0
 100       JNVN = INVN+1
 101       DO WHILE(NINT(VAL(JNVN,LUN)).GT.0)
 102          JNVN = JNVN+NINT(VAL(JNVN,LUN))
 103       ENDDO
 104       DO KNVN=1,NVAL(LUN)-JNVN+1
 105       INV(INVN+KNVN,LUN) = INV(JNVN+KNVN-1,LUN)
 106       VAL(INVN+KNVN,LUN) = VAL(JNVN+KNVN-1,LUN)
 107       ENDDO
 108       NVAL(LUN) = NVAL(LUN)-(JNVN-INVN-1)
 109       CALL USRTPL(LUN,INVN,I2)
 110
 111 C  FINALLY, CALL THE MNEMONIC WRITER
 112 C  ----------------------------------------
 113
 114       CALL UFBRW(LUN,USR,I1,I2,IO,IRET)
 115
 116 C  EXIT
 117 C  ----
 118
 119 100   RETURN
 120       END