wrfv2_fire/var/external/bufr/ufbrp.inc

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