wrfv2_fire/var/external/bufr/trybump.inc

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