wrf svn trunk commit r4103
[wrffire.git] / wrfv2_fire / var / external / bufr / ufbrp.inc
blob6a1759da6b7ed3a8e34eaf56e446da55c4d1a7f3
1       SUBROUTINE UFBRP(LUN,USR,I1,I2,IO,IRET)
3 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
5 ! SUBPROGRAM:    UFBRP
6 !   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
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).
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)
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
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)
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).
70 ! ATTRIBUTES:
71 !   LANGUAGE: FORTRAN 77
72 !   MACHINE:  PORTABLE TO ALL PLATFORMS
74 !$$$
76       INCLUDE 'bufrlib.prm'
78 !     COMMON /USRINT/ NVAL(NFILES),INV(MAXJL,NFILES),VAL(MAXJL,NFILES)
79       COMMON /USRSTR/ NNOD,NCON,NODS(20),NODC(10),IVLS(10),KONS(10)
81       REAL*8 USR(I1,I2)!,VAL
83 !----------------------------------------------------------------------
84 !----------------------------------------------------------------------
86       IRET = 0
87       INS1 = 0
88       INS2 = 0
90 !  FIND FIRST NON-ZERO NODE IN STRING
91 !  ----------------------------------
93       DO NZ=1,NNOD
94       IF(NODS(NZ).GT.0) GOTO 1
95       ENDDO
96       GOTO 100
98 !  FRAME A SECTION OF THE BUFFER - RETURN WHEN NO FRAME
99 !  ----------------------------------------------------
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
106       INS2 = INVTAG(NODS(NZ),LUN,INS1+1,NVAL(LUN))
107       IF(INS2.EQ.0) INS2 = NVAL(LUN)
108       IRET = IRET+1
110 !  READ USER VALUES
111 !  ----------------
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
122 !  WRITE USER VALUES
123 !  -----------------
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
134 !  GO FOR NEXT FRAME
135 !  -----------------
137       GOTO 1
139 !  EXIT
140 !  ----
142 100   RETURN
143       END SUBROUTINE UFBRP