var/external/bufr/ufbrp.f

   1       SUBROUTINE UFBRP(LUN,USR,I1,I2,IO,IRET)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    UFBRP
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE WRITES OR READS SPECIFIED VALUES TO OR
   9 C   FROM THE CURRENT BUFR DATA SUBSET WITHIN INTERNAL ARRAYS, WITH THE
  10 C   DIRECTION OF THE DATA TRANSFER DETERMINED BY THE CONTEXT OF IO
  11 C   (I.E., IF IO INDICATES LUN POINTS TO A BUFR FILE THAT IS OPEN FOR
  12 C   INPUT, THEN DATA VALUES ARE READ FROM THE INTERNAL DATA SUBSET;
  13 C   OTHERWISE, DATA VALUES ARE WRITTEN TO THE INTERNAL DATA SUBSET).
  14 C   THE DATA VALUES CORRESPOND TO INTERNAL ARRAYS REPRESENTING PARSED
  15 C   STRINGS OF MNEMONICS WHICH ARE EITHER:
  16 C       1) PART OF A REGULAR (I.E., NON-DELAYED) REPLICATION SEQUENCE
  17 C                OR
  18 C       2) REPLICATED BY BEING DIRECTLY LISTED MORE THAN ONCE WITHIN AN
  19 C          OVERALL SUBSET DEFINITION
  20 C
  21 C   THIS SUBROUTINE SHOULD NEVER BE CALLED BY ANY APPLICATION PROGRAM;
  22 C   INSTEAD, APPLICATION PROGRAMS SHOULD ALWAYS CALL BUFR ARCHIVE
  23 C   LIBRARY SUBROUTINE UFBREP.
  24 C
  25 C PROGRAM HISTORY LOG:
  26 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  27 C 1998-07-08  J. WOOLLEN -- IMPROVED MACHINE PORTABILITY
  28 C 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
  29 C                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
  30 C                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
  31 C                           BUFR FILES UNDER THE MPI)
  32 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  33 C                           INTERDEPENDENCIES
  34 C 2003-11-04  D. KEYSER  -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
  35 C                           INCREASED FROM 15000 TO 16000 (WAS IN
  36 C                           VERIFICATION VERSION); UNIFIED/PORTABLE FOR
  37 C                           WRF; ADDED DOCUMENTATION (INCLUDING
  38 C                           HISTORY)
  39 C 2009-03-31  J. WOOLLEN -- ADD DOCUMENTATION
  40 C
  41 C USAGE:    CALL UFBRP (LUN, USR, I1, I2, IO, IRET)
  42 C   INPUT ARGUMENT LIST:
  43 C     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
  44 C     USR      - ONLY IF BUFR FILE OPEN FOR OUTPUT:
  45 C                   REAL*8: (I1,I2) STARTING ADDRESS OF DATA VALUES
  46 C                   WRITTEN TO DATA SUBSET
  47 C     I1       - INTEGER: LENGTH OF FIRST DIMENSION OF USR
  48 C     I2       - INTEGER: LENGTH OF SECOND DIMENSION OF USR
  49 C     IO       - INTEGER: STATUS INDICATOR FOR BUFR FILE ASSOCIATED
  50 C                WITH LUN:
  51 C                       0 = input file
  52 C                       1 = output file
  53 C
  54 C   OUTPUT ARGUMENT LIST:
  55 C     USR      - ONLY IF BUFR FILE OPEN FOR INPUT:
  56 C                   REAL*8: (I1,I2) STARTING ADDRESS OF DATA VALUES
  57 C                   READ FROM DATA SUBSET
  58 C     IRET     - INTEGER:
  59 C                  - IF BUFR FILE OPEN FOR INPUT: NUMBER OF "LEVELS" OF
  60 C                    DATA VALUES READ FROM DATA SUBSET (MUST BE NO
  61 C                    LARGER THAN I2)
  62 C                  - IF BUFR FILE OPEN FOR OUTPUT: NUMBER OF "LEVELS"
  63 C                    OF DATA VALUES WRITTEN TO DATA SUBSET (SHOULD BE
  64 C                    SAME AS I2)
  65 C
  66 C REMARKS:
  67 C    THIS ROUTINE CALLS:        INVTAG
  68 C    THIS ROUTINE IS CALLED BY: UFBREP
  69 C                               Normally not called by any application
  70 C                               programs (they should call UFBREP).
  71 C
  72 C ATTRIBUTES:
  73 C   LANGUAGE: FORTRAN 77
  74 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  75 C
  76 C$$$
  77
  78       INCLUDE 'bufrlib.prm'
  79
  80       COMMON /USRINT/ NVAL(NFILES),INV(MAXSS,NFILES),VAL(MAXSS,NFILES)
  81       COMMON /USRSTR/ NNOD,NCON,NODS(20),NODC(10),IVLS(10),KONS(10)
  82
  83       REAL*8 USR(I1,I2),VAL
  84
  85 C----------------------------------------------------------------------
  86 C----------------------------------------------------------------------
  87
  88       IRET = 0
  89       INS1 = 0
  90       INS2 = 0
  91
  92 C  FIND FIRST NON-ZERO NODE IN STRING
  93 C  ----------------------------------
  94
  95       DO NZ=1,NNOD
  96       IF(NODS(NZ).GT.0) GOTO 1
  97       ENDDO
  98       GOTO 100
  99
 100 C  FRAME A SECTION OF THE BUFFER - RETURN WHEN NO FRAME
 101 C  ----------------------------------------------------
 102
 103 1     IF(INS1+1.GT.NVAL(LUN)) GOTO 100
 104       IF(IO.EQ.1 .AND. IRET.EQ.I2) GOTO 100
 105       INS1 = INVTAG(NODS(NZ),LUN,INS1+1,NVAL(LUN))
 106       IF(INS1.EQ.0) GOTO 100
 107
 108       INS2 = INVTAG(NODS(NZ),LUN,INS1+1,NVAL(LUN))
 109       IF(INS2.EQ.0) INS2 = NVAL(LUN)
 110       IRET = IRET+1
 111
 112 C  READ USER VALUES
 113 C  ----------------
 114
 115       IF(IO.EQ.0 .AND. IRET.LE.I2) THEN
 116          DO I=1,NNOD
 117          IF(NODS(I).GT.0) THEN
 118             INVN = INVTAG(NODS(I),LUN,INS1,INS2)
 119             IF(INVN.GT.0) USR(I,IRET) = VAL(INVN,LUN)
 120          ENDIF
 121          ENDDO
 122       ENDIF
 123
 124 C  WRITE USER VALUES
 125 C  -----------------
 126
 127       IF(IO.EQ.1 .AND. IRET.LE.I2) THEN
 128          DO I=1,NNOD
 129          IF(NODS(I).GT.0) THEN
 130             INVN = INVTAG(NODS(I),LUN,INS1,INS2)
 131             IF(INVN.GT.0) VAL(INVN,LUN) = USR(I,IRET)
 132          ENDIF
 133          ENDDO
 134       ENDIF
 135
 136 C  GO FOR NEXT FRAME
 137 C  -----------------
 138
 139       GOTO 1
 140
 141 C  EXIT
 142 C  ----
 143
 144 100   RETURN
 145       END